module MO.Base where
import MO.Run
import Data.Maybe
import Data.Typeable
import StringTable.Atom
import MO.Capture
import GHC.PArr
import StringTable.AtomMap as AtomMap
data (Typeable1 m, Monad m) => Invocant m
= forall a. (Show a, Eq a, Ord a, Typeable a) => MkInvocant
a
(AnyResponder m)
class Monad m => Codeable m c where
run :: c -> Arguments m -> m (Invocant m)
newtype NoCode m = NoCode (Invocant m)
instance (Typeable (NoCode m), Monad m) => Codeable m (NoCode m) where
run (NoCode obj) _ = return obj
instance Show (NoCode m) where
show _ = "<NoCode>"
newtype PureCode = PureCode (forall m. (Typeable1 m, Monad m) => Arguments m -> Invocant m)
instance (Typeable1 m, Monad m) => Codeable m PureCode where
run (PureCode f) a = return (f a)
instance Show PureCode where
show _ = "<PureCode>"
newtype Monad m => HsCode m = HsCode (Arguments m -> m (Invocant m))
instance (Typeable1 m, Monad m) => Codeable m (HsCode m) where
run (HsCode f) a = f a
instance Show (HsCode m) where
show _ = "<HsCode>"
type Arguments m = Capt (Invocant m)
withInvocant :: (Typeable1 m, Monad m) => Arguments m -> Invocant m -> Arguments m
withInvocant args x = CaptMeth{ c_invocant = x, c_feeds = c_feeds args }
getInvocant :: (Typeable1 m, Monad m) => Arguments m -> Maybe (Invocant m)
getInvocant CaptMeth{ c_invocant = x } = Just x
getInvocant _ = Nothing
namedArg :: (Typeable1 m, Monad m) => Arguments m -> Atom -> Maybe (Invocant m)
namedArg args key = foldlP findArg Nothing (c_feeds args)
where
findArg Nothing MkFeed{ f_nameds = ns } = fmap (!: 0) (AtomMap.lookup key ns)
findArg x _ = x
stubInvocant :: (Typeable1 m, Monad m) => Invocant m
stubInvocant = MkInvocant () emptyResponder