mirror of
https://github.com/ilyakooo0/elm-bridge.git
synced 2024-09-11 14:05:55 +03:00
Better documentation
This commit is contained in:
parent
f1198a4f1e
commit
d6659740dd
@ -1,8 +1,31 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
{-| This module should be used to derive the Elm instance alongside the
|
||||
JSON ones. The prefered usage is to convert statements such as :
|
||||
|
||||
> $(deriveJSON defaultOptions{fieldLabelModifier = drop 4, constructorTagModifier = map toLower} ''D)
|
||||
|
||||
into:
|
||||
|
||||
> $(deriveBoth defaultOptions{fieldLabelModifier = drop 4, constructorTagModifier = map toLower} ''D)
|
||||
|
||||
Which will derive both the @aeson@ and @elm-bridge@ instances at the same
|
||||
time.
|
||||
-}
|
||||
|
||||
module Elm.Derive
|
||||
( deriveElmDef, deriveBoth, defaultOptions, defaultOptionsDropLower, ElmOptions(..), toAesonOptions, toElmOptions, A.SumEncoding(..) )
|
||||
( -- * Options
|
||||
ElmOptions(..)
|
||||
, toAesonOptions
|
||||
, toElmOptions
|
||||
, A.SumEncoding(..)
|
||||
, defaultOptions
|
||||
, defaultOptionsDropLower
|
||||
-- * Template haskell functions
|
||||
, deriveElmDef
|
||||
, deriveBoth
|
||||
)
|
||||
where
|
||||
|
||||
import Elm.TyRep
|
||||
@ -16,9 +39,12 @@ import Data.Char (toLower)
|
||||
import Control.Applicative
|
||||
import Prelude
|
||||
|
||||
-- | This type is almost identical to that in the `aeson` module, in order
|
||||
-- to maximize compatiblity. The only difference is the added 'makeNewType'
|
||||
-- member.
|
||||
data ElmOptions = ElmOptions
|
||||
{ fieldLabelModifier :: String -> String
|
||||
-- ^ Function applied to field labels.
|
||||
-- ^ Function applied to field labels.
|
||||
-- Handy for removing common record prefixes for example.
|
||||
, constructorTagModifier :: String -> String
|
||||
-- ^ Function applied to constructor tags which could be handy
|
||||
@ -36,7 +62,8 @@ data ElmOptions = ElmOptions
|
||||
-- ^ Specifies how to encode constructors of a sum datatype.
|
||||
, makeNewtype :: Bool
|
||||
-- ^ Elm specific option, generates a "type" instead of a "type alias".
|
||||
-- Doesn't make sense for sum types
|
||||
-- Doesn't make sense for sum types, but is useful to break recursive
|
||||
-- references.
|
||||
}
|
||||
|
||||
toAesonOptions :: ElmOptions -> A.Options
|
||||
@ -45,6 +72,8 @@ toAesonOptions (ElmOptions flm ctm an on se _) = A.Options flm ctm an on se
|
||||
toElmOptions :: A.Options -> ElmOptions
|
||||
toElmOptions (A.Options flm ctm an on se) = ElmOptions flm ctm an on se False
|
||||
|
||||
-- | Note that This default set of options is distinct from that in
|
||||
-- the @aeson@ package.
|
||||
defaultOptions :: ElmOptions
|
||||
defaultOptions = ElmOptions { sumEncoding = ObjectWithSingleField
|
||||
, fieldLabelModifier = id
|
||||
@ -54,20 +83,23 @@ defaultOptions = ElmOptions { sumEncoding = ObjectWithSingleField
|
||||
, makeNewtype = False
|
||||
}
|
||||
|
||||
{-| This generates a default set of options. The parameter represents the
|
||||
number of characters that must be dropped from the Haskell field names.
|
||||
The first letter of the field is then converted to lowercase, ie:
|
||||
|
||||
> data Foo = Foo { _fooBarQux :: Int }
|
||||
> $(deriveBoth (defaultOptionsDropLower 4) ''Foo)
|
||||
|
||||
Will be encoded as:
|
||||
|
||||
> {"barQux"=12}
|
||||
-}
|
||||
defaultOptionsDropLower :: Int -> ElmOptions
|
||||
defaultOptionsDropLower n = defaultOptions { fieldLabelModifier = lower . drop n }
|
||||
where
|
||||
lower "" = ""
|
||||
lower (x:xs) = toLower x : xs
|
||||
|
||||
conCompiler :: String -> String
|
||||
conCompiler s =
|
||||
case s of
|
||||
"Double" -> "Float"
|
||||
"Text" -> "String"
|
||||
"Vector" -> "List"
|
||||
_ -> s
|
||||
|
||||
compileType :: Type -> Q Exp
|
||||
compileType ty =
|
||||
case ty of
|
||||
@ -80,7 +112,7 @@ compileType ty =
|
||||
compileType ty'
|
||||
AppT a b -> [|ETyApp $(compileType a) $(compileType b)|]
|
||||
ConT name ->
|
||||
let n = conCompiler $ nameBase name
|
||||
let n = nameBase name
|
||||
in [|ETyCon (ETCon n)|]
|
||||
_ -> fail $ "Unsupported type: " ++ show ty
|
||||
|
||||
@ -168,9 +200,15 @@ deriveSynonym _ name vars otherT =
|
||||
where
|
||||
otherType = compileType otherT
|
||||
|
||||
-- | Equivalent to running both 'deriveJSON' and 'deriveElmDef' with the
|
||||
-- same options, so as to ensure the code on the Haskell and Elm size is
|
||||
-- synchronized.
|
||||
deriveBoth :: ElmOptions -> Name -> Q [Dec]
|
||||
deriveBoth o n = (++) <$> deriveElmDef o n <*> deriveJSON (toAesonOptions o) n
|
||||
|
||||
-- | Just derive the @elm-bridge@ definitions for generating the
|
||||
-- serialization/deserialization code. It must be kept synchronized with
|
||||
-- the Haskell code manually.
|
||||
deriveElmDef :: ElmOptions -> Name -> Q [Dec]
|
||||
deriveElmDef opts name =
|
||||
do TyConI tyCon <- reify name
|
||||
|
@ -1,6 +1,10 @@
|
||||
{- |
|
||||
This module implements a generator for JSON serialisers and parsers of arbitrary elm types.
|
||||
Please note: It's still very hacky and might not work for all possible elm types yet.
|
||||
|
||||
It is highly recommended to either only use the functions of "Elm.Module", or to use the functions in this module
|
||||
after having modified the 'ETypeDef' arguments with functions such as 'defaultAlterations'.
|
||||
|
||||
The reason is that Elm types might have an equivalent on the Haskell side and should be converted (ie. 'Text' -> 'String', 'Vector' -> 'List').
|
||||
-}
|
||||
module Elm.Json
|
||||
( jsonParserForDef
|
||||
@ -138,9 +142,10 @@ jsonParserForDef etd =
|
||||
decoderTypeEnd name = unwords ("Json.Decode.Decoder" : "(" : et_name name : map tv_name (et_args name) ++ [")"])
|
||||
makeName name = unwords (funcname name : prependTypes "localDecoder_" name)
|
||||
|
||||
-- | Compile a JSON serializer for an Elm type
|
||||
--
|
||||
-- TODO : omitting null values on serialization ..
|
||||
{-| Compile a JSON serializer for an Elm type.
|
||||
|
||||
The 'omitNothingFields' option is currently not implemented!
|
||||
-}
|
||||
jsonSerForType :: EType -> String
|
||||
jsonSerForType = jsonSerForType' False
|
||||
|
||||
|
@ -1,5 +1,9 @@
|
||||
{-# LANGUAGE ExistentialQuantification #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
{-|
|
||||
Functions in this module are used to generate Elm modules. Note that the generated modules depend on the @bartavelle/json-helpers@ package.
|
||||
|
||||
-}
|
||||
module Elm.Module where
|
||||
|
||||
import Data.Proxy
|
||||
@ -14,21 +18,30 @@ import Elm.Json
|
||||
data DefineElm
|
||||
= forall a. IsElmDefinition a => DefineElm (Proxy a)
|
||||
|
||||
-- | Compile an Elm module
|
||||
makeElmModule :: String -> [DefineElm] -> String
|
||||
-- | Creates an Elm module. This will use the default type conversion rules (to
|
||||
-- convert @Vector@ to @List@, @HashMap a b@ to @List (a,b)@, etc.).
|
||||
makeElmModule :: String -- ^ Module name
|
||||
-> [DefineElm] -- ^ List of definitions to be included in the module
|
||||
-> String
|
||||
makeElmModule moduleName defs = unlines (
|
||||
[ "module " ++ moduleName ++ " where"
|
||||
, ""
|
||||
, "import Json.Decode"
|
||||
, "import Json.Decode exposing ((:=))"
|
||||
, "import Json.Encode"
|
||||
, "import Json.Helpers exposing (..)"
|
||||
, ""
|
||||
, ""
|
||||
]) ++ makeModuleContent defs
|
||||
|
||||
|
||||
-- | Generates the content of a module. You will be responsible for
|
||||
-- including the required Elm headers. This uses the default type
|
||||
-- conversion rules.
|
||||
makeModuleContent :: [DefineElm] -> String
|
||||
makeModuleContent = makeModuleContentWithAlterations defaultAlterations
|
||||
|
||||
-- | Generates the content of a module, using custom type conversion rules.
|
||||
makeModuleContentWithAlterations :: (ETypeDef -> ETypeDef) -> [DefineElm] -> String
|
||||
makeModuleContentWithAlterations alt = intercalate "\n\n" . map mkDef
|
||||
where
|
||||
@ -36,6 +49,15 @@ makeModuleContentWithAlterations alt = intercalate "\n\n" . map mkDef
|
||||
let def = alt (compileElmDef proxy)
|
||||
in renderElm def ++ "\n" ++ jsonParserForDef def ++ "\n" ++ jsonSerForDef def ++ "\n"
|
||||
|
||||
{-| A helper function that will recursively traverse type definitions and let you convert types.
|
||||
|
||||
> myAlteration : ETypeDef -> ETypeDef
|
||||
> myAlteration = recAlterType $ \t -> case t of
|
||||
> ETyCon (ETCon "Integer") -> ETyCon (ETCon "Int")
|
||||
> ETyCon (ETCon "Text") -> ETyCon (ETCon "String")
|
||||
> _ -> t
|
||||
|
||||
-}
|
||||
recAlterType :: (EType -> EType) -> ETypeDef -> ETypeDef
|
||||
recAlterType f td = case td of
|
||||
ETypeAlias a -> ETypeAlias (a { ea_fields = map (second f') (ea_fields a) })
|
||||
@ -45,15 +67,28 @@ recAlterType f td = case td of
|
||||
f' (ETyApp a b) = f (ETyApp (f' a) (f' b))
|
||||
f' x = f x
|
||||
|
||||
{-| A default set of type conversion rules:
|
||||
|
||||
* @HashSet a@, @Set a@ -> if @a@ is comparable, then @Set a@, else @List a@
|
||||
* @HashMap String v@, @Map String v@ -> @Dict String v@
|
||||
* @HashMap k v@, @Map k v@ -> @List (k, v)@
|
||||
* @Integer@ -> @Int@
|
||||
* @Text@ -> @String@
|
||||
* @Vector@ -> @List@
|
||||
* @Double@ -> @Float@
|
||||
-}
|
||||
defaultAlterations :: ETypeDef -> ETypeDef
|
||||
defaultAlterations = recAlterType $ \t -> case t of
|
||||
ETyApp (ETyCon (ETCon "HashSet")) s -> checkSet s
|
||||
ETyApp (ETyCon (ETCon "Set")) s -> checkSet s
|
||||
ETyApp (ETyApp (ETyCon (ETCon "HashMap")) k) v -> checkMap k v
|
||||
ETyApp (ETyCon (ETCon "HashSet")) s -> checkSet s
|
||||
ETyApp (ETyCon (ETCon "Set")) s -> checkSet s
|
||||
ETyApp (ETyApp (ETyCon (ETCon "HashMap")) k) v -> checkMap k v
|
||||
ETyApp (ETyApp (ETyCon (ETCon "THashMap")) k) v -> checkMap k v
|
||||
ETyApp (ETyApp (ETyCon (ETCon "Map")) k) v -> checkMap k v
|
||||
ETyCon (ETCon "Integer") -> ETyCon (ETCon "Int")
|
||||
_ -> t
|
||||
ETyApp (ETyApp (ETyCon (ETCon "Map")) k) v -> checkMap k v
|
||||
ETyCon (ETCon "Integer") -> ETyCon (ETCon "Int")
|
||||
ETyCon (ETCon "Text") -> ETyCon (ETCon "String")
|
||||
ETyCon (ETCon "Vector") -> ETyCon (ETCon "List")
|
||||
ETyCon (ETCon "Double") -> ETyCon (ETCon "Float")
|
||||
_ -> t
|
||||
where
|
||||
isString (ETyCon (ETCon "String")) = True
|
||||
isString _ = False
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-| This module should not usually be imported. -}
|
||||
module Elm.TyRender where
|
||||
|
||||
import Elm.TyRep
|
||||
|
168
src/Elm/TyRep.hs
168
src/Elm/TyRep.hs
@ -1,3 +1,6 @@
|
||||
{-| This module defines how the derived Haskell data types are represented.
|
||||
- It is useful for writing type conversion rules.
|
||||
-}
|
||||
module Elm.TyRep where
|
||||
|
||||
import Data.List
|
||||
@ -7,6 +10,98 @@ import Data.Aeson.Types (SumEncoding(..))
|
||||
import Data.Monoid ((<>))
|
||||
import Data.Maybe (fromMaybe)
|
||||
|
||||
-- | Type definition, including constructors.
|
||||
data ETypeDef
|
||||
= ETypeAlias EAlias
|
||||
| ETypePrimAlias EPrimAlias
|
||||
| ETypeSum ESum
|
||||
deriving (Show, Eq)
|
||||
|
||||
-- | Type construction : type variables, type constructors, tuples and type
|
||||
-- application.
|
||||
data EType
|
||||
= ETyVar ETVar
|
||||
| ETyCon ETCon
|
||||
| ETyApp EType EType
|
||||
| ETyTuple Int
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
{-| Type constructor:
|
||||
|
||||
> ETCon "Int"
|
||||
-}
|
||||
data ETCon
|
||||
= ETCon
|
||||
{ tc_name :: String
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
{-| Type variable:
|
||||
|
||||
> ETVar "a"
|
||||
-}
|
||||
data ETVar
|
||||
= ETVar
|
||||
{ tv_name :: String
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
|
||||
{-| Type name:
|
||||
|
||||
> ETypeName "Map" [ETVar "k", ETVar "v"]
|
||||
-}
|
||||
data ETypeName
|
||||
= ETypeName
|
||||
{ et_name :: String
|
||||
, et_args :: [ETVar]
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data EPrimAlias
|
||||
= EPrimAlias
|
||||
{ epa_name :: ETypeName
|
||||
, epa_type :: EType
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data EAlias
|
||||
= EAlias
|
||||
{ ea_name :: ETypeName
|
||||
, ea_fields :: [(String, EType)]
|
||||
, ea_omit_null :: Bool
|
||||
, ea_newtype :: Bool
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data ESum
|
||||
= ESum
|
||||
{ es_name :: ETypeName
|
||||
, es_options :: [(String, Either [(String, EType)] [EType])]
|
||||
, es_type :: SumEncoding'
|
||||
, es_omit_null :: Bool
|
||||
, es_unary_strings :: Bool
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
-- | Transforms tuple types in a list of types. Otherwise returns
|
||||
-- a singleton list with the original type.
|
||||
unpackTupleType :: EType -> [EType]
|
||||
unpackTupleType et = fromMaybe [et] (extract et)
|
||||
where
|
||||
extract :: EType -> Maybe [EType]
|
||||
extract ty = case ty of
|
||||
ETyApp (ETyTuple _) t -> return [t]
|
||||
ETyApp app@(ETyApp _ _) t -> fmap (++ [t]) (extract app)
|
||||
_ -> Nothing
|
||||
|
||||
unpackToplevelConstr :: EType -> [EType]
|
||||
unpackToplevelConstr t =
|
||||
reverse $
|
||||
flip unfoldr (Just t) $ \mT ->
|
||||
case mT of
|
||||
Nothing -> Nothing
|
||||
Just t' ->
|
||||
case t' of
|
||||
ETyApp l r ->
|
||||
Just (r, Just l)
|
||||
_ ->
|
||||
Just (t', Nothing)
|
||||
|
||||
class IsElmDefinition a where
|
||||
compileElmDef :: Proxy a -> ETypeDef
|
||||
|
||||
@ -39,76 +134,3 @@ instance Ord SumEncoding' where
|
||||
defSumEncoding :: SumEncoding'
|
||||
defSumEncoding = SumEncoding' ObjectWithSingleField
|
||||
|
||||
data ETypeDef
|
||||
= ETypeAlias EAlias
|
||||
| ETypePrimAlias EPrimAlias
|
||||
| ETypeSum ESum
|
||||
deriving (Show, Eq)
|
||||
|
||||
data EType
|
||||
= ETyVar ETVar
|
||||
| ETyCon ETCon
|
||||
| ETyApp EType EType
|
||||
| ETyTuple Int
|
||||
deriving (Show, Eq, Ord)
|
||||
|
||||
data ETCon
|
||||
= ETCon
|
||||
{ tc_name :: String
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data ETVar
|
||||
= ETVar
|
||||
{ tv_name :: String
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data ETypeName
|
||||
= ETypeName
|
||||
{ et_name :: String
|
||||
, et_args :: [ETVar]
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data EPrimAlias
|
||||
= EPrimAlias
|
||||
{ epa_name :: ETypeName
|
||||
, epa_type :: EType
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data EAlias
|
||||
= EAlias
|
||||
{ ea_name :: ETypeName
|
||||
, ea_fields :: [(String, EType)]
|
||||
, ea_omit_null :: Bool
|
||||
, ea_newtype :: Bool
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
data ESum
|
||||
= ESum
|
||||
{ es_name :: ETypeName
|
||||
, es_options :: [(String, Either [(String, EType)] [EType])]
|
||||
, es_type :: SumEncoding'
|
||||
, es_omit_null :: Bool
|
||||
, es_unary_strings :: Bool
|
||||
} deriving (Show, Eq, Ord)
|
||||
|
||||
unpackTupleType :: EType -> [EType]
|
||||
unpackTupleType et = fromMaybe [et] (extract et)
|
||||
where
|
||||
extract :: EType -> Maybe [EType]
|
||||
extract ty = case ty of
|
||||
ETyApp (ETyTuple _) t -> return [t]
|
||||
ETyApp app@(ETyApp _ _) t -> fmap (++ [t]) (extract app)
|
||||
_ -> Nothing
|
||||
|
||||
unpackToplevelConstr :: EType -> [EType]
|
||||
unpackToplevelConstr t =
|
||||
reverse $
|
||||
flip unfoldr (Just t) $ \mT ->
|
||||
case mT of
|
||||
Nothing -> Nothing
|
||||
Just t' ->
|
||||
case t' of
|
||||
ETyApp l r ->
|
||||
Just (r, Just l)
|
||||
_ ->
|
||||
Just (t', Nothing)
|
||||
|
@ -30,6 +30,7 @@ moduleCode = unlines
|
||||
, "import Json.Decode"
|
||||
, "import Json.Decode exposing ((:=))"
|
||||
, "import Json.Encode"
|
||||
, "import Json.Helpers exposing (..)"
|
||||
, ""
|
||||
, ""
|
||||
, "type alias Bar a ="
|
||||
@ -65,6 +66,7 @@ moduleCode' = unlines
|
||||
, "import Json.Decode"
|
||||
, "import Json.Decode exposing ((:=))"
|
||||
, "import Json.Encode"
|
||||
, "import Json.Helpers exposing (..)"
|
||||
, ""
|
||||
, ""
|
||||
, "type Qux a ="
|
||||
|
Loading…
Reference in New Issue
Block a user