framework for parsing Specs

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
   other-modules:       Events.Types
                      , Events.Types.NDT
                      , Events.Eval
+                     , Events.Spec
+                     , Events.Spec.Types
+                     , Events.Spec.Eval
   -- other-extensions:    
   build-depends:       base >=4.8 && <5
                      , lens >=4.13 && <5
@@ -36,5 +39,10 @@ executable events
                      , transformers >=0.4.2 && <1
                      , list-t >=0.4.6 && <1
                      , data-default-class >=0.0.1 && <1
+                     , text >=1.2.2.1 && <2
+                     , conduit >=1.2.6.6 && <2
+                     , conduit-extra >=1.1.13.2 && <2
+                     , attoparsec >=0.13.0.2 && <1
+                     , exceptions >=0.8.3 && <1
   hs-source-dirs:      src
   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 @@
-{ mkDerivation, aeson, aeson-lens, base, bytestring
-, data-default-class, lens, lens-time, list-t, mmorph, mtl, stdenv
-, time, transformers, tz, yaml
+{ mkDerivation, aeson, aeson-lens, attoparsec, base, bytestring
+, conduit, conduit-extra, data-default-class, exceptions, lens
+, lens-time, list-t, mmorph, mtl, stdenv, text, time, transformers
+, tz, yaml
 }:
 mkDerivation {
   pname = "events";
@@ -9,8 +10,9 @@ mkDerivation {
   isLibrary = false;
   isExecutable = true;
   executableHaskellDepends = [
-    aeson aeson-lens base bytestring data-default-class lens lens-time
-    list-t mmorph mtl time transformers tz yaml
+    aeson aeson-lens attoparsec base bytestring conduit conduit-extra
+    data-default-class exceptions lens lens-time list-t mmorph mtl text
+    time transformers tz yaml
   ];
   homepage = "https://git.yggdrasil.li/gkleen/pub/events";
   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 @@
 module Events.Spec
        ( interpret
        , Spec, Cmnd(..), Expr(..), Elem(..)
+       , module Events.Spec.Parse
        ) where
 
-import Events.Types
 import Events.Spec.Types
 import Events.Spec.Eval
 
+import Events.Spec.Parse
+
 import Control.Monad ((<=<))
 import Control.Monad.IO.Class
 import Control.Monad.State.Lazy
@@ -19,13 +21,6 @@ import Control.Lens
 
 import Debug.Trace
 
-type Spec m = Expr (Eval m) '[] Cmnd -- most significant last
-
-data Cmnd = COverride Object
-          | COccurs Bool
-          | CNop
-          deriving (Show)
-
 interpret :: MonadIO m => Spec m -> Eval m ()
 interpret = join . fmap interpretCmnd . evalExpr
 
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 @@
+{-# LANGUAGE GADTs, DataKinds, OverloadedStrings #-}
+
+module Events.Spec.Parse
+  ( parse
+  , Position(..), ParseError(..)
+  ) where
+
+import Data.Conduit.Attoparsec
+import Data.Conduit
+
+import Data.Attoparsec.Text hiding (parse)
+
+import Data.Text (Text)
+import qualified Data.Text as T
+
+import Events.Spec.Types
+
+import Control.Monad.Catch (MonadThrow)
+
+parse :: MonadThrow m => Consumer Text m (Spec m)
+parse = sinkParser $ (tokenize >>= pSpec) <* endOfInput
+
+pSpec :: Monad m => Parser (Spec m)
+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 @@
 module Events.Spec.Types
   ( Expr(..)
   , Val(..)
+  , Spec
+  , Cmnd(..)
   , Elem(..)
   , Length(..)
   , type (++)(..)
+  , module Events.Types
   ) where
 
+import Events.Types
+
 data Expr :: (* -> *) -> [*] -> * -> * where
   ELit :: Val m a -> Expr m ctx a
   EVar :: Elem a ctx -> Expr m ctx a
@@ -18,6 +23,13 @@ type family Val m a where
   Val m (a -> b) = Expr m '[a] b
   Val m a        = m a
 
+type Spec m = Expr (Eval m) '[] Cmnd
+
+data Cmnd = COverride Object
+          | COccurs Bool
+          | CNop
+          deriving (Show)
+
 data Elem :: a -> [a] -> * where
   EZ :: Elem x (x ': xs)
   ES :: Elem x xs -> Elem x (y ': xs)
@@ -30,3 +42,4 @@ type family (xs :: [a]) ++ (ys :: [a]) :: [a]
 type instance '[]       ++ ys = ys
 type instance (x ': xs) ++ ys = x ': (xs ++ ys)
 infixr 5 ++
+