diff options
Diffstat (limited to 'events/src/Events/Spec')
-rw-r--r-- | events/src/Events/Spec/Parse.hs | 26 | ||||
-rw-r--r-- | events/src/Events/Spec/Parse/AST.hs | 19 | ||||
-rw-r--r-- | events/src/Events/Spec/Parse/Token.hs | 43 |
3 files changed, 78 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 | ||
4 | module Events.Spec.Parse | 4 | module Events.Spec.Parse |
5 | ( parse | 5 | ( parse |
6 | , ParseError(..) | 6 | , ParseError(..) |
7 | , TypeError(..) | ||
7 | ) where | 8 | ) where |
8 | 9 | ||
9 | import Events.Spec.Types | 10 | import Events.Spec.Types |
11 | import Events.Spec.Parse.Token | ||
12 | import Events.Spec.Parse.AST | ||
10 | 13 | ||
11 | import Text.Parsec hiding (parse, ParseError) | 14 | import Text.Megaparsec hiding (parse) |
12 | import qualified Text.Parsec as Parsec (parse, ParseError) | 15 | import qualified Text.Megaparsec.Lexer as L |
13 | 16 | ||
14 | import Data.Text (Text) | 17 | import Data.Text (Text) |
15 | import qualified Data.Text as Text | 18 | import qualified Data.Text as Text |
@@ -23,13 +26,16 @@ import Data.Typeable (Typeable) | |||
23 | import Control.Monad.Catch (Exception(..), MonadThrow(..)) | 26 | import Control.Monad.Catch (Exception(..), MonadThrow(..)) |
24 | 27 | ||
25 | 28 | ||
26 | newtype ParseError = ParseError Parsec.ParseError | 29 | data TypeError = TypeError |
27 | deriving (Typeable, Show, Eq) | 30 | deriving (Typeable, Show) |
28 | instance Exception ParseError | ||
29 | 31 | ||
32 | instance Exception TypeError | ||
30 | 33 | ||
31 | parse :: MonadThrow m => SourceName -> Lazy.Text -> Eval m (Spec m) | ||
32 | parse name = either (throwM . ParseError) return <=< runParserT pSpec () name | ||
33 | 34 | ||
34 | pSpec :: ParsecT Lazy.Text () (Eval m) (Spec m) | 35 | parse :: (MonadIO m, MonadThrow m) => String -> Lazy.Text -> m (Spec m) |
35 | pSpec = mzero | 36 | parse name = typecheck <=< runParserT' pAST name <=< runParserT' pTokens name |
37 | where | ||
38 | runParserT' parser name = either throwM return <=< runParserT parser name | ||
39 | |||
40 | typecheck :: MonadThrow m => AST -> m (Spec m) | ||
41 | typecheck = undefined | ||
diff --git a/events/src/Events/Spec/Parse/AST.hs b/events/src/Events/Spec/Parse/AST.hs new file mode 100644 index 0000000..38c2c84 --- /dev/null +++ b/events/src/Events/Spec/Parse/AST.hs | |||
@@ -0,0 +1,19 @@ | |||
1 | {-# LANGUAGE GADTs, DataKinds, OverloadedStrings #-} | ||
2 | |||
3 | module Events.Spec.Parse.AST | ||
4 | ( AST(..) | ||
5 | , pAST | ||
6 | ) where | ||
7 | |||
8 | import Events.Spec.Types | ||
9 | import Events.Spec.Parse.Token | ||
10 | |||
11 | import Text.Megaparsec hiding (parse) | ||
12 | |||
13 | import Data.Typeable (Typeable) | ||
14 | |||
15 | data AST = AST | ||
16 | deriving (Typeable) | ||
17 | |||
18 | pAST :: ParsecT Dec [SpecToken] m AST | ||
19 | pAST = mzero {- TODO -} | ||
diff --git a/events/src/Events/Spec/Parse/Token.hs b/events/src/Events/Spec/Parse/Token.hs new file mode 100644 index 0000000..df6f09e --- /dev/null +++ b/events/src/Events/Spec/Parse/Token.hs | |||
@@ -0,0 +1,43 @@ | |||
1 | {-# LANGUAGE GADTs, DataKinds, OverloadedStrings #-} | ||
2 | {-# LANGUAGE StandaloneDeriving #-} | ||
3 | {-# LANGUAGE FlexibleInstances, TypeFamilies #-} | ||
4 | |||
5 | module Events.Spec.Parse.Token | ||
6 | ( SpecToken(..) | ||
7 | , pToken, pTokens | ||
8 | ) where | ||
9 | |||
10 | import Events.Spec.Types | ||
11 | |||
12 | import Text.Megaparsec hiding (parse) | ||
13 | import Text.Megaparsec.Pos | ||
14 | import qualified Text.Megaparsec.Lexer as L | ||
15 | |||
16 | import Data.Typeable (Typeable) | ||
17 | |||
18 | import Data.Text (Text) | ||
19 | import qualified Data.Text as Text | ||
20 | |||
21 | import Data.Text.Lazy as Lazy (Text) | ||
22 | import qualified Data.Text.Lazy as Lazy.Text | ||
23 | |||
24 | data SpecToken = Token | ||
25 | deriving (Typeable, Show, Eq, Ord) | ||
26 | |||
27 | instance Stream [SpecToken] where | ||
28 | type Token [SpecToken] = SpecToken | ||
29 | |||
30 | uncons [] = Nothing | ||
31 | uncons (s:ss) = Just (s, ss) | ||
32 | |||
33 | updatePos = undefined | ||
34 | |||
35 | |||
36 | tSpace :: ParsecT Dec Lazy.Text m () | ||
37 | tSpace = L.space (() <$ spaceChar) (L.skipLineComment "--") (L.skipBlockComment "{-" "-}") | ||
38 | |||
39 | pToken :: ParsecT Dec Lazy.Text m SpecToken | ||
40 | pToken = mzero {- TODO -} | ||
41 | |||
42 | pTokens :: ParsecT Dec Lazy.Text m [SpecToken] | ||
43 | pTokens = manyTill (tSpace *> pToken <* tSpace) eof | ||