summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--events/events.cabal8
-rw-r--r--events/events.nix12
-rw-r--r--events/src/Events/Spec.hs11
-rw-r--r--events/src/Events/Spec/Parse.hs24
-rw-r--r--events/src/Events/Spec/Types.hs13
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}:
5mkDerivation { 6mkDerivation {
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 @@
3module Events.Spec 3module 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
8import Events.Types
9import Events.Spec.Types 9import Events.Spec.Types
10import Events.Spec.Eval 10import Events.Spec.Eval
11 11
12import Events.Spec.Parse
13
12import Control.Monad ((<=<)) 14import Control.Monad ((<=<))
13import Control.Monad.IO.Class 15import Control.Monad.IO.Class
14import Control.Monad.State.Lazy 16import Control.Monad.State.Lazy
@@ -19,13 +21,6 @@ import Control.Lens
19 21
20import Debug.Trace 22import Debug.Trace
21 23
22type Spec m = Expr (Eval m) '[] Cmnd -- most significant last
23
24data Cmnd = COverride Object
25 | COccurs Bool
26 | CNop
27 deriving (Show)
28
29interpret :: MonadIO m => Spec m -> Eval m () 24interpret :: MonadIO m => Spec m -> Eval m ()
30interpret = join . fmap interpretCmnd . evalExpr 25interpret = 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
3module Events.Spec.Parse
4 ( parse
5 , Position(..), ParseError(..)
6 ) where
7
8import Data.Conduit.Attoparsec
9import Data.Conduit
10
11import Data.Attoparsec.Text hiding (parse)
12
13import Data.Text (Text)
14import qualified Data.Text as T
15
16import Events.Spec.Types
17
18import Control.Monad.Catch (MonadThrow)
19
20parse :: MonadThrow m => Consumer Text m (Spec m)
21parse = sinkParser $ (tokenize >>= pSpec) <* endOfInput
22
23pSpec :: Monad m => Parser (Spec m)
24pSpec = 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 @@
3module Events.Spec.Types 3module 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
14import Events.Types
15
11data Expr :: (* -> *) -> [*] -> * -> * where 16data 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
26type Spec m = Expr (Eval m) '[] Cmnd
27
28data Cmnd = COverride Object
29 | COccurs Bool
30 | CNop
31 deriving (Show)
32
21data Elem :: a -> [a] -> * where 33data 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]
30type instance '[] ++ ys = ys 42type instance '[] ++ ys = ys
31type instance (x ': xs) ++ ys = x ': (xs ++ ys) 43type instance (x ': xs) ++ ys = x ': (xs ++ ys)
32infixr 5 ++ 44infixr 5 ++
45