{-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeOperators #-} {-# LANGUAGE UndecidableInstances #-} import qualified Data.Text.Internal import qualified GHC.Generics import GHC.Generics import qualified Prelude as GHC.Classes import Control.Applicative import Data.Foldable import Data.Monoid import Data.Functor import Data.Traversable import Prelude ((.), putStr) import Data.Functor.Const import Data.Functor.Identity newtype Literal a = Literal {getLiteral :: (((Boolean GHC.Generics.:+: (Float GHC.Generics.:+: Heredoc)) GHC.Generics.:+: (Integer GHC.Generics.:+: (Null GHC.Generics.:+: String))) a)} -- deriving newtype (AST.Unmarshal.SymbolMatching) deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_6. Traversable1 a_6 ) data Boolean a = Boolean {ann :: a, text :: Data.Text.Internal.Text} deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_998. Traversable1 a_998 ) data Float a = Float {ann :: a, text :: Data.Text.Internal.Text} deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_1007. Traversable1 a_1007 ) data Heredoc a = Heredoc {ann :: a, text :: Data.Text.Internal.Text} deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_1016. Traversable1 a_1016 ) data Integer a = Integer {ann :: a, text :: Data.Text.Internal.Text} deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_1025. Traversable1 a_1025 ) data Null a = Null {ann :: a, text :: Data.Text.Internal.Text} deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_1034. Traversable1 a_1034 ) data String a = String {ann :: a, text :: Data.Text.Internal.Text} deriving stock (GHC.Generics.Generic, GHC.Generics.Generic1) deriving anyclass ( forall a_1061. Traversable1 a_1061 ) -- | Simultaneous traversal of subterms of kind @*@ and @* -> *@ in an 'Applicative' context. -- -- 'Traversable1' can express any combination of first- and second-order mapping, folding, and traversal. -- -- Note that the @1@ suffix is used in the manner of 'Data.Functor.Classes.Show1' or 'Generic1', rather than 'foldr1'; it’s a higher-order traversal which is simultaneously able to traverse (and alter) annotations. class Traversable1 c t where -- | Map annotations of kind @*@ and heterogeneously-typed subterms of kind @* -> *@ under some constraint @c@ into an 'Applicative' context. The constraint is necessary to operate on otherwise universally-quantified subterms, since otherwise there would be insufficient information to inspect them at all. -- -- No proxy is provided for the constraint @c@; instead, @-XTypeApplications@ should be used. E.g. here we ignore the annotations and print all the @* -> *@ subterms using 'Show1': -- -- @ -- 'traverse1' \@'Data.Functor.Classes.Show1' 'pure' (\ t -> t '<$' 'putStrLn' ('Data.Functor.Classes.showsPrec1' 0 t "")) -- @ -- -- Note that this traversal is non-recursive: any recursion through subterms must be performed by the second function argument. traverse1 :: Applicative f => (a -> f b) -> (forall t' . c t' => t' a -> f (t' b)) -> t a -> f (t b) default traverse1 :: (Applicative f, Generic1 t, GTraversable1 c (Rep1 t)) => (a -> f b) -> (forall t' . c t' => t' a -> f (t' b)) -> t a -> f (t b) traverse1 f g = fmap to1 . gtraverse1 @c f g . from1 -- | This function may be used as a value for 'foldMap' in a 'Foldable' instance. foldMapDefault1 :: (Traversable1 Foldable t, Monoid b) => (a -> b) -> t a -> b foldMapDefault1 f = getConst . traverse1 @Foldable (Const . f) (Const . foldMap f) -- | This function may be used as a value for 'fmap' in a 'Functor' instance. fmapDefault1 :: Traversable1 Functor t => (a -> b) -> t a -> t b fmapDefault1 f = runIdentity . traverse1 @Functor (Identity . f) (Identity . fmap f) -- | This function may be used as a value for 'traverse' in a 'Traversable' instance. traverseDefault1 :: (Traversable1 Traversable t, Applicative f) => (a -> f b) -> t a -> f (t b) traverseDefault1 f = traverse1 @Traversable f (traverse f) class GTraversable1 c t where -- | Generically map annotations and subterms of kind @* -> *@ into an 'Applicative' context. gtraverse1 :: Applicative f => (a -> f b) -> (forall t' . c t' => t' a -> f (t' b)) -> t a -> f (t b) instance GTraversable1 c f => GTraversable1 c (M1 i c' f) where gtraverse1 f g = fmap M1 . gtraverse1 @c f g . unM1 instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :*: g) where gtraverse1 f g (l :*: r) = (:*:) <$> gtraverse1 @c f g l <*> gtraverse1 @c f g r instance (GTraversable1 c f, GTraversable1 c g) => GTraversable1 c (f :+: g) where gtraverse1 f g (L1 l) = L1 <$> gtraverse1 @c f g l gtraverse1 f g (R1 r) = R1 <$> gtraverse1 @c f g r instance GTraversable1 c (K1 R t) where gtraverse1 _ _ (K1 k) = pure (K1 k) instance GTraversable1 c Par1 where gtraverse1 f _ (Par1 a) = Par1 <$> f a instance c t => GTraversable1 c (Rec1 t) where gtraverse1 _ g (Rec1 t) = Rec1 <$> g t instance (Traversable f, GTraversable1 c g) => GTraversable1 c (f :.: g) where gtraverse1 f g = fmap Comp1 . traverse (gtraverse1 @c f g) . unComp1 instance GTraversable1 c U1 where gtraverse1 _ _ _ = pure U1 main = putStr "hello"