diff options
Diffstat (limited to 'fig-bless/src')
| -rw-r--r-- | fig-bless/src/Fig/Bless/Runtime.hs | 13 | ||||
| -rw-r--r-- | fig-bless/src/Fig/Bless/Syntax.hs | 32 | ||||
| -rw-r--r-- | fig-bless/src/Fig/Bless/TypeChecker.hs | 7 | ||||
| -rw-r--r-- | fig-bless/src/Fig/Bless/Types.hs | 8 |
4 files changed, 44 insertions, 16 deletions
diff --git a/fig-bless/src/Fig/Bless/Runtime.hs b/fig-bless/src/Fig/Bless/Runtime.hs index cc19437..cbef849 100644 --- a/fig-bless/src/Fig/Bless/Runtime.hs +++ b/fig-bless/src/Fig/Bless/Runtime.hs @@ -19,6 +19,8 @@ import qualified Data.Text as Text import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map +import qualified Data.Aeson as Aeson + import Fig.Bless.Types import qualified Fig.Bless.Syntax as Syn @@ -28,7 +30,8 @@ data ValueF t v | ValueString Text | ValueProgram (Syn.ProgramF t) | ValueArray [v] - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance (Aeson.ToJSON t, Aeson.ToJSON v) => Aeson.ToJSON (ValueF t v) instance (Pretty t, Pretty v) => Pretty (ValueF t v) where pretty (ValueInteger i) = tshow i pretty (ValueDouble d) = tshow d @@ -48,7 +51,8 @@ data ValueSort | ValueSortWord | ValueSortProgram | ValueSortArray - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Aeson.ToJSON ValueSort instance Pretty ValueSort where pretty ValueSortInteger = "integer" pretty ValueSortDouble = "double" @@ -56,7 +60,6 @@ instance Pretty ValueSort where pretty ValueSortWord = "word" pretty ValueSortProgram = "program" pretty ValueSortArray = "list" - valueSort :: ValueF t v -> ValueSort valueSort (ValueInteger _) = ValueSortInteger valueSort (ValueDouble _) = ValueSortDouble @@ -69,14 +72,14 @@ data RuntimeError t | RuntimeErrorOutOfFuel (Maybe t) | RuntimeErrorStackUnderflow (Maybe t) | RuntimeErrorSortMismatch (Maybe t) ValueSort ValueSort - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) instance (Show t, Typeable t) => Exception (RuntimeError t) +instance Aeson.ToJSON t => Aeson.ToJSON (RuntimeError t) runtimeErrorPrefix :: Pretty t => Maybe t -> Text runtimeErrorPrefix Nothing = "" runtimeErrorPrefix (Just t) = mconcat [ "while evaluating term: ", pretty t, "\n" ] - instance Pretty t => Pretty (RuntimeError t) where pretty (RuntimeErrorWordNotFound t w) = mconcat [ runtimeErrorPrefix t diff --git a/fig-bless/src/Fig/Bless/Syntax.hs b/fig-bless/src/Fig/Bless/Syntax.hs index b58c516..fc43917 100644 --- a/fig-bless/src/Fig/Bless/Syntax.hs +++ b/fig-bless/src/Fig/Bless/Syntax.hs @@ -27,8 +27,11 @@ import qualified Text.Megaparsec as P import qualified Text.Megaparsec.Char as P.C import qualified Text.Megaparsec.Char.Lexer as P.C.L +import qualified Data.Aeson as Aeson + newtype Word = Word Text - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Aeson.ToJSON Word instance IsString Word where fromString = Word . fromString instance Pretty Word where @@ -38,14 +41,16 @@ data Literal = LiteralInteger Integer | LiteralDouble Double | LiteralString Text - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Aeson.ToJSON Literal instance Pretty Literal where pretty (LiteralInteger i) = tshow i pretty (LiteralDouble d) = tshow d pretty (LiteralString s) = tshow s newtype ProgramF t = Program [t] - deriving (Show, Eq, Ord, Functor) + deriving (Show, Eq, Ord, Generic, Functor) +instance Aeson.ToJSON t => Aeson.ToJSON (ProgramF t) instance Pretty t => Pretty (ProgramF t) where pretty (Program ts) = unwords $ pretty <$> ts type Program = ProgramF (Fix TermF) @@ -54,7 +59,8 @@ data TermF t = TermWord Word | TermLiteral Literal | TermQuote (ProgramF t) - deriving (Show, Eq, Ord, Functor) + deriving (Show, Eq, Ord, Generic, Functor) +instance Aeson.ToJSON t => Aeson.ToJSON (TermF t) instance Pretty t => Pretty (TermF t) where pretty (TermWord w) = pretty w pretty (TermLiteral l) = pretty l @@ -83,7 +89,7 @@ ws = P.C.L.space (P.C.L.skipBlockComment "/*" "*/") wordChar :: Char -> Bool -wordChar c = not $ elem @[] c ['[', ']'] || isSpace c +wordChar c = not $ elem @[] c ['[', ']', '=', ';'] || isSpace c word :: Parser Word word = Word . pack <$> P.some (P.satisfy wordChar) @@ -133,8 +139,14 @@ dictionary :: Parser Dictionary dictionary = dictionaryF $ Fix <$> term newtype ParseError = ParseError (P.ParseErrorBundle Text Void) - deriving (Show) + deriving (Show, Generic) instance Exception ParseError +instance Aeson.ToJSON ParseError where + toJSON (ParseError b) = Aeson.object + [ "errors" Aeson..= Aeson.toJSON (bimap P.parseErrorPretty P.sourcePosPretty <$> posed) + ] + where + (posed, _) = P.attachSourcePos P.errorOffset (P.bundleErrors b) (P.bundlePosState b) instance Pretty ParseError where pretty (ParseError b) = mconcat [ "failed to read program:\n" @@ -146,7 +158,13 @@ data Spanning = Spanning , start :: P.SourcePos , end :: P.SourcePos } - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Aeson.ToJSON Spanning where + toJSON s = Aeson.object + [ "term" Aeson..= Aeson.toJSON s.t + , "start" Aeson..= pack (P.sourcePosPretty s.start) + , "end" Aeson..= pack (P.sourcePosPretty s.end) + ] instance Pretty Spanning where pretty s = mconcat [ pretty s.t, "\n" diff --git a/fig-bless/src/Fig/Bless/TypeChecker.hs b/fig-bless/src/Fig/Bless/TypeChecker.hs index dedc66a..0ee8eaf 100644 --- a/fig-bless/src/Fig/Bless/TypeChecker.hs +++ b/fig-bless/src/Fig/Bless/TypeChecker.hs @@ -10,6 +10,8 @@ import Data.Map.Strict (Map) import qualified Data.Map.Strict as Map import qualified Data.Set as Set +import qualified Data.Aeson as Aeson + import Fig.Bless.Syntax import Fig.Bless.Types import Fig.Bless.Runtime @@ -23,8 +25,9 @@ data TypeError t = TypeErrorWordNotFound (Maybe t) Word | TypeErrorMismatch (Maybe t) BType BType | TypeErrorArityMismatch (Maybe t) BProgType BProgType - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) instance (Show t, Typeable t) => Exception (TypeError t) +instance Aeson.ToJSON t => Aeson.ToJSON (TypeError t) typeErrorPrefix :: Pretty t => Maybe t -> Text typeErrorPrefix Nothing = "" typeErrorPrefix (Just t) = mconcat @@ -142,4 +145,4 @@ checkDictionary env d = foldM } ) env - (reverse d.defs) + d.defs diff --git a/fig-bless/src/Fig/Bless/Types.hs b/fig-bless/src/Fig/Bless/Types.hs index 162358c..ae8d9d4 100644 --- a/fig-bless/src/Fig/Bless/Types.hs +++ b/fig-bless/src/Fig/Bless/Types.hs @@ -7,13 +7,16 @@ import qualified Data.Map.Strict as Map import Data.Set (Set) import qualified Data.Set as Set +import qualified Data.Aeson as Aeson + data BType = BTypeVariable Text | BTypeInteger | BTypeDouble | BTypeString | BTypeProgram BProgType - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Aeson.ToJSON BType instance Pretty BType where pretty (BTypeVariable s) = "!" <> s pretty BTypeInteger = "integer" @@ -25,7 +28,8 @@ data BProgType = BProgType { inp :: [BType] , out :: [BType] } - deriving (Show, Eq, Ord) + deriving (Show, Eq, Ord, Generic) +instance Aeson.ToJSON BProgType instance Pretty BProgType where pretty p = unwords (pretty <$> p.inp) <> " -- " <> unwords (pretty <$> p.out) |
