module Text.Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkExpanderEnv,mkHistoryEnv,mkInteractor,mkSpawn,mkRandom,mkClock,mkChatty,mkChannelPrinter,mkDefCP,mkArchiver,mkExtendedPrinter) where
import Text.Chatty.Scanner
import Text.Chatty.Printer
import Text.Chatty.Finalizer
import Text.Chatty.Expansion
import Text.Chatty.Expansion.Vars
import Text.Chatty.Expansion.History
import Text.Chatty.Channel.Printer
import Text.Chatty.Channel.Broadcast
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
import System.IO
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
mnomask = lift . mnomask
|]
where sx = strToType s
mkExtendedPrinter :: Name -> Q [Dec]
mkExtendedPrinter s = [d|
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
mkChannelPrinter :: Name -> Name -> Q [Dec]
mkChannelPrinter c s = [d|
instance ChannelPrinter $cx m => ChannelPrinter $cx ($sx m) where
cstart = lift . cstart
cfin = lift . cfin
cprint c = lift . cprint c
cthis = lift cthis
|]
where sx = strToType s
cx = strToType c
mkDefCP :: Name -> Q [Dec]
mkDefCP s = mkInteractor s (mkChannelPrinter ''Int) (mkChannelPrinter ''Bool) (mkChannelPrinter ''Handle)
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
|]
where sx = strToType s
mkExpanderEnv :: Name -> Q [Dec]
mkExpanderEnv s = [d|
instance ExpanderEnv m => ExpanderEnv ($sx m) where
mgetv = lift . mgetv
mputv k v = lift $ mputv k v
|]
where sx = strToType s
mkHistoryEnv :: Name -> Q [Dec]
mkHistoryEnv s = [d|
instance HistoryEnv m => HistoryEnv ($sx m) where
mcounth = lift mcounth
mgeth = lift . mgeth
mputh = lift . mputh
|]
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 mkExpanderEnv
mkHistoryEnv mkDefCP mkExtendedPrinter
mkArchiver :: Name -> Q [Dec]
mkArchiver s = mkInteractor s
mkScanner mkExpander mkExpanderEnv
mkHistoryEnv mkFinalizer 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))