diff options
| author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-04-16 22:16:41 +0200 |
|---|---|---|
| committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-04-16 22:16:41 +0200 |
| commit | 03f321adafd3ef7a169555703ebc8e03903a1450 (patch) | |
| tree | d37a3e5bdb608806915e9bd88113cea71d7d8e1a | |
| parent | bfbe2f67cc3fef07db4d0ef9423a2dbc2d002533 (diff) | |
| download | events-03f321adafd3ef7a169555703ebc8e03903a1450.tar events-03f321adafd3ef7a169555703ebc8e03903a1450.tar.gz events-03f321adafd3ef7a169555703ebc8e03903a1450.tar.bz2 events-03f321adafd3ef7a169555703ebc8e03903a1450.tar.xz events-03f321adafd3ef7a169555703ebc8e03903a1450.zip | |
Specifications to be evaluated
| -rw-r--r-- | events/src/Events/Spec.hs | 36 | ||||
| -rw-r--r-- | events/src/Main.hs | 24 |
2 files changed, 59 insertions, 1 deletions
diff --git a/events/src/Events/Spec.hs b/events/src/Events/Spec.hs new file mode 100644 index 0000000..deabcc3 --- /dev/null +++ b/events/src/Events/Spec.hs | |||
| @@ -0,0 +1,36 @@ | |||
| 1 | module Events.Spec | ||
| 2 | ( interpret | ||
| 3 | , Spec, Expr(..), BoolExpr(..) | ||
| 4 | ) where | ||
| 5 | |||
| 6 | import Events.Types | ||
| 7 | |||
| 8 | import Control.Monad.IO.Class | ||
| 9 | import Control.Monad.State.Lazy | ||
| 10 | |||
| 11 | import Data.Monoid | ||
| 12 | import Data.Foldable | ||
| 13 | import Control.Lens | ||
| 14 | |||
| 15 | import Debug.Trace | ||
| 16 | |||
| 17 | type Spec = [Expr] -- most significant last | ||
| 18 | |||
| 19 | data Expr = Override Object | ||
| 20 | | Occurs BoolExpr | ||
| 21 | | Nop | ||
| 22 | deriving (Show) | ||
| 23 | |||
| 24 | data BoolExpr = BoolLit Bool | ||
| 25 | deriving (Show) | ||
| 26 | |||
| 27 | interpret :: MonadIO m => Spec -> Eval m () | ||
| 28 | interpret = mapM_ interpretExpr | ||
| 29 | |||
| 30 | interpretExpr :: MonadIO m => Expr -> Eval m () | ||
| 31 | interpretExpr (Override obj) = ctxEvent ?= obj | ||
| 32 | interpretExpr (Occurs expr) = ctxOccurs <~ interpretBoolExpr expr | ||
| 33 | interpretExpr _ = return () | ||
| 34 | |||
| 35 | interpretBoolExpr :: Monad m => BoolExpr -> Eval m Bool | ||
| 36 | interpretBoolExpr (BoolLit v) = return v | ||
diff --git a/events/src/Main.hs b/events/src/Main.hs index 1c56140..7f65b19 100644 --- a/events/src/Main.hs +++ b/events/src/Main.hs | |||
| @@ -1,4 +1,26 @@ | |||
| 1 | {-# LANGUAGE OverloadedStrings #-} | ||
| 2 | {-# LANGUAGE OverloadedLists #-} | ||
| 3 | |||
| 1 | import Events.Types | 4 | import Events.Types |
| 5 | import Events.Spec | ||
| 6 | |||
| 7 | import qualified Data.Yaml as Yaml | ||
| 8 | import qualified Data.ByteString.Char8 as CBS | ||
| 9 | |||
| 10 | import Control.Lens | ||
| 11 | import Control.Monad | ||
| 12 | import Control.Monad.Trans | ||
| 13 | import Data.Aeson.Lens | ||
| 14 | import Data.Aeson | ||
| 15 | |||
| 16 | import Debug.Trace | ||
| 17 | |||
| 18 | import qualified ListT | ||
| 2 | 19 | ||
| 3 | main :: IO () | 20 | main :: IO () |
| 4 | main = undefined | 21 | main = test $ [ -- Nop |
| 22 | -- , Override [("blub", String "Haha!")] | ||
| 23 | --, Occurs (BoolLit True) | ||
| 24 | ] | ||
| 25 | where | ||
| 26 | test = CBS.putStr . Yaml.encode <=< evaluate . interpret | ||
