diff --git a/JsonGrammar.cabal b/JsonGrammar.cabal --- a/JsonGrammar.cabal +++ b/JsonGrammar.cabal @@ -1,5 +1,5 @@ Name: JsonGrammar -Version: 1.0 +Version: 1.0.1 Synopsis: Combinators for bidirectional JSON parsing Description: Combinators for bidirectional JSON parsing @@ -32,11 +32,11 @@ Language.JsonGrammar.Serializer, Language.JsonGrammar.Util Build-Depends: base >= 3.0 && < 5, - aeson >= 0.6 && < 0.8, - semigroups >= 0.5 && < 0.16, + aeson >= 0.6 && < 0.9, + semigroups >= 0.5 && < 0.17, language-typescript >= 0.0.4 && < 0.1, mtl >= 2.1 && < 2.3, - stack-prism < 0.2, + stack-prism >= 0.1 && < 0.2, -- constraints copied from aeson-0.6.1.0: attoparsec >= 0.8.6.1, bytestring, @@ -54,9 +54,9 @@ Main-Is: Tests.hs Other-Modules: Types Build-Depends: JsonGrammar, - stack-prism < 0.2, + stack-prism >= 0.1 && < 0.2, base >= 3.0 && < 5, - aeson >= 0.6 && < 0.8, + aeson >= 0.6 && < 0.9, language-typescript >= 0.0.4 && < 0.1, text >= 0.11.0.2, test-framework >= 0.8 && < 0.9, diff --git a/Setup.hs b/Setup.hs --- a/Setup.hs +++ b/Setup.hs @@ -1,2 +1,3 @@ import Distribution.Simple + main = defaultMain diff --git a/src/Language/JsonGrammar.hs b/src/Language/JsonGrammar.hs --- a/src/Language/JsonGrammar.hs +++ b/src/Language/JsonGrammar.hs @@ -27,7 +27,7 @@ ) where -import Prelude hiding ((.)) +import Prelude (Monad(..), Maybe(..)) import Control.Category ((.)) import Data.Aeson.Types (Parser) @@ -83,11 +83,11 @@ -- > interface Person {age : number ;name : string ;} -- | Parse a JSON value according to the specified grammar. -parse :: Grammar Val (a :- ()) (b :- ()) -> a -> Parser b +parse :: Grammar 'Val (a :- ()) (b :- ()) -> a -> Parser b parse = parseValue . unstack -- | Serialize a Haskell value to a JSON value according to the specified grammar. -serialize :: Grammar Val (a :- ()) (b :- ()) -> b -> Maybe a +serialize :: Grammar 'Val (a :- ()) (b :- ()) -> b -> Maybe a serialize = serializeValue . unstack unstack :: Grammar c (a :- ()) (b :- ()) -> Grammar c a b diff --git a/src/Language/JsonGrammar/Grammar.hs b/src/Language/JsonGrammar/Grammar.hs --- a/src/Language/JsonGrammar/Grammar.hs +++ b/src/Language/JsonGrammar/Grammar.hs @@ -14,7 +14,7 @@ Json(..), el, prop ) where -import Prelude hiding (id, (.)) +import Prelude (Maybe(..), Monad(..), Int, Float, Eq(..)) import Control.Applicative ((<$>)) import Control.Category (Category(..)) import Data.Aeson (Value, FromJSON(..), ToJSON(..)) @@ -47,17 +47,17 @@ Pure :: (t1 -> Parser t2) -> (t2 -> Maybe t1) -> Grammar c t1 t2 Many :: Grammar c t t -> Grammar c t t - Literal :: Value -> Grammar Val (Value :- t) t + Literal :: Value -> Grammar 'Val (Value :- t) t - Label :: Text -> Grammar Val t1 t2 -> Grammar Val t1 t2 + Label :: Text -> Grammar 'Val t1 t2 -> Grammar 'Val t1 t2 - Object :: Grammar Obj t1 t2 -> Grammar Val (Value :- t1) t2 - Property :: Text -> Grammar Val (Value :- t1) t2 -> Grammar Obj t1 t2 + Object :: Grammar 'Obj t1 t2 -> Grammar 'Val (Value :- t1) t2 + Property :: Text -> Grammar 'Val (Value :- t1) t2 -> Grammar 'Obj t1 t2 - Array :: Grammar Arr t1 t2 -> Grammar Val (Value :- t1) t2 - Element :: Grammar Val (Value :- t1) t2 -> Grammar Arr t1 t2 + Array :: Grammar 'Arr t1 t2 -> Grammar 'Val (Value :- t1) t2 + Element :: Grammar 'Val (Value :- t1) t2 -> Grammar 'Arr t1 t2 - Coerce :: Type -> Grammar Val t1 t2 -> Grammar Val t1 t2 + Coerce :: Type -> Grammar 'Val t1 t2 -> Grammar 'Val t1 t2 -- | The '.' operator is the main way to compose two grammars. instance Category (Grammar c) where @@ -70,7 +70,7 @@ mappend = (:<>) -- | String literals convert to grammars that expect or produce a specific JSON string 'literal' value. -instance IsString (Grammar Val (Value :- t) t) where +instance IsString (Grammar 'Val (Value :- t) t) where fromString = literal . fromString @@ -87,15 +87,15 @@ many = Many -- | Expect or produce a literal JSON 'Value'. You can only use this constructor in the value context 'Val'. -literal :: Value -> Grammar Val (Value :- t) t +literal :: Value -> Grammar 'Val (Value :- t) t literal = Literal -- | Label a value grammar with a name. This doesn't affect the JSON conversion itself, but it generates an interface definition when converting to TypeScript 'interfaces'. -label :: Text -> Grammar Val t1 t2 -> Grammar Val t1 t2 +label :: Text -> Grammar 'Val t1 t2 -> Grammar 'Val t1 t2 label = Label -- | Expect or produce a JSON object whose properties match the specified 'Obj' grammar. You can create 'Obj' grammars using 'property'. Alternatively, if you want to match an empty object, use @object 'id'@. -object :: Grammar Obj t1 t2 -> Grammar Val (Value :- t1) t2 +object :: Grammar 'Obj t1 t2 -> Grammar 'Val (Value :- t1) t2 object = Object -- | Expect or produce an object property with the specified name, and a value that can be parsed/produced by the specified grammar. This function creates a grammar in the 'Obj' context. You can combine multiple @property@ grammars using the '.' operator from 'Category'. @@ -104,23 +104,23 @@ -- -- > grammar = object (propertiesA <> propertiesB) -- > where --- > propertiesA = property "type" "A" . fromPiso constructorA . prop "foo" --- > propertiesB = property "type" "B" . fromPiso constructorB . prop "bar" . prop "baz" -property :: Text -> Grammar Val (Value :- t1) t2 -> Grammar Obj t1 t2 +-- > propertiesA = property "type" "A" . fromPrism constructorA . prop "foo" +-- > propertiesB = property "type" "B" . fromPrism constructorB . prop "bar" . prop "baz" +property :: Text -> Grammar 'Val (Value :- t1) t2 -> Grammar 'Obj t1 t2 property = Property -- | Expect or produce a JSON array value whose contents match the specified 'Arr' grammar. You can create 'Arr' grammars using 'element'. Alternatively, if you want to match an empty array, use @array 'id'@. -array :: Grammar Arr t1 t2 -> Grammar Val (Value :- t1) t2 +array :: Grammar 'Arr t1 t2 -> Grammar 'Val (Value :- t1) t2 array = Array -- | Expect or produce a JSON array element whose value matches the specified 'Val' grammar. -element :: Grammar Val (Value :- t1) t2 -> Grammar Arr t1 t2 +element :: Grammar 'Val (Value :- t1) t2 -> Grammar 'Arr t1 t2 element = Element -- | Mark a grammar to be of a specific TypeScript type. This doesn't affect the JSON conversion, but when generating TypeScript 'interfaces' a coercion causes the interface generator to stop looking at the underlying grammar and just use the specified TypeScript 'Type' as inferred type instead. -- -- This is useful if you write a grammar that, for example, wraps a primitive type like string (in which case you would specify @'Predefined' 'StringType'@ as type). Another use is when you find the generated interface can't be described by a 'Grammar', for example because it uses a generic type parameter. -coerce :: Type -> Grammar Val t1 t2 -> Grammar Val t1 t2 +coerce :: Type -> Grammar 'Val t1 t2 -> Grammar 'Val t1 t2 coerce = Coerce @@ -158,7 +158,7 @@ -- | A type class for types that can be converted from and to JSON using a 'Grammar'. The grammar is expected to be in the value context 'Val' and consumes (or produces) a JSON 'Value'. class Json a where - grammar :: Grammar Val (Value :- t) (a :- t) + grammar :: Grammar 'Val (Value :- t) (a :- t) instance Json Text where grammar = Coerce (Predefined StringType) liftAeson instance Json Int where grammar = Coerce (Predefined NumberType) liftAeson @@ -183,11 +183,11 @@ g (x :- t) = Just (toJSON x :- t) -- | Expect or produce an object 'property' whose value grammar is specified by 'grammar'. -prop :: Json a => Text -> Grammar Obj t (a :- t) +prop :: Json a => Text -> Grammar 'Obj t (a :- t) prop n = Property n grammar -- | Expect or produce an array 'element' whose value grammar is specified by 'grammar'. -el :: Json a => Grammar Arr t (a :- t) +el :: Json a => Grammar 'Arr t (a :- t) el = Element grammar -- | Create a 'pure' grammar that expects or produces a specific Haskell value. diff --git a/src/Language/JsonGrammar/Parser.hs b/src/Language/JsonGrammar/Parser.hs --- a/src/Language/JsonGrammar/Parser.hs +++ b/src/Language/JsonGrammar/Parser.hs @@ -17,7 +17,7 @@ -- | Convert a 'Grammar' to a JSON 'Parser'. -parseValue :: Grammar Val t1 t2 -> t1 -> Parser t2 +parseValue :: Grammar 'Val t1 t2 -> t1 -> Parser t2 parseValue = \case Id -> return g1 :. g2 -> parseValue g2 >=> parseValue g1 @@ -45,7 +45,7 @@ -parseProperties :: Object -> Grammar Obj t1 t2 -> t1 -> Parser t2 +parseProperties :: Object -> Grammar 'Obj t1 t2 -> t1 -> Parser t2 parseProperties obj = \case Id -> return g1 :. g2 -> parseProperties obj g2 >=> parseProperties obj g1 @@ -61,7 +61,7 @@ parseValue g (val :- x) -parseElements :: Grammar Arr t1 t2 -> (Array, t1) -> Parser (Array, t2) +parseElements :: Grammar 'Arr t1 t2 -> (Array, t1) -> Parser (Array, t2) parseElements = \case Id -> return g1 :. g2 -> parseElements g2 >=> parseElements g1 diff --git a/src/Language/JsonGrammar/Serializer.hs b/src/Language/JsonGrammar/Serializer.hs --- a/src/Language/JsonGrammar/Serializer.hs +++ b/src/Language/JsonGrammar/Serializer.hs @@ -16,7 +16,7 @@ -- | Convert a 'Grammar' to a JSON serializer. -serializeValue :: Grammar Val t1 t2 -> t2 -> Maybe t1 +serializeValue :: Grammar 'Val t1 t2 -> t2 -> Maybe t1 serializeValue = \case Id -> return g1 :. g2 -> serializeValue g1 >=> serializeValue g2 @@ -43,7 +43,7 @@ serializeProperties :: - Grammar Obj t1 t2 -> (Ae.Object, t2) -> Maybe (Ae.Object, t1) + Grammar 'Obj t1 t2 -> (Ae.Object, t2) -> Maybe (Ae.Object, t1) serializeProperties = \case Id -> return g1 :. g2 -> serializeProperties g1 >=> serializeProperties g2 @@ -60,7 +60,7 @@ return (H.insert n val obj, y) -serializeElements :: Grammar Arr t1 t2 -> (Ae.Array, t2) -> Maybe (Ae.Array, t1) +serializeElements :: Grammar 'Arr t1 t2 -> (Ae.Array, t2) -> Maybe (Ae.Array, t1) serializeElements = \case Id -> return g1 :. g2 -> serializeElements g1 >=> serializeElements g2 diff --git a/src/Language/JsonGrammar/TypeScript.hs b/src/Language/JsonGrammar/TypeScript.hs --- a/src/Language/JsonGrammar/TypeScript.hs +++ b/src/Language/JsonGrammar/TypeScript.hs @@ -19,10 +19,10 @@ import Language.TypeScript -toType :: GrammarMap -> Grammar Val t1 t2 -> Maybe Type +toType :: GrammarMap -> Grammar 'Val t1 t2 -> Maybe Type toType gm = go where - go :: Grammar Val t1 t2 -> Maybe Type + go :: Grammar 'Val t1 t2 -> Maybe Type go = \case Id -> Nothing g1 :. g2 -> @@ -53,10 +53,10 @@ emptyComment :: CommentPlaceholder emptyComment = Left (0, 0) -toProperties :: GrammarMap -> Grammar Obj t1 t2 -> HashMap Text (Maybe Optional, Type) +toProperties :: GrammarMap -> Grammar 'Obj t1 t2 -> HashMap Text (Maybe Optional, Type) toProperties gm = go where - go :: Grammar Obj t1 t2 -> HashMap Text (Maybe Optional, Type) + go :: Grammar 'Obj t1 t2 -> HashMap Text (Maybe Optional, Type) go = \case Id -> H.empty g1 :. g2 -> @@ -78,10 +78,10 @@ Property n g -> maybe H.empty (\ty -> H.singleton n (Nothing, ty)) (toType gm g) -toElementType :: GrammarMap -> Grammar Arr t1 t2 -> Maybe Type +toElementType :: GrammarMap -> Grammar 'Arr t1 t2 -> Maybe Type toElementType gm = go where - go :: Grammar Arr t1 t2 -> Maybe Type + go :: Grammar 'Arr t1 t2 -> Maybe Type go = \case Id -> Nothing g1 :. g2 -> unify <$> go g1 <*> go g2 @@ -129,9 +129,9 @@ Ae.Bool _ -> Predefined BooleanType Ae.Null -> Predefined VoidType -- TODO -type GrammarMap = HashMap Text (SomeGrammar Val) +type GrammarMap = HashMap Text (SomeGrammar 'Val) -grammarMap :: [SomeGrammar Val] -> GrammarMap +grammarMap :: [SomeGrammar 'Val] -> GrammarMap grammarMap gs = execState (mapM_ (\(SomeGrammar g) -> buildGrammarMap g) gs) H.empty where @@ -167,7 +167,7 @@ SomeGrammar :: Grammar c t1 t2 -> SomeGrammar c -- | Generate a list of TypeScript interface declarations from the specified grammars. -interfaces :: [SomeGrammar Val] -> [DeclarationElement] +interfaces :: [SomeGrammar 'Val] -> [DeclarationElement] interfaces gs = tys where gm = grammarMap gs diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -73,8 +73,8 @@ printInterfaces [SomeGrammar personGrammar] defaultMain [test1, test2] -personGrammar :: Grammar Val (Value :- t) (Person :- t) +personGrammar :: Grammar 'Val (Value :- t) (Person :- t) personGrammar = grammar -printInterfaces :: [SomeGrammar Val] -> IO () +printInterfaces :: [SomeGrammar 'Val] -> IO () printInterfaces gs = putStrLn (renderDeclarationSourceFile (interfaces gs))