module Text.Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkExpanderEnv,mkHistoryEnv,mkInteractor,mkSpawn,mkRandom,mkClock,mkChatty,mkChannelPrinter,mkDefCP,mkArchiver,mkExtendedPrinter,mkBufferedScanner) where
import Text.Chatty.Scanner
import Text.Chatty.Scanner.Buffered
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 ChScanner m => ChScanner ($sx m) where
mscan1 = lift mscan1
mscanL = lift mscanL
mscannable = lift mscannable
mscanh = lift mscanh
mready = lift mready
|]
where sx = strToType s
mkBufferedScanner :: Name -> Q [Dec]
mkBufferedScanner s = [d|
instance ChBufferedScanner m => ChBufferedScanner ($sx m) where
mpeek1 = lift mpeek1
mprepend = lift . mprepend
|]
where sx = strToType s
mkPrinter :: Name -> Q [Dec]
mkPrinter s = [d|
instance ChPrinter m => ChPrinter ($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 ChExtendedPrinter m => ChExtendedPrinter ($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 ChChannelPrinter $cx m => ChChannelPrinter $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 ChFinalizer m => ChFinalizer ($sx m) where
mqfh = lift . mqfh
mfin = lift mfin
|]
where sx = strToType s
mkExpander :: Name -> Q [Dec]
mkExpander s = [d|
instance ChExpand m => ChExpand ($sx m) where
expand = lift . expand
|]
where sx = strToType s
mkExpanderEnv :: Name -> Q [Dec]
mkExpanderEnv s = [d|
instance ChExpanderEnv m => ChExpanderEnv ($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 ChHistoryEnv m => ChHistoryEnv ($sx m) where
mcounth = lift mcounth
mgeth = lift . mgeth
mputh = lift . mputh
|]
where sx = strToType s
mkSpawn :: Name -> Q [Dec]
mkSpawn s = [d|
instance ChSpawn m => ChSpawn ($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 ChRandom m => ChRandom ($sx m) where
mrandom = lift mrandom
mrandomR = lift . mrandomR
|]
where sx = strToType s
mkClock :: Name -> Q [Dec]
mkClock s = [d|
instance ChClock m => ChClock ($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
mkBufferedScanner
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))