module Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkInteractor,mkSpawn,mkRandom,mkClock) where
import Chatty.Scanner
import Chatty.Printer
import Chatty.Finalizer
import Chatty.Expansion
import Chatty.Spawn
import Chatty.Extended.Printer
import Control.Monad
import Control.Monad.Trans
import Language.Haskell.TH
import Chatty.Templates
import Chatty.Misc
mkScanner s = [d|
instance MonadScanner m => MonadScanner ($sx m) where
mscan1 = lift mscan1
mscanL = lift mscanL
mscannable = lift mscannable
mscanh = lift mscanh
mready = lift mready
|]
where sx = strToType s
mkPrinter s = [d|
instance MonadPrinter m => MonadPrinter ($sx m) where
mprint = lift . mprint
mnoecho = lift . mnoecho
mflush = lift mflush
instance ExtendedPrinter m => ExtendedPrinter ($sx m) where
estart = lift . estart
efin = lift efin
eprint c = lift . eprint c
eprintLn c = lift . eprintLn c
|]
where sx = strToType s
mkFinalizer s = [d|
instance MonadFinalizer m => MonadFinalizer ($sx m) where
mqfh = lift . mqfh
mfin = lift mfin
|]
where sx = strToType s
mkExpander s = [d|
instance MonadExpand m => MonadExpand ($sx m) where
expand = lift . expand
instance ExpanderEnv m => ExpanderEnv ($sx m) where
mgetv = lift . mgetv
mputv k v = lift $ mputv k v
|]
where sx = strToType s
mkSpawn s = [d|
instance MonadSpawn m => MonadSpawn ($sx m) where
mspw pn as si = lift $ mspw pn as si
mah = lift . mah
|]
where sx = strToType s
mkRandom s = [d|
instance MonadRandom m => MonadRandom ($sx m) where
mrandom = lift mrandom
mrandomR = lift . mrandomR
|]
where sx = strToType s
mkClock s = [d|
instance MonadClock m => MonadClock ($sx m) where
mutctime = lift mutctime
mgetstamp = lift mgetstamp
|]
where sx = strToType s
class InteractorMaker i where
mkInteractor' :: Name -> Q [Dec] -> i
mkInteractor :: Name -> i
mkInteractor n = mkInteractor' n [d| |]
instance InteractorMaker (Q [Dec]) where
mkInteractor' _ = id
instance InteractorMaker i => InteractorMaker ((Name -> Q [Dec]) -> i) where
mkInteractor' n qs qf = mkInteractor' n (do q1 <- qs; q2 <- qf n; return (q1++q2))