mirror of
https://github.com/ilyakooo0/elm-bridge.git
synced 2024-10-05 17:47:50 +03:00
first working prototype
This commit is contained in:
commit
ddefcb9e8f
12
.gitignore
vendored
Normal file
12
.gitignore
vendored
Normal file
@ -0,0 +1,12 @@
|
|||||||
|
dist
|
||||||
|
cabal-dev
|
||||||
|
*.o
|
||||||
|
*.hi
|
||||||
|
*.chi
|
||||||
|
*.chs.h
|
||||||
|
.virthualenv
|
||||||
|
.DS_Store
|
||||||
|
.cabal-sandbox
|
||||||
|
cabal.sandbox.config
|
||||||
|
*~
|
||||||
|
.stack-work
|
30
LICENSE
Normal file
30
LICENSE
Normal file
@ -0,0 +1,30 @@
|
|||||||
|
Copyright (c) 2015 Alexander Thiemann <mail@athiemann.net>
|
||||||
|
|
||||||
|
All rights reserved.
|
||||||
|
|
||||||
|
Redistribution and use in source and binary forms, with or without
|
||||||
|
modification, are permitted provided that the following conditions are met:
|
||||||
|
|
||||||
|
* Redistributions of source code must retain the above copyright
|
||||||
|
notice, this list of conditions and the following disclaimer.
|
||||||
|
|
||||||
|
* Redistributions in binary form must reproduce the above
|
||||||
|
copyright notice, this list of conditions and the following
|
||||||
|
disclaimer in the documentation and/or other materials provided
|
||||||
|
with the distribution.
|
||||||
|
|
||||||
|
* Neither the name of Alexander Thiemann or agrafix nor the names of other
|
||||||
|
contributors may be used to endorse or promote products derived
|
||||||
|
from this software without specific prior written permission.
|
||||||
|
|
||||||
|
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
|
||||||
|
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
|
||||||
|
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
|
||||||
|
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
|
||||||
|
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
|
||||||
|
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
|
||||||
|
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
|
||||||
|
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
|
||||||
|
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||||
|
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
6
app/Main.hs
Normal file
6
app/Main.hs
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
module Main where
|
||||||
|
|
||||||
|
import Lib
|
||||||
|
|
||||||
|
main :: IO ()
|
||||||
|
main = someFunc
|
42
elm-bridge.cabal
Normal file
42
elm-bridge.cabal
Normal file
@ -0,0 +1,42 @@
|
|||||||
|
name: elm-bridge
|
||||||
|
version: 0.1.0.0
|
||||||
|
synopsis: Derive Elm types from Haskell types
|
||||||
|
description: Building the bridge from Haskell to Elm and back. Define types once,
|
||||||
|
use on both sides and enjoy free (de)serialisation. Cheers!
|
||||||
|
homepage: http://github.com/agrafix/derive-elm
|
||||||
|
license: BSD3
|
||||||
|
license-file: LICENSE
|
||||||
|
author: Alexander Thiemann <mail@athiemann.net>
|
||||||
|
maintainer: Alexander Thiemann <mail@athiemann.net>
|
||||||
|
copyright: (c) 2015 Alexander Thiemann
|
||||||
|
category: Web, Compiler, Language
|
||||||
|
build-type: Simple
|
||||||
|
cabal-version: >=1.10
|
||||||
|
|
||||||
|
extra-source-files:
|
||||||
|
README.md
|
||||||
|
|
||||||
|
library
|
||||||
|
hs-source-dirs: src
|
||||||
|
exposed-modules: Elm.Derive, Elm.TyRep, Elm.TyRender
|
||||||
|
build-depends: base >= 4.7 && < 5,
|
||||||
|
template-haskell
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
test-suite derive-elm-tests
|
||||||
|
type: exitcode-stdio-1.0
|
||||||
|
hs-source-dirs: test
|
||||||
|
main-is: Spec.hs
|
||||||
|
other-modules:
|
||||||
|
Elm.DeriveSpec
|
||||||
|
Elm.TyRenderSpec
|
||||||
|
Elm.TestHelpers
|
||||||
|
build-depends:
|
||||||
|
base,
|
||||||
|
hspec >= 2.0,
|
||||||
|
elm-bridge
|
||||||
|
default-language: Haskell2010
|
||||||
|
|
||||||
|
source-repository head
|
||||||
|
type: git
|
||||||
|
location: https://github.com/agrafix/derive-elm
|
131
src/Elm/Derive.hs
Normal file
131
src/Elm/Derive.hs
Normal file
@ -0,0 +1,131 @@
|
|||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
module Elm.Derive
|
||||||
|
( deriveElmDef, defaultOpts, DeriveOpts(..) )
|
||||||
|
where
|
||||||
|
|
||||||
|
import Elm.TyRep
|
||||||
|
|
||||||
|
import Language.Haskell.TH
|
||||||
|
import Language.Haskell.TH.Syntax
|
||||||
|
|
||||||
|
data DeriveOpts
|
||||||
|
= DeriveOpts
|
||||||
|
{ do_fieldModifier :: String -> String
|
||||||
|
, do_constrModifier :: String -> String
|
||||||
|
}
|
||||||
|
|
||||||
|
defaultOpts :: DeriveOpts
|
||||||
|
defaultOpts =
|
||||||
|
DeriveOpts
|
||||||
|
{ do_fieldModifier = id
|
||||||
|
, do_constrModifier = id
|
||||||
|
}
|
||||||
|
|
||||||
|
compileType :: Type -> Q Exp
|
||||||
|
compileType ty =
|
||||||
|
case ty of
|
||||||
|
ListT -> [|ETyCon (ETCon "List")|]
|
||||||
|
TupleT i -> [|ETyTuple i|]
|
||||||
|
ConT name ->
|
||||||
|
let n = nameBase name
|
||||||
|
in [|ETyCon (ETCon n)|]
|
||||||
|
VarT name ->
|
||||||
|
let n = nameBase name
|
||||||
|
in [|ETyVar (ETVar n)|]
|
||||||
|
SigT ty _ ->
|
||||||
|
compileType ty
|
||||||
|
AppT a b ->
|
||||||
|
let a1 = compileType a
|
||||||
|
b1 = compileType b
|
||||||
|
in [|ETyApp $a1 $b1|]
|
||||||
|
_ -> fail $ "Unsupported type: " ++ show ty
|
||||||
|
|
||||||
|
|
||||||
|
runDerive :: Name -> [TyVarBndr] -> (Q Exp -> Q Exp) -> Q Dec
|
||||||
|
runDerive name vars mkBody =
|
||||||
|
instanceD (cxt [])
|
||||||
|
(classType `appT` instanceType)
|
||||||
|
[ funD 'compileElmDef
|
||||||
|
[ clause [ return WildP ] (normalB body) []
|
||||||
|
]
|
||||||
|
]
|
||||||
|
where
|
||||||
|
classType = conT ''IsElmDefinition
|
||||||
|
instanceType = foldl appT (conT name) $ map varT argNames
|
||||||
|
|
||||||
|
body = mkBody [|ETypeName { et_name = nameStr, et_args = $args }|]
|
||||||
|
|
||||||
|
nameStr = nameBase name
|
||||||
|
args =
|
||||||
|
listE $ map mkTVar argNames
|
||||||
|
mkTVar :: Name -> Q Exp
|
||||||
|
mkTVar n =
|
||||||
|
let str = nameBase n
|
||||||
|
in [|ETVar str|]
|
||||||
|
|
||||||
|
argNames =
|
||||||
|
flip map vars $ \v ->
|
||||||
|
case v of
|
||||||
|
PlainTV tv -> tv
|
||||||
|
KindedTV tv _ -> tv
|
||||||
|
|
||||||
|
deriveAlias :: DeriveOpts -> Name -> [TyVarBndr] -> Con -> Q Dec
|
||||||
|
deriveAlias opts name vars c =
|
||||||
|
case c of
|
||||||
|
RecC _ conFields ->
|
||||||
|
let fields = listE $ map mkField conFields
|
||||||
|
in runDerive name vars $ \typeName ->
|
||||||
|
[|ETypeAlias (EAlias $typeName $fields)|]
|
||||||
|
_ ->
|
||||||
|
fail "Can only derive records like C { v :: Int, w :: a }"
|
||||||
|
where
|
||||||
|
mkField :: VarStrictType -> Q Exp
|
||||||
|
mkField (fname, _, ftype) =
|
||||||
|
[|(fldName, $fldType)|]
|
||||||
|
where
|
||||||
|
fldName = do_fieldModifier opts $ nameBase fname
|
||||||
|
fldType = compileType ftype
|
||||||
|
|
||||||
|
deriveSum :: DeriveOpts -> Name -> [TyVarBndr] -> [Con] -> Q Dec
|
||||||
|
deriveSum opts name vars constrs =
|
||||||
|
runDerive name vars $ \typeName ->
|
||||||
|
[|ETypeSum (ESum $typeName $sumOpts)|]
|
||||||
|
where
|
||||||
|
sumOpts =
|
||||||
|
listE $ map mkOpt constrs
|
||||||
|
mkOpt :: Con -> Q Exp
|
||||||
|
mkOpt c =
|
||||||
|
case c of
|
||||||
|
NormalC name args ->
|
||||||
|
let n = do_constrModifier opts $ nameBase name
|
||||||
|
tyArgs = listE $ map (\(_, ty) -> compileType ty) args
|
||||||
|
in [|(n, $tyArgs)|]
|
||||||
|
_ ->
|
||||||
|
fail "Can only derive sum types with options like C Int a"
|
||||||
|
|
||||||
|
deriveSynonym :: DeriveOpts -> Name -> [TyVarBndr] -> Type -> Q Dec
|
||||||
|
deriveSynonym opts name vars otherT =
|
||||||
|
runDerive name vars $ \typeName ->
|
||||||
|
[|ETypePrimAlias (EPrimAlias $typeName $otherType)|]
|
||||||
|
where
|
||||||
|
otherType = compileType otherT
|
||||||
|
|
||||||
|
deriveElmDef :: DeriveOpts -> Name -> Q [Dec]
|
||||||
|
deriveElmDef opts name =
|
||||||
|
do r <- deriveElmDef' opts name
|
||||||
|
return [r]
|
||||||
|
|
||||||
|
deriveElmDef' :: DeriveOpts -> Name -> Q Dec
|
||||||
|
deriveElmDef' opts name =
|
||||||
|
do TyConI tyCon <- reify name
|
||||||
|
case tyCon of
|
||||||
|
DataD _ _ tyVars constrs _ ->
|
||||||
|
case constrs of
|
||||||
|
[] -> fail "Can not derive empty data decls"
|
||||||
|
[x] -> deriveAlias opts name tyVars x
|
||||||
|
_ -> deriveSum opts name tyVars constrs
|
||||||
|
NewtypeD _ _ tyVars constr _ ->
|
||||||
|
deriveAlias opts name tyVars constr
|
||||||
|
TySynD _ vars otherTy ->
|
||||||
|
deriveSynonym opts name vars otherTy
|
||||||
|
_ -> fail "Oops, can only derive data and newtype"
|
57
src/Elm/TyRender.hs
Normal file
57
src/Elm/TyRender.hs
Normal file
@ -0,0 +1,57 @@
|
|||||||
|
module Elm.TyRender where
|
||||||
|
|
||||||
|
import Elm.TyRep
|
||||||
|
|
||||||
|
import Data.List
|
||||||
|
|
||||||
|
class ElmRenderable a where
|
||||||
|
renderElm :: a -> String
|
||||||
|
|
||||||
|
instance ElmRenderable ETypeDef where
|
||||||
|
renderElm td =
|
||||||
|
case td of
|
||||||
|
ETypeAlias alias -> renderElm alias
|
||||||
|
ETypeSum s -> renderElm s
|
||||||
|
ETypePrimAlias pa -> renderElm pa
|
||||||
|
|
||||||
|
instance ElmRenderable EType where
|
||||||
|
renderElm ty =
|
||||||
|
case unpackTupleType ty of
|
||||||
|
[t] -> renderSingleTy t
|
||||||
|
xs -> "(" ++ intercalate ", " (map renderSingleTy xs) ++ ")"
|
||||||
|
where
|
||||||
|
renderSingleTy ty =
|
||||||
|
case ty of
|
||||||
|
ETyVar v -> renderElm v
|
||||||
|
ETyCon c -> renderElm c
|
||||||
|
ETyTuple n -> error "Library Bug: This should never happen!"
|
||||||
|
ETyApp l r -> "(" ++ renderElm l ++ " " ++ renderElm r ++ ")"
|
||||||
|
|
||||||
|
instance ElmRenderable ETCon where
|
||||||
|
renderElm = tc_name
|
||||||
|
|
||||||
|
instance ElmRenderable ETVar where
|
||||||
|
renderElm = tv_name
|
||||||
|
|
||||||
|
instance ElmRenderable ETypeName where
|
||||||
|
renderElm tyName =
|
||||||
|
et_name tyName ++ " " ++ unwords (map renderElm $ et_args tyName)
|
||||||
|
|
||||||
|
instance ElmRenderable EAlias where
|
||||||
|
renderElm alias =
|
||||||
|
"type alias " ++ renderElm (ea_name alias) ++ " = \n { "
|
||||||
|
++ intercalate "\n, " (map (\(fld, ty) -> fld ++ ": " ++ renderElm ty) (ea_fields alias))
|
||||||
|
++ "\n }\n"
|
||||||
|
|
||||||
|
instance ElmRenderable ESum where
|
||||||
|
renderElm s =
|
||||||
|
"type " ++ renderElm (es_name s) ++ " = \n "
|
||||||
|
++ intercalate "\n | " (map mkOpt (es_options s))
|
||||||
|
++ "\n"
|
||||||
|
where
|
||||||
|
mkOpt (name, types) =
|
||||||
|
name ++ " " ++ unwords (map renderElm types)
|
||||||
|
|
||||||
|
instance ElmRenderable EPrimAlias where
|
||||||
|
renderElm pa =
|
||||||
|
"type alias " ++ renderElm (epa_name pa) ++ " = " ++ renderElm (epa_type pa) ++ "\n"
|
66
src/Elm/TyRep.hs
Normal file
66
src/Elm/TyRep.hs
Normal file
@ -0,0 +1,66 @@
|
|||||||
|
module Elm.TyRep where
|
||||||
|
|
||||||
|
import Data.List
|
||||||
|
import Data.Proxy
|
||||||
|
|
||||||
|
class IsElmDefinition a where
|
||||||
|
compileElmDef :: Proxy a -> ETypeDef
|
||||||
|
|
||||||
|
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)]
|
||||||
|
} deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
data ESum
|
||||||
|
= ESum
|
||||||
|
{ es_name :: ETypeName
|
||||||
|
, es_options :: [(String, [EType])]
|
||||||
|
} deriving (Show, Eq, Ord)
|
||||||
|
|
||||||
|
unpackTupleType :: EType -> [EType]
|
||||||
|
unpackTupleType t =
|
||||||
|
unfoldr (\ty ->
|
||||||
|
case ty of
|
||||||
|
Just (ETyApp (ETyApp (ETyTuple i) r) r') ->
|
||||||
|
Just (r, Just r')
|
||||||
|
Just t ->
|
||||||
|
Just (t, Nothing)
|
||||||
|
Nothing ->
|
||||||
|
Nothing
|
||||||
|
) (Just t)
|
6
src/Lib.hs
Normal file
6
src/Lib.hs
Normal file
@ -0,0 +1,6 @@
|
|||||||
|
module Lib
|
||||||
|
( someFunc
|
||||||
|
) where
|
||||||
|
|
||||||
|
someFunc :: IO ()
|
||||||
|
someFunc = putStrLn "someFunc"
|
5
stack.yaml
Normal file
5
stack.yaml
Normal file
@ -0,0 +1,5 @@
|
|||||||
|
flags: {}
|
||||||
|
packages:
|
||||||
|
- '.'
|
||||||
|
extra-deps: []
|
||||||
|
resolver: lts-2.20
|
83
test/Elm/DeriveSpec.hs
Normal file
83
test/Elm/DeriveSpec.hs
Normal file
@ -0,0 +1,83 @@
|
|||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
module Elm.DeriveSpec (spec) where
|
||||||
|
|
||||||
|
import Elm.Derive
|
||||||
|
import Elm.TyRep
|
||||||
|
|
||||||
|
import Data.Proxy
|
||||||
|
import Test.Hspec
|
||||||
|
|
||||||
|
data Foo
|
||||||
|
= Foo
|
||||||
|
{ f_name :: String
|
||||||
|
, f_blablub :: Int
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Bar a
|
||||||
|
= Bar
|
||||||
|
{ b_name :: a
|
||||||
|
, b_blablub :: Int
|
||||||
|
, b_tuple :: (Int, String)
|
||||||
|
, b_list :: [Bool]
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data SomeOpts a
|
||||||
|
= Okay Int
|
||||||
|
| NotOkay a
|
||||||
|
|
||||||
|
deriveElmDef defaultOpts ''Foo
|
||||||
|
deriveElmDef defaultOpts ''Bar
|
||||||
|
deriveElmDef defaultOpts ''SomeOpts
|
||||||
|
|
||||||
|
fooElm :: ETypeDef
|
||||||
|
fooElm =
|
||||||
|
ETypeAlias $
|
||||||
|
EAlias
|
||||||
|
{ ea_name =
|
||||||
|
ETypeName
|
||||||
|
{ et_name = "Foo"
|
||||||
|
, et_args = []
|
||||||
|
}
|
||||||
|
, ea_fields =
|
||||||
|
[("f_name",ETyCon (ETCon {tc_name = "String"})),("f_blablub",ETyCon (ETCon {tc_name = "Int"}))]
|
||||||
|
}
|
||||||
|
|
||||||
|
barElm :: ETypeDef
|
||||||
|
barElm =
|
||||||
|
ETypeAlias $
|
||||||
|
EAlias
|
||||||
|
{ ea_name =
|
||||||
|
ETypeName
|
||||||
|
{ et_name = "Bar"
|
||||||
|
, et_args = [ETVar {tv_name = "a"}]
|
||||||
|
}
|
||||||
|
, ea_fields =
|
||||||
|
[ ("b_name",ETyVar (ETVar {tv_name = "a"}))
|
||||||
|
, ("b_blablub",ETyCon (ETCon {tc_name = "Int"}))
|
||||||
|
, ("b_tuple",ETyApp (ETyApp (ETyTuple 2) (ETyCon (ETCon {tc_name = "Int"}))) (ETyCon (ETCon {tc_name = "String"})))
|
||||||
|
, ("b_list",ETyApp (ETyCon (ETCon {tc_name = "List"})) (ETyCon (ETCon {tc_name = "Bool"})))
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
someOptsElm :: ETypeDef
|
||||||
|
someOptsElm =
|
||||||
|
ETypeSum $
|
||||||
|
ESum
|
||||||
|
{ es_name =
|
||||||
|
ETypeName
|
||||||
|
{ et_name = "SomeOpts"
|
||||||
|
, et_args = [ETVar {tv_name = "a"}]
|
||||||
|
}
|
||||||
|
, es_options =
|
||||||
|
[ ("Okay",[ETyCon (ETCon {tc_name = "Int"})])
|
||||||
|
, ("NotOkay",[ETyVar (ETVar {tv_name = "a"})])
|
||||||
|
]
|
||||||
|
}
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec =
|
||||||
|
describe "deriveElmRep" $
|
||||||
|
it "should produce the correct types" $
|
||||||
|
do compileElmDef (Proxy :: Proxy Foo) `shouldBe` fooElm
|
||||||
|
compileElmDef (Proxy :: Proxy (Bar a)) `shouldBe` barElm
|
||||||
|
compileElmDef (Proxy :: Proxy (SomeOpts a)) `shouldBe` someOptsElm
|
9
test/Elm/TestHelpers.hs
Normal file
9
test/Elm/TestHelpers.hs
Normal file
@ -0,0 +1,9 @@
|
|||||||
|
module Elm.TestHelpers where
|
||||||
|
|
||||||
|
import Elm.Derive
|
||||||
|
|
||||||
|
fieldDropOpts :: Int -> DeriveOpts
|
||||||
|
fieldDropOpts i =
|
||||||
|
defaultOpts
|
||||||
|
{ do_fieldModifier = drop i
|
||||||
|
}
|
53
test/Elm/TyRenderSpec.hs
Normal file
53
test/Elm/TyRenderSpec.hs
Normal file
@ -0,0 +1,53 @@
|
|||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
|
module Elm.TyRenderSpec (spec) where
|
||||||
|
|
||||||
|
import Elm.Derive
|
||||||
|
import Elm.TyRep
|
||||||
|
import Elm.TyRender
|
||||||
|
|
||||||
|
import Elm.TestHelpers
|
||||||
|
|
||||||
|
import Data.Proxy
|
||||||
|
import Test.Hspec
|
||||||
|
|
||||||
|
data Foo
|
||||||
|
= Foo
|
||||||
|
{ f_name :: String
|
||||||
|
, f_blablub :: Int
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data Bar a
|
||||||
|
= Bar
|
||||||
|
{ b_name :: a
|
||||||
|
, b_blablub :: Int
|
||||||
|
, b_tuple :: (Int, String)
|
||||||
|
, b_list :: [Bool]
|
||||||
|
} deriving (Show, Eq)
|
||||||
|
|
||||||
|
data SomeOpts a
|
||||||
|
= Okay Int
|
||||||
|
| NotOkay a
|
||||||
|
|
||||||
|
$(deriveElmDef (fieldDropOpts 2) ''Foo)
|
||||||
|
$(deriveElmDef (fieldDropOpts 2) ''Bar)
|
||||||
|
$(deriveElmDef defaultOpts ''SomeOpts)
|
||||||
|
|
||||||
|
fooCode :: String
|
||||||
|
fooCode = "type alias Foo = \n { name: String\n, blablub: Int\n }\n"
|
||||||
|
|
||||||
|
barCode :: String
|
||||||
|
barCode = "type alias Bar a = \n { name: a\n, blablub: Int\n, tuple: (Int, String)\n, list: (List Bool)\n }\n"
|
||||||
|
|
||||||
|
someOptsCode :: String
|
||||||
|
someOptsCode = "type SomeOpts a = \n Okay Int\n | NotOkay a\n"
|
||||||
|
|
||||||
|
spec :: Spec
|
||||||
|
spec =
|
||||||
|
describe "deriveElmRep" $
|
||||||
|
do let rFoo = compileElmDef (Proxy :: Proxy Foo)
|
||||||
|
rBar = compileElmDef (Proxy :: Proxy (Bar a))
|
||||||
|
rSomeOpts = compileElmDef (Proxy :: Proxy (SomeOpts a))
|
||||||
|
it "should produce the correct code" $
|
||||||
|
do renderElm rFoo `shouldBe` fooCode
|
||||||
|
renderElm rBar `shouldBe` barCode
|
||||||
|
renderElm rSomeOpts `shouldBe` someOptsCode
|
1
test/Spec.hs
Normal file
1
test/Spec.hs
Normal file
@ -0,0 +1 @@
|
|||||||
|
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
Loading…
Reference in New Issue
Block a user