module Text.Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkInteractor,mkSpawn,mkRandom,mkClock,mkChatty) where
import Text.Chatty.Scanner
import Text.Chatty.Printer
import Text.Chatty.Finalizer
import Text.Chatty.Expansion
import System.Chatty.Spawn
import Text.Chatty.Extended.Printer
import Control.Monad
import Control.Monad.Trans
import Language.Haskell.TH
import Text.Chatty.Templates
import System.Chatty.Misc
mkScanner :: Name -> Q [Dec]
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 :: Name -> Q [Dec]
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 :: Name -> Q [Dec]
mkFinalizer s = [d|
instance MonadFinalizer m => MonadFinalizer ($sx m) where
mqfh = lift . mqfh
mfin = lift mfin
|]
where sx = strToType s
mkExpander :: Name -> Q [Dec]
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 :: Name -> Q [Dec]
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 :: Name -> Q [Dec]
mkRandom s = [d|
instance MonadRandom m => MonadRandom ($sx m) where
mrandom = lift mrandom
mrandomR = lift . mrandomR
|]
where sx = strToType s
mkClock :: Name -> Q [Dec]
mkClock s = [d|
instance MonadClock m => MonadClock ($sx m) where
mutctime = lift mutctime
mgetstamp = lift mgetstamp
|]
where sx = strToType s
mkChatty :: Name -> Q [Dec]
mkChatty s = mkInteractor s mkPrinter mkScanner mkFinalizer mkExpander mkSpawn mkRandom mkClock
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))