module Text.Chatty.Interactor.Templates (mkScanner, mkPrinter, mkFinalizer, mkExpander,mkExpanderEnv,mkHistoryEnv,mkInteractor,mkSpawn,mkRandom,mkClock,mkChatty,mkChannelPrinter,mkDefCP,mkArchiver,mkExtendedPrinter,mkBufferedScanner,mkCounter,mkAtoms,mkFilesys) where
import Data.Chatty.Atoms
import Data.Chatty.Counter
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 System.Chatty.Filesystem
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
mkCounter :: Name -> Q [Dec]
mkCounter s = [d|
instance ChCounter m => ChCounter ($sx m) where
countOn = lift countOn
|]
where sx = strToType s
mkAtoms :: Name -> Q [Dec]
mkAtoms s = [d|
instance ChAtoms m => ChAtoms ($sx m) where
putAtom a v = lift $ putAtom a v
getAtom = lift . getAtom
dispAtom = lift . dispAtom
|]
where sx = strToType s
mkFilesys :: Name -> Q [Dec]
mkFilesys s = [d|
instance (ChAtoms ($sx m), ChFilesystem m) => ChFilesystem ($sx m) where
fopen p = do
res <- lift $ fopen p
case res of
NoPermission -> return NoPermission
NotFound -> return NotFound
FSSucc a -> liftM FSSucc $ funAtom a (\a -> File (lift $ loadFun a) (lift $ saveFun a) (leftBehind a) (rightPending a)) (\b a -> b{leftBehind=leftBehind a,rightPending=rightPending a})
fpwd = lift fpwd
fcd = lift . fcd
instance CanLoad m n => CanLoad ($sx m) n where
fload = lift . fload
instance CanSave m n => CanSave ($sx m) n where
fsave = lift . fsave
instance CanMount m n => CanMount ($sx m) n where
fmount = lift . fmount
|]
where sx = strToType s
mkChatty :: Name -> Q [Dec]
mkChatty s = mkInteractor s
mkPrinter mkScanner mkFinalizer mkExpander
mkSpawn mkRandom mkClock mkExpanderEnv
mkHistoryEnv mkDefCP mkExtendedPrinter
mkBufferedScanner mkCounter mkAtoms
mkFilesys
mkArchiver :: Name -> Q [Dec]
mkArchiver s = mkInteractor s
mkScanner mkExpander mkExpanderEnv
mkHistoryEnv mkFinalizer mkSpawn
mkRandom mkClock mkCounter mkAtoms
mkFilesys
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))