summaryrefslogtreecommitdiff
path: root/events/src/Events/Spec/Parse.hs
diff options
context:
space:
mode:
Diffstat (limited to 'events/src/Events/Spec/Parse.hs')
-rw-r--r--events/src/Events/Spec/Parse.hs26
1 files changed, 16 insertions, 10 deletions
diff --git a/events/src/Events/Spec/Parse.hs b/events/src/Events/Spec/Parse.hs
index 44aabd0..2847372 100644
--- a/events/src/Events/Spec/Parse.hs
+++ b/events/src/Events/Spec/Parse.hs
@@ -1,15 +1,18 @@
1{-# LANGUAGE GADTs, DataKinds, OverloadedStrings #-} 1{-# LANGUAGE GADTs, DataKinds, OverloadedStrings #-}
2{-# LANGUAGE StandaloneDeriving #-} 2{-# LANGUAGE StandaloneDeriving, FlexibleContexts #-}
3 3
4module Events.Spec.Parse 4module Events.Spec.Parse
5 ( parse 5 ( parse
6 , ParseError(..) 6 , ParseError(..)
7 , TypeError(..)
7 ) where 8 ) where
8 9
9import Events.Spec.Types 10import Events.Spec.Types
11import Events.Spec.Parse.Token
12import Events.Spec.Parse.AST
10 13
11import Text.Parsec hiding (parse, ParseError) 14import Text.Megaparsec hiding (parse)
12import qualified Text.Parsec as Parsec (parse, ParseError) 15import qualified Text.Megaparsec.Lexer as L
13 16
14import Data.Text (Text) 17import Data.Text (Text)
15import qualified Data.Text as Text 18import qualified Data.Text as Text
@@ -23,13 +26,16 @@ import Data.Typeable (Typeable)
23import Control.Monad.Catch (Exception(..), MonadThrow(..)) 26import Control.Monad.Catch (Exception(..), MonadThrow(..))
24 27
25 28
26newtype ParseError = ParseError Parsec.ParseError 29data TypeError = TypeError
27 deriving (Typeable, Show, Eq) 30 deriving (Typeable, Show)
28instance Exception ParseError
29 31
32instance Exception TypeError
30 33
31parse :: MonadThrow m => SourceName -> Lazy.Text -> Eval m (Spec m)
32parse name = either (throwM . ParseError) return <=< runParserT pSpec () name
33 34
34pSpec :: ParsecT Lazy.Text () (Eval m) (Spec m) 35parse :: (MonadIO m, MonadThrow m) => String -> Lazy.Text -> m (Spec m)
35pSpec = mzero 36parse name = typecheck <=< runParserT' pAST name <=< runParserT' pTokens name
37 where
38 runParserT' parser name = either throwM return <=< runParserT parser name
39
40typecheck :: MonadThrow m => AST -> m (Spec m)
41typecheck = undefined