diff options
-rw-r--r-- | events/events.cabal | 8 | ||||
-rw-r--r-- | events/events.nix | 12 | ||||
-rw-r--r-- | events/src/Events/Spec.hs | 11 | ||||
-rw-r--r-- | events/src/Events/Spec/Parse.hs | 24 | ||||
-rw-r--r-- | events/src/Events/Spec/Types.hs | 13 |
5 files changed, 55 insertions, 13 deletions
diff --git a/events/events.cabal b/events/events.cabal index 93a2daf..4ab12fd 100644 --- a/events/events.cabal +++ b/events/events.cabal | |||
@@ -21,6 +21,9 @@ executable events | |||
21 | other-modules: Events.Types | 21 | other-modules: Events.Types |
22 | , Events.Types.NDT | 22 | , Events.Types.NDT |
23 | , Events.Eval | 23 | , Events.Eval |
24 | , Events.Spec | ||
25 | , Events.Spec.Types | ||
26 | , Events.Spec.Eval | ||
24 | -- other-extensions: | 27 | -- other-extensions: |
25 | build-depends: base >=4.8 && <5 | 28 | build-depends: base >=4.8 && <5 |
26 | , lens >=4.13 && <5 | 29 | , lens >=4.13 && <5 |
@@ -36,5 +39,10 @@ executable events | |||
36 | , transformers >=0.4.2 && <1 | 39 | , transformers >=0.4.2 && <1 |
37 | , list-t >=0.4.6 && <1 | 40 | , list-t >=0.4.6 && <1 |
38 | , data-default-class >=0.0.1 && <1 | 41 | , data-default-class >=0.0.1 && <1 |
42 | , text >=1.2.2.1 && <2 | ||
43 | , conduit >=1.2.6.6 && <2 | ||
44 | , conduit-extra >=1.1.13.2 && <2 | ||
45 | , attoparsec >=0.13.0.2 && <1 | ||
46 | , exceptions >=0.8.3 && <1 | ||
39 | hs-source-dirs: src | 47 | hs-source-dirs: src |
40 | default-language: Haskell2010 \ No newline at end of file | 48 | default-language: Haskell2010 \ No newline at end of file |
diff --git a/events/events.nix b/events/events.nix index 26f598b..3f5d798 100644 --- a/events/events.nix +++ b/events/events.nix | |||
@@ -1,6 +1,7 @@ | |||
1 | { mkDerivation, aeson, aeson-lens, base, bytestring | 1 | { mkDerivation, aeson, aeson-lens, attoparsec, base, bytestring |
2 | , data-default-class, lens, lens-time, list-t, mmorph, mtl, stdenv | 2 | , conduit, conduit-extra, data-default-class, exceptions, lens |
3 | , time, transformers, tz, yaml | 3 | , lens-time, list-t, mmorph, mtl, stdenv, text, time, transformers |
4 | , tz, yaml | ||
4 | }: | 5 | }: |
5 | mkDerivation { | 6 | mkDerivation { |
6 | pname = "events"; | 7 | pname = "events"; |
@@ -9,8 +10,9 @@ mkDerivation { | |||
9 | isLibrary = false; | 10 | isLibrary = false; |
10 | isExecutable = true; | 11 | isExecutable = true; |
11 | executableHaskellDepends = [ | 12 | executableHaskellDepends = [ |
12 | aeson aeson-lens base bytestring data-default-class lens lens-time | 13 | aeson aeson-lens attoparsec base bytestring conduit conduit-extra |
13 | list-t mmorph mtl time transformers tz yaml | 14 | data-default-class exceptions lens lens-time list-t mmorph mtl text |
15 | time transformers tz yaml | ||
14 | ]; | 16 | ]; |
15 | homepage = "https://git.yggdrasil.li/gkleen/pub/events"; | 17 | homepage = "https://git.yggdrasil.li/gkleen/pub/events"; |
16 | description = "An appointment book"; | 18 | description = "An appointment book"; |
diff --git a/events/src/Events/Spec.hs b/events/src/Events/Spec.hs index e098886..cfa75be 100644 --- a/events/src/Events/Spec.hs +++ b/events/src/Events/Spec.hs | |||
@@ -3,12 +3,14 @@ | |||
3 | module Events.Spec | 3 | module Events.Spec |
4 | ( interpret | 4 | ( interpret |
5 | , Spec, Cmnd(..), Expr(..), Elem(..) | 5 | , Spec, Cmnd(..), Expr(..), Elem(..) |
6 | , module Events.Spec.Parse | ||
6 | ) where | 7 | ) where |
7 | 8 | ||
8 | import Events.Types | ||
9 | import Events.Spec.Types | 9 | import Events.Spec.Types |
10 | import Events.Spec.Eval | 10 | import Events.Spec.Eval |
11 | 11 | ||
12 | import Events.Spec.Parse | ||
13 | |||
12 | import Control.Monad ((<=<)) | 14 | import Control.Monad ((<=<)) |
13 | import Control.Monad.IO.Class | 15 | import Control.Monad.IO.Class |
14 | import Control.Monad.State.Lazy | 16 | import Control.Monad.State.Lazy |
@@ -19,13 +21,6 @@ import Control.Lens | |||
19 | 21 | ||
20 | import Debug.Trace | 22 | import Debug.Trace |
21 | 23 | ||
22 | type Spec m = Expr (Eval m) '[] Cmnd -- most significant last | ||
23 | |||
24 | data Cmnd = COverride Object | ||
25 | | COccurs Bool | ||
26 | | CNop | ||
27 | deriving (Show) | ||
28 | |||
29 | interpret :: MonadIO m => Spec m -> Eval m () | 24 | interpret :: MonadIO m => Spec m -> Eval m () |
30 | interpret = join . fmap interpretCmnd . evalExpr | 25 | interpret = join . fmap interpretCmnd . evalExpr |
31 | 26 | ||
diff --git a/events/src/Events/Spec/Parse.hs b/events/src/Events/Spec/Parse.hs new file mode 100644 index 0000000..912a308 --- /dev/null +++ b/events/src/Events/Spec/Parse.hs | |||
@@ -0,0 +1,24 @@ | |||
1 | {-# LANGUAGE GADTs, DataKinds, OverloadedStrings #-} | ||
2 | |||
3 | module Events.Spec.Parse | ||
4 | ( parse | ||
5 | , Position(..), ParseError(..) | ||
6 | ) where | ||
7 | |||
8 | import Data.Conduit.Attoparsec | ||
9 | import Data.Conduit | ||
10 | |||
11 | import Data.Attoparsec.Text hiding (parse) | ||
12 | |||
13 | import Data.Text (Text) | ||
14 | import qualified Data.Text as T | ||
15 | |||
16 | import Events.Spec.Types | ||
17 | |||
18 | import Control.Monad.Catch (MonadThrow) | ||
19 | |||
20 | parse :: MonadThrow m => Consumer Text m (Spec m) | ||
21 | parse = sinkParser $ (tokenize >>= pSpec) <* endOfInput | ||
22 | |||
23 | pSpec :: Monad m => Parser (Spec m) | ||
24 | pSpec = mzero | ||
diff --git a/events/src/Events/Spec/Types.hs b/events/src/Events/Spec/Types.hs index 665958d..5216f46 100644 --- a/events/src/Events/Spec/Types.hs +++ b/events/src/Events/Spec/Types.hs | |||
@@ -3,11 +3,16 @@ | |||
3 | module Events.Spec.Types | 3 | module Events.Spec.Types |
4 | ( Expr(..) | 4 | ( Expr(..) |
5 | , Val(..) | 5 | , Val(..) |
6 | , Spec | ||
7 | , Cmnd(..) | ||
6 | , Elem(..) | 8 | , Elem(..) |
7 | , Length(..) | 9 | , Length(..) |
8 | , type (++)(..) | 10 | , type (++)(..) |
11 | , module Events.Types | ||
9 | ) where | 12 | ) where |
10 | 13 | ||
14 | import Events.Types | ||
15 | |||
11 | data Expr :: (* -> *) -> [*] -> * -> * where | 16 | data Expr :: (* -> *) -> [*] -> * -> * where |
12 | ELit :: Val m a -> Expr m ctx a | 17 | ELit :: Val m a -> Expr m ctx a |
13 | EVar :: Elem a ctx -> Expr m ctx a | 18 | EVar :: Elem a ctx -> Expr m ctx a |
@@ -18,6 +23,13 @@ type family Val m a where | |||
18 | Val m (a -> b) = Expr m '[a] b | 23 | Val m (a -> b) = Expr m '[a] b |
19 | Val m a = m a | 24 | Val m a = m a |
20 | 25 | ||
26 | type Spec m = Expr (Eval m) '[] Cmnd | ||
27 | |||
28 | data Cmnd = COverride Object | ||
29 | | COccurs Bool | ||
30 | | CNop | ||
31 | deriving (Show) | ||
32 | |||
21 | data Elem :: a -> [a] -> * where | 33 | data Elem :: a -> [a] -> * where |
22 | EZ :: Elem x (x ': xs) | 34 | EZ :: Elem x (x ': xs) |
23 | ES :: Elem x xs -> Elem x (y ': xs) | 35 | ES :: Elem x xs -> Elem x (y ': xs) |
@@ -30,3 +42,4 @@ type family (xs :: [a]) ++ (ys :: [a]) :: [a] | |||
30 | type instance '[] ++ ys = ys | 42 | type instance '[] ++ ys = ys |
31 | type instance (x ': xs) ++ ys = x ': (xs ++ ys) | 43 | type instance (x ': xs) ++ ys = x ': (xs ++ ys) |
32 | infixr 5 ++ | 44 | infixr 5 ++ |
45 | |||