ilyakooo0/elm-bridge
1
0
Fork 0
mirror of https://github.com/ilyakooo0/elm-bridge.git synced 2024-09-11 14:05:55 +03:00
Code Issues Packages Projects Releases Wiki Activity

Better documentation

Browse Source
This commit is contained in:
bartavelle 2016-01-12 15:49:59 +01:00
parent f1198a4f1e
commit d6659740dd
6 changed files with 200 additions and 97 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

62
src/Elm/Derive.hs
View File

@ -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

13
src/Elm/Json.hs
View File

@ -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

51
src/Elm/Module.hs
View File

@ -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
src/Elm/TyRender.hs
View File

@ -1,3 +1,4 @@
{-| This module should not usually be imported. -}
module Elm.TyRender where
import Elm.TyRep

168
src/Elm/TyRep.hs
View File

@ -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)

2
test/Elm/ModuleSpec.hs
View File

@ -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 ="