{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE QuasiQuotes #-}
module Streamly.Internal.Data.Stream.MkType
(
mkZipType
, mkCrossType
, MonadIO(..)
, MonadThrow(..)
, MonadReader(..)
, MonadTrans(..)
, ap
) where
import Language.Haskell.TH.Lib
import Language.Haskell.TH.Syntax
import Control.Monad (ap)
import Control.Monad.Catch (MonadThrow(..))
import Control.Monad.IO.Class (MonadIO(..))
import Control.Monad.Reader.Class (MonadReader(..))
import Control.Monad.Trans.Class (MonadTrans(..))
import Prelude hiding (repeat)
{-# INLINE singleton #-}
singleton :: a -> [a]
singleton :: forall a. a -> [a]
singleton a
x = [a
x]
toTypeStr :: String -> String
toTypeStr :: String -> String
toTypeStr String
typ = String
"mk" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ
unTypeStr :: String -> String
unTypeStr :: String -> String
unTypeStr String
typ = String
"un" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
typ
_m :: Name
_m :: Name
_m = String -> Name
mkName String
"m"
_a :: Name
_a :: Name
_a = String -> Name
mkName String
"a"
_r :: Name
_r :: Name
_r = String -> Name
mkName String
"r"
_Stream :: Name
_Stream :: Name
_Stream = String -> Name
mkName String
"Stream.Stream"
_fmap :: Name
_fmap :: Name
_fmap = String -> Name
mkName String
"fmap"
_pure :: Name
_pure :: Name
_pure = String -> Name
mkName String
"pure"
_return :: Name
_return :: Name
_return = String -> Name
mkName String
"return"
_strm :: Name
_strm :: Name
_strm = String -> Name
mkName String
"strm"
_strm1 :: Name
_strm1 :: Name
_strm1 = String -> Name
mkName String
"strm1"
_strm2 :: Name
_strm2 :: Name
_strm2 = String -> Name
mkName String
"strm2"
_Functor :: Name
_Functor :: Name
_Functor = String -> Name
mkName String
"Functor"
_Applicative :: Name
_Applicative :: Name
_Applicative = String -> Name
mkName String
"Applicative"
_Monad :: Name
_Monad :: Name
_Monad = String -> Name
mkName String
"Monad"
_MonadTrans :: Name
_MonadTrans :: Name
_MonadTrans = String -> Name
mkName String
"MonadTrans"
_MonadIO :: Name
_MonadIO :: Name
_MonadIO = String -> Name
mkName String
"MonadIO"
_MonadThrow :: Name
_MonadThrow :: Name
_MonadThrow = String -> Name
mkName String
"MonadThrow"
_MonadReader :: Name
_MonadReader :: Name
_MonadReader = String -> Name
mkName String
"MonadReader"
_lift :: Name
_lift :: Name
_lift = String -> Name
mkName String
"lift"
_ask :: Name
_ask :: Name
_ask = String -> Name
mkName String
"ask"
_local :: Name
_local :: Name
_local = String -> Name
mkName String
"local"
_throwM :: Name
_throwM :: Name
_throwM = String -> Name
mkName String
"throwM"
_liftIO :: Name
_liftIO :: Name
_liftIO = String -> Name
mkName String
"liftIO"
_f :: Name
_f :: Name
_f = String -> Name
mkName String
"f"
_f1 :: Name
_f1 :: Name
_f1 = String -> Name
mkName String
"f1"
_dotOp :: Name
_dotOp :: Name
_dotOp = String -> Name
mkName String
"."
_apOp :: Name
_apOp :: Name
_apOp = String -> Name
mkName String
"<*>"
_bindOp :: Name
_bindOp :: Name
_bindOp = String -> Name
mkName String
">>="
_IsList :: Name
_IsList :: Name
_IsList = String -> Name
mkName String
"IsList"
_IsString :: Name
_IsString :: Name
_IsString = String -> Name
mkName String
"IsString"
_Eq :: Name
_Eq :: Name
_Eq = String -> Name
mkName String
"Eq"
_Ord :: Name
_Ord :: Name
_Ord = String -> Name
mkName String
"Ord"
_Traversable :: Name
_Traversable :: Name
_Traversable = String -> Name
mkName String
"Traversable"
_Identity :: Name
_Identity :: Name
_Identity = String -> Name
mkName String
"Identity"
_Read :: Name
_Read :: Name
_Read = String -> Name
mkName String
"Read"
_Show :: Name
_Show :: Name
_Show = String -> Name
mkName String
"Show"
_show :: Name
_show :: Name
_show = String -> Name
mkName String
"show"
_readPrec :: Name
_readPrec :: Name
_readPrec = String -> Name
mkName String
"readPrec"
_Semigroup :: Name
_Semigroup :: Name
_Semigroup = String -> Name
mkName String
"Semigroup"
_Monoid :: Name
_Monoid :: Name
_Monoid = String -> Name
mkName String
"Monoid"
_Foldable :: Name
_Foldable :: Name
_Foldable = String -> Name
mkName String
"Foldable"
derivIsListIdent :: Name -> Q Dec
derivIsListIdent :: Name -> Q Dec
derivIsListIdent Name
_Type =
Q Cxt -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => m Cxt -> m Type -> m Dec
standaloneDerivD
(Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_IsList) ((Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Identity, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a]))
derivIsStringIdent :: Name -> Q Dec
derivIsStringIdent :: Name -> Q Dec
derivIsStringIdent Name
_Type =
Q Cxt -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => m Cxt -> m Type -> m Dec
standaloneDerivD
(Type -> Cxt
forall a. a -> [a]
singleton (Type -> Cxt) -> Q Type -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [t|$(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a) ~ Char|])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT
(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_IsString)
((Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Identity, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a]))
derivEqIdent :: Name -> Q Dec
derivEqIdent :: Name -> Q Dec
derivEqIdent Name
_Type =
Q Cxt -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => m Cxt -> m Type -> m Dec
standaloneDerivD
(Type -> Cxt
forall a. a -> [a]
singleton (Type -> Cxt) -> Q Type -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [t|Eq $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a)|])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Eq) ((Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Identity, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a]))
derivOrdIdent :: Name -> Q Dec
derivOrdIdent :: Name -> Q Dec
derivOrdIdent Name
_Type =
Q Cxt -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => m Cxt -> m Type -> m Dec
standaloneDerivD
(Type -> Cxt
forall a. a -> [a]
singleton (Type -> Cxt) -> Q Type -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [t|Ord $(Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a)|])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Ord) ((Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Identity, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a]))
showInstance :: Name -> Q Dec
showInstance :: Name -> Q Dec
showInstance Name
_Type =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
(Type -> Cxt
forall a. a -> [a]
singleton (Type -> Cxt) -> Q Type -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Show) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a))
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Show) ((Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Identity, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a]))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_show Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_show
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
_Type [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_strm]]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_show) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_strm)))
[]
]
]
readInstance :: Name -> Q Dec
readInstance :: Name -> Q Dec
readInstance Name
_Type =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
(Type -> Cxt
forall a. a -> [a]
singleton (Type -> Cxt) -> Q Type -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Read) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a))
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Read) ((Q Type -> Q Type -> Q Type) -> [Q Type] -> Q Type
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT [Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Identity, Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a]))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_readPrec Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_readPrec
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
((Q Exp -> Q Exp -> Q Exp) -> [Q Exp] -> Q Exp
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE [Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_fmap, Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type, Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_readPrec])
)
[]
]
]
functorInstance :: Name -> Q Dec
functorInstance :: Name -> Q Dec
functorInstance Name
_Type = do
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
(Type -> Cxt
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Cxt) -> Q Type -> Q Cxt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Monad) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m))
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Functor) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_fmap Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_fmap
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_f, Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
_Type [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_strm]]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type)
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_fmap) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_f)) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_strm))))
[]
]
]
monadtransInstance :: Name -> Q Dec
monadtransInstance :: Name -> Q Dec
monadtransInstance Name
_Type =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
(Cxt -> Q Cxt
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_MonadTrans) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_lift Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_lift
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_dotOp)
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"Stream.fromEffect")))))
[]
]
]
monadioInstance :: Name -> Q Dec
monadioInstance :: Name -> Q Dec
monadioInstance Name
_Type =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
([Q Type] -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Monad) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m))
, Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_MonadIO) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)
])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_MonadIO) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_liftIO Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_liftIO
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_dotOp)
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just
(Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"Stream.fromEffect")))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_dotOp)
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_liftIO))))))
[]
]
]
monadthrowInstance :: Name -> Q Dec
monadthrowInstance :: Name -> Q Dec
monadthrowInstance Name
_Type =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
([Q Type] -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Monad) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m))
, Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_MonadThrow) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)
])
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_MonadThrow) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_throwM Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_throwM
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_dotOp)
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just
(Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE (String -> Name
mkName String
"Stream.fromEffect")))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_dotOp)
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_throwM))))))
[]
]
]
typeDec :: String -> [Name] -> Q [Dec]
typeDec :: String -> [Name] -> Q [Dec]
typeDec String
dtNameStr [Name]
toDerive = do
Dec
typ <-
Q Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> Q Con
-> [Q DerivClause]
-> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt
-> Name
-> [TyVarBndr ()]
-> Maybe Type
-> m Con
-> [m DerivClause]
-> m Dec
newtypeD
(Cxt -> Q Cxt
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [])
Name
_Type
[Name -> TyVarBndr ()
plainTV Name
_m, Name -> TyVarBndr ()
plainTV Name
_a]
Maybe Type
forall a. Maybe a
Nothing
(Name -> [Q BangType] -> Q Con
forall (m :: * -> *). Quote m => Name -> [m BangType] -> m Con
normalC
(String -> Name
mkName String
dtNameStr)
[ Q Bang -> Q Type -> Q BangType
forall (m :: * -> *). Quote m => m Bang -> m Type -> m BangType
bangType
(Q SourceUnpackedness -> Q SourceStrictness -> Q Bang
forall (m :: * -> *).
Quote m =>
m SourceUnpackedness -> m SourceStrictness -> m Bang
bang Q SourceUnpackedness
forall (m :: * -> *). Quote m => m SourceUnpackedness
noSourceUnpackedness Q SourceStrictness
forall (m :: * -> *). Quote m => m SourceStrictness
noSourceStrictness)
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Stream) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a))
])
[Maybe DerivStrategy -> [Q Type] -> Q DerivClause
forall (m :: * -> *).
Quote m =>
Maybe DerivStrategy -> [m Type] -> m DerivClause
derivClause Maybe DerivStrategy
forall a. Maybe a
Nothing (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (Name -> Q Type) -> [Name] -> [Q Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
toDerive) | Bool -> Bool
not ([Name] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Name]
toDerive)]
let streamType :: Q Type
streamType = Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Stream) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a)
nameType :: Q Type
nameType = Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_a)
Dec
mkTypSig <- Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
_toType (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT Q Type
forall (m :: * -> *). Quote m => m Type
arrowT Q Type
streamType) Q Type
nameType)
Dec
mkTyp <- Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD Name
_toType [[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type)) []]
Dec
unTypSig <- Name -> Q Type -> Q Dec
forall (m :: * -> *). Quote m => Name -> m Type -> m Dec
sigD Name
_unType (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT Q Type
forall (m :: * -> *). Quote m => m Type
arrowT Q Type
nameType) Q Type
streamType)
Dec
unTyp <-
Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_unType
[[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
_Type [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_strm]] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_strm)) []]
[Dec] -> Q [Dec]
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return [Dec
typ, Dec
mkTypSig, Dec
mkTyp, Dec
unTypSig, Dec
unTyp]
where
_Type :: Name
_Type = String -> Name
mkName String
dtNameStr
_toType :: Name
_toType = String -> Name
mkName (String -> String
toTypeStr String
dtNameStr)
_unType :: Name
_unType = String -> Name
mkName (String -> String
unTypeStr String
dtNameStr)
mkStreamApplicative :: Bool -> String -> [String] -> String -> String -> Q Dec
mkStreamApplicative :: Bool -> String -> [String] -> String -> String -> Q Dec
mkStreamApplicative Bool
isMonad String
dtNameStr [String]
ctxM String
pureDefStr String
apDefStr =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
((String -> Q Type) -> [String] -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Prelude.mapM (\String
c -> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (String -> Name
mkName String
c)) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)) [String]
ctxM)
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Applicative) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_pure Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_pure
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Maybe (Q Exp) -> Q Exp -> Maybe (Q Exp) -> Q Exp
forall (m :: * -> *).
Quote m =>
Maybe (m Exp) -> m Exp -> Maybe (m Exp) -> m Exp
infixE
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_dotOp)
(Q Exp -> Maybe (Q Exp)
forall a. a -> Maybe a
Just (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_pureDef))))
[]
]
, Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_apOp Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_apOp
[ if Bool
isMonad
then Q Clause
apClauseMonad
else Q Clause
apClauseApplicative
]
]
where
_Type :: Name
_Type = String -> Name
mkName String
dtNameStr
_pureDef :: Name
_pureDef = String -> Name
mkName String
pureDefStr
_apDef :: Name
_apDef = String -> Name
mkName String
apDefStr
apClauseMonad :: Q Clause
apClauseMonad = [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause [] (Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_apDef)) []
apClauseApplicative :: Q Clause
apClauseApplicative =
[Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
_Type [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_strm1], Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
_Type [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_strm2]]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type)
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_apDef) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_strm1))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_strm2))))
[]
mkStreamMonad :: String -> [String] -> String -> Q Dec
mkStreamMonad :: String -> [String] -> String -> Q Dec
mkStreamMonad String
dtNameStr [String]
ctxM String
bindDefStr =
Q Cxt -> Q Type -> [Q Dec] -> Q Dec
forall (m :: * -> *).
Quote m =>
m Cxt -> m Type -> [m Dec] -> m Dec
instanceD
((String -> Q Type) -> [String] -> Q Cxt
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
Prelude.mapM (\String
c -> Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT (String -> Name
mkName String
c)) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)) [String]
ctxM)
(Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Monad) (Q Type -> Q Type -> Q Type
forall (m :: * -> *). Quote m => m Type -> m Type -> m Type
appT (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
conT Name
_Type) (Name -> Q Type
forall (m :: * -> *). Quote m => Name -> m Type
varT Name
_m)))
[ Name -> Inline -> RuleMatch -> Phases -> Q Dec
forall (m :: * -> *).
Quote m =>
Name -> Inline -> RuleMatch -> Phases -> m Dec
pragInlD Name
_bindOp Inline
Inline RuleMatch
FunLike Phases
AllPhases
, Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_bindOp
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[Name -> [Q Pat] -> Q Pat
forall (m :: * -> *). Quote m => Name -> [m Pat] -> m Pat
conP Name
_Type [Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_strm1], Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_f]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
([Q Dec] -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => [m Dec] -> m Exp -> m Exp
letE
[ Name -> [Q Clause] -> Q Dec
forall (m :: * -> *). Quote m => Name -> [m Clause] -> m Dec
funD
Name
_f1
[ [Q Pat] -> Q Body -> [Q Dec] -> Q Clause
forall (m :: * -> *).
Quote m =>
[m Pat] -> m Body -> [m Dec] -> m Clause
clause
[Name -> Q Pat
forall (m :: * -> *). Quote m => Name -> m Pat
varP Name
_a]
(Q Exp -> Q Body
forall (m :: * -> *). Quote m => m Exp -> m Body
normalB
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_unType)
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_f) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_a))))
[]
]
]
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
conE Name
_Type)
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE
(Q Exp -> Q Exp -> Q Exp
forall (m :: * -> *). Quote m => m Exp -> m Exp -> m Exp
appE (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_bindDef) (Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_strm1))
(Name -> Q Exp
forall (m :: * -> *). Quote m => Name -> m Exp
varE Name
_f1)))))
[]
]
]
where
_Type :: Name
_Type = String -> Name
mkName String
dtNameStr
_unType :: Name
_unType = String -> Name
mkName (String -> String
unTypeStr String
dtNameStr)
_bindDef :: Name
_bindDef = String -> Name
mkName String
bindDefStr
flattenDec :: [Q [Dec]] -> Q [Dec]
flattenDec :: [Q [Dec]] -> Q [Dec]
flattenDec [] = [Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
flattenDec (Q [Dec]
ma:[Q [Dec]]
mas) = do
[Dec]
a <- Q [Dec]
ma
[Dec]
as <- [Q [Dec]] -> Q [Dec]
flattenDec [Q [Dec]]
mas
[Dec] -> Q [Dec]
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec]
a [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
as)
mkZipType
:: String
-> String
-> Bool
-> Q [Dec]
mkZipType :: String -> String -> Bool -> Q [Dec]
mkZipType String
dtNameStr String
apOpStr Bool
isConcurrent =
[Q [Dec]] -> Q [Dec]
flattenDec
[ String -> [Name] -> Q [Dec]
typeDec String
dtNameStr [Name
_Foldable | Bool -> Bool
not Bool
isConcurrent]
, [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
([Q Dec] -> Q [Dec]) -> [Q Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
isConcurrent
then [ Name -> Q Dec
derivIsListIdent Name
_Type
, Name -> Q Dec
derivIsStringIdent Name
_Type
, Name -> Q Dec
derivEqIdent Name
_Type
, Name -> Q Dec
derivOrdIdent Name
_Type
, Name -> Q Dec
showInstance Name
_Type
, Name -> Q Dec
readInstance Name
_Type
]
else []
, [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
[ Name -> Q Dec
functorInstance Name
_Type
, Bool -> String -> [String] -> String -> String -> Q Dec
mkStreamApplicative
Bool
False
String
dtNameStr
[String]
classConstraints
String
"Stream.repeat"
String
apOpStr
]
]
where
_Type :: Name
_Type = String -> Name
mkName String
dtNameStr
classConstraints :: [String]
classConstraints =
if Bool
isConcurrent
then [String
"Stream.MonadAsync"]
else [String
"Monad"]
mkCrossType
:: String
-> String
-> Bool
-> Q [Dec]
mkCrossType :: String -> String -> Bool -> Q [Dec]
mkCrossType String
dtNameStr String
bindOpStr Bool
isConcurrent =
[Q [Dec]] -> Q [Dec]
flattenDec
[ String -> [Name] -> Q [Dec]
typeDec String
dtNameStr [Name
_Foldable | Bool -> Bool
not Bool
isConcurrent]
, [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence
([Q Dec] -> Q [Dec]) -> [Q Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$ if Bool -> Bool
not Bool
isConcurrent
then [ Name -> Q Dec
derivIsListIdent Name
_Type
, Name -> Q Dec
derivIsStringIdent Name
_Type
, Name -> Q Dec
derivEqIdent Name
_Type
, Name -> Q Dec
derivOrdIdent Name
_Type
, Name -> Q Dec
showInstance Name
_Type
, Name -> Q Dec
readInstance Name
_Type
]
else []
, [Q Dec] -> Q [Dec]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence ([Q Dec] -> Q [Dec]) -> [Q Dec] -> Q [Dec]
forall a b. (a -> b) -> a -> b
$
[ Name -> Q Dec
functorInstance Name
_Type
, String -> [String] -> String -> Q Dec
mkStreamMonad String
dtNameStr [String]
classConstraints String
bindOpStr
, Bool -> String -> [String] -> String -> String -> Q Dec
mkStreamApplicative
Bool
True
String
dtNameStr
[String]
classConstraints
String
"Stream.fromPure"
String
"ap"
, Name -> Q Dec
monadioInstance Name
_Type
, Name -> Q Dec
monadthrowInstance Name
_Type
] [Q Dec] -> [Q Dec] -> [Q Dec]
forall a. [a] -> [a] -> [a]
++ [Name -> Q Dec
monadtransInstance Name
_Type | Bool -> Bool
not Bool
isConcurrent]
]
where
_Type :: Name
_Type = String -> Name
mkName String
dtNameStr
classConstraints :: [String]
classConstraints =
if Bool
isConcurrent
then [String
"Stream.MonadAsync"]
else [String
"Monad"]