From b16e56a555b37c5d0c01074b6c6a0dbcbb100bfe Mon Sep 17 00:00:00 2001
From: Gregor Kleen <pngwjpgh@users.noreply.github.com>
Date: Sun, 31 Jul 2016 18:47:51 +0200
Subject: framework for parsing Specs

---
 events/src/Events/Spec.hs       | 11 +++--------
 events/src/Events/Spec/Parse.hs | 24 ++++++++++++++++++++++++
 events/src/Events/Spec/Types.hs | 13 +++++++++++++
 3 files changed, 40 insertions(+), 8 deletions(-)
 create mode 100644 events/src/Events/Spec/Parse.hs

(limited to 'events/src/Events')

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 ++
+
-- 
cgit v1.2.3