elm-export 0.5.0.2 → 0.5.1.0
raw patch · 15 files changed
+719/−619 lines, 15 filesdep +Diffdep +HUnitdep +wl-pprint-textdep ~QuickCheckdep ~basedep ~bytestringPVP ok
version bump matches the API change (PVP)
Dependencies added: Diff, HUnit, wl-pprint-text
Dependency ranges changed: QuickCheck, base, bytestring, containers, directory, elm-export, formatting, hspec, hspec-core, mtl, quickcheck-instances, text, time
API changes (from Hackage documentation)
Files
- elm-export.cabal +21/−18
- src/Elm.hs +9/−7
- src/Elm/Common.hs +25/−4
- src/Elm/Decoder.hs +70/−68
- src/Elm/Encoder.hs +71/−58
- src/Elm/File.hs +15/−15
- src/Elm/Record.hs +77/−57
- src/Elm/Type.hs +97/−93
- test/CommentDecoder.elm +2/−2
- test/CommentDecoderWithOptions.elm +2/−2
- test/CommentEncoder.elm +1/−2
- test/CommentEncoderWithOptions.elm +1/−2
- test/ExportSpec.hs +324/−288
- test/FavoritePlacesType.elm +1/−0
- test/TypesSpec.hs +3/−3
elm-export.cabal view
@@ -1,5 +1,5 @@ name: elm-export-version: 0.5.0.2+version: 0.5.1.0 cabal-version: >=1.10 build-type: Simple license: OtherLicense@@ -25,13 +25,14 @@ Elm build-depends: base >=4.7 && <5,- bytestring >=0.10.6.0 && <0.11,- containers >=0.5.6.2 && <0.6,- directory >=1.2.2.0 && <1.3,- formatting >=6.2.2 && <6.3,- mtl >=2.2.1 && <2.3,- text >=1.2.2.1 && <1.3,- time >=1.5.0.1 && <1.6+ bytestring >=0.10.6.0,+ containers >=0.5.6.2,+ directory >=1.2.2.0,+ formatting >=6.2.2,+ mtl >=2.2.1,+ text >=1.2.2.1,+ time >=1.5.0.1,+ wl-pprint-text >=1.1.0.4 default-language: Haskell2010 hs-source-dirs: src other-modules:@@ -47,16 +48,18 @@ type: exitcode-stdio-1.0 main-is: Spec.hs build-depends:- QuickCheck >=2.8.2 && <2.9,- base >=4.8.2.0 && <4.9,- bytestring >=0.10.6.0 && <0.11,- containers >=0.5.6.2 && <0.6,- elm-export >=0.5.0.2 && <0.6,- hspec >=2.2.3 && <2.3,- hspec-core >=2.2.3 && <2.3,- quickcheck-instances >=0.3.12 && <0.4,- text >=1.2.2.1 && <1.3,- time >=1.5.0.1 && <1.6+ Diff >=0.3.2,+ HUnit >=1.3.1.2,+ QuickCheck >=2.8.2,+ base >=4.8.2.0,+ bytestring >=0.10.6.0,+ containers >=0.5.6.2,+ elm-export >=0.5.1.0,+ hspec >=2.2.4,+ hspec-core >=2.2.4,+ quickcheck-instances >=0.3.12,+ text >=1.2.2.1,+ time >=1.5.0.1 default-language: Haskell2010 hs-source-dirs: test other-modules:
src/Elm.hs view
@@ -1,8 +1,10 @@-module Elm (module X) where+module Elm+ ( module X+ ) where -import Elm.Common as X (Options (..), defaultOptions)-import Elm.Decoder as X-import Elm.Encoder as X-import Elm.File as X-import Elm.Record as X-import Elm.Type as X+import Elm.Common as X (Options(..), defaultOptions)+import Elm.Decoder as X+import Elm.Encoder as X+import Elm.File as X+import Elm.Record as X+import Elm.Type as X
src/Elm/Common.hs view
@@ -1,14 +1,35 @@ {-# LANGUAGE OverloadedStrings #-}-module Elm.Common where +module Elm.Common where++import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>))+import Data.Monoid import Data.Text (Text)-import Formatting+import qualified Data.Text.Lazy as LT+import Formatting hiding (text) -data Options =- Options {fieldLabelModifier :: Text -> Text}+data Options = Options+ { fieldLabelModifier :: Text -> Text+ } defaultOptions :: Options defaultOptions = Options {fieldLabelModifier = id} cr :: Format r r cr = now "\n"++mintercalate+ :: Monoid m+ => m -> [m] -> m+mintercalate _ [] = mempty+mintercalate _ [x] = x+mintercalate seperator (x:xs) = x <> seperator <> mintercalate seperator xs++pprinter :: Doc -> Text+pprinter = LT.toStrict . displayT . renderPretty 0.4 100++stext :: Data.Text.Text -> Doc+stext = text . LT.fromStrict++spaceparens :: Doc -> Doc+spaceparens doc = "(" <+> doc <+> ")"
src/Elm/Decoder.hs view
@@ -1,8 +1,7 @@-{-# LANGUAGE DefaultSignatures #-}-{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeOperators #-} module Elm.Decoder ( toElmDecoderRef@@ -11,88 +10,91 @@ , toElmDecoderSourceWith ) where -import Control.Monad.Reader-import Data.Text-import Elm.Common-import Elm.Type-import Formatting+import Control.Monad.Reader+import Data.Monoid+import qualified Data.Text as T+import Elm.Common+import Elm.Type+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) class HasDecoder a where- render :: a -> Reader Options Text+ render :: a -> Reader Options Doc class HasDecoderRef a where- renderRef :: a -> Reader Options Text+ renderRef :: a -> Reader Options Doc instance HasDecoder ElmDatatype where- render d@(ElmDatatype name constructor) = do- fnName <- renderRef d- sformat- (stext % " : Decoder " % stext % cr % stext % " =" % cr % stext)- fnName- name- fnName <$>- render constructor- render (ElmPrimitive primitive) = renderRef primitive+ render d@(ElmDatatype name constructor) = do+ fnName <- renderRef d+ ctor <- render constructor+ return $+ (fnName <+> ": Decoder" <+> stext name) <$$>+ (fnName <+> "=" <$$> indent 4 ctor)+ render (ElmPrimitive primitive) = renderRef primitive instance HasDecoderRef ElmDatatype where- renderRef (ElmDatatype name _) =- pure $ sformat ("decode" % stext) name-- renderRef (ElmPrimitive primitive) =- renderRef primitive-+ renderRef (ElmDatatype name _) = pure $ "decode" <> stext name+ renderRef (ElmPrimitive primitive) = renderRef primitive instance HasDecoder ElmConstructor where- render (NamedConstructor name value) =- sformat (" decode " % stext % cr % stext) name <$> render value- render (RecordConstructor name value) =- sformat (" decode " % stext % cr % stext) name <$> render value-+ render (NamedConstructor name value) = do+ dv <- render value+ return $ "decode" <+> stext name <$$> indent 4 dv+ render (RecordConstructor name value) = do+ dv <- render value+ return $ "decode" <+> stext name <$$> indent 4 dv instance HasDecoder ElmValue where- render (ElmRef name) = pure (sformat ("decode" % stext) name)- render (ElmPrimitiveRef primitive) = renderRef primitive- render (Values x y) = sformat (stext % cr % stext) <$> render x <*> render y- render (ElmField name value) = do- fieldModifier <- asks fieldLabelModifier- sformat- (" |> required \"" % stext % "\" " % stext)- (fieldModifier name) <$>- render value-+ render (ElmRef name) = pure $ "decode" <> stext name+ render (ElmPrimitiveRef primitive) = renderRef primitive+ render (Values x y) = do+ dx <- render x+ dy <- render y+ return $ dx <$$> dy+ render (ElmField name value) = do+ fieldModifier <- asks fieldLabelModifier+ dv <- render value+ return $ "|> required" <+> dquotes (stext (fieldModifier name)) <+> dv instance HasDecoderRef ElmPrimitive where- renderRef (EList (ElmPrimitive EChar)) = pure "string"- renderRef (EList datatype) =- sformat ("(list " % stext % ")") <$> renderRef datatype- renderRef (EDict key value) =- sformat ("(map Dict.fromList " % stext % ")") <$>- renderRef (EList (ElmPrimitive (ETuple2 (ElmPrimitive key) value)))- renderRef (EMaybe datatype) =- sformat ("(maybe " % stext % ")") <$> renderRef datatype- renderRef (ETuple2 x y) =- sformat ("(tuple2 (,) " % stext % " " % stext % ")") <$> renderRef x <*>- renderRef y- renderRef EUnit = pure "(succeed ())"- renderRef EDate = pure "(customDecoder string Date.fromString)"- renderRef EInt = pure "int"- renderRef EBool = pure "bool"- renderRef EChar = pure "char"- renderRef EFloat = pure "float"- renderRef EString = pure "string"---toElmDecoderRefWith :: ElmType a => Options -> a -> Text-toElmDecoderRefWith options x = runReader (renderRef (toElmType x)) options+ renderRef (EList (ElmPrimitive EChar)) = pure "string"+ renderRef (EList datatype) = do+ dt <- renderRef datatype+ return . parens $ "list" <+> dt+ renderRef (EDict key value) = do+ d <- renderRef (EList (ElmPrimitive (ETuple2 (ElmPrimitive key) value)))+ return . parens $ "map Dict.fromList" <+> d+ renderRef (EMaybe datatype) = do+ dt <- renderRef datatype+ return . parens $ "maybe" <+> dt+ renderRef (ETuple2 x y) = do+ dx <- renderRef x+ dy <- renderRef y+ return . parens $ "tuple2 (,)" <+> dx <+> dy+ renderRef EUnit = pure $ parens "succeed ()"+ renderRef EDate = pure "decodeDate"+ renderRef EInt = pure "int"+ renderRef EBool = pure "bool"+ renderRef EChar = pure "char"+ renderRef EFloat = pure "float"+ renderRef EString = pure "string" +toElmDecoderRefWith+ :: ElmType a+ => Options -> a -> T.Text+toElmDecoderRefWith options x = pprinter $ runReader (renderRef (toElmType x)) options -toElmDecoderRef :: ElmType a => a -> Text+toElmDecoderRef+ :: ElmType a+ => a -> T.Text toElmDecoderRef = toElmDecoderRefWith defaultOptions --toElmDecoderSourceWith :: ElmType a => Options -> a -> Text-toElmDecoderSourceWith options x = runReader (render (toElmType x)) options-+toElmDecoderSourceWith+ :: ElmType a+ => Options -> a -> T.Text+toElmDecoderSourceWith options x = pprinter $ runReader (render (toElmType x)) options -toElmDecoderSource :: ElmType a => a -> Text+toElmDecoderSource+ :: ElmType a+ => a -> T.Text toElmDecoderSource = toElmDecoderSourceWith defaultOptions
src/Elm/Encoder.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ module Elm.Encoder ( toElmEncoderRef , toElmEncoderRefWith@@ -6,81 +7,93 @@ , toElmEncoderSourceWith ) where -import Control.Monad.Reader-import Data.Text-import Elm.Common-import Elm.Type-import Formatting+import Control.Monad.Reader+import Data.Monoid+import qualified Data.Text as T+import Elm.Common+import Elm.Type+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) class HasEncoder a where- render :: a -> Reader Options Text+ render :: a -> Reader Options Doc class HasEncoderRef a where- renderRef :: a -> Reader Options Text+ renderRef :: a -> Reader Options Doc instance HasEncoder ElmDatatype where- render d@(ElmDatatype name constructor) = do- fnName <- renderRef d- sformat- (stext % " : " % stext % " -> Json.Encode.Value" % cr % stext % " x =" % stext)- fnName- name- fnName <$>- render constructor- render (ElmPrimitive primitive) = renderRef primitive+ render d@(ElmDatatype name constructor) = do+ fnName <- renderRef d+ ctor <- render constructor+ return $+ (fnName <+> ":" <+> stext name <+> "->" <+> "Json.Encode.Value") <$$>+ (fnName <+> "x =" <$$> indent 4 ctor)+ render (ElmPrimitive primitive) = renderRef primitive instance HasEncoderRef ElmDatatype where- renderRef (ElmDatatype name _) =- pure $ sformat ("encode" % stext) name-- renderRef (ElmPrimitive primitive) =- renderRef primitive+ renderRef (ElmDatatype name _) = pure $ "encode" <> stext name+ renderRef (ElmPrimitive primitive) = renderRef primitive instance HasEncoder ElmConstructor where- render (RecordConstructor _ value) =- sformat (cr % " Json.Encode.object" % cr % " [ " % stext % cr % " ]") <$> render value+ render (RecordConstructor _ value) = do+ dv <- render value+ return . nest 4 $ "Json.Encode.object" <$$> "[" <+> dv <$$> "]" instance HasEncoder ElmValue where- render (ElmField name value) = do- fieldModifier <- asks fieldLabelModifier- valueBody <- render value- pure $- sformat- ("( \"" % stext % "\", " % stext % " x." % stext % " )")- (fieldModifier name)- valueBody- name- render (ElmPrimitiveRef primitive) = renderRef primitive- render (ElmRef name) = pure $ sformat ("encode" % stext) name- render (Values x y) = sformat (stext % cr % " , " % stext) <$> render x <*> render y+ render (ElmField name value) = do+ fieldModifier <- asks fieldLabelModifier+ valueBody <- render value+ return . spaceparens $+ dquotes (stext (fieldModifier name)) <> comma <+>+ (valueBody <+> "x." <> stext name)+ render (ElmPrimitiveRef primitive) = renderRef primitive+ render (ElmRef name) = pure $ "encode" <> stext name+ render (Values x y) = do+ dx <- render x+ dy <- render y+ return $ dx <$$> comma <+> dy instance HasEncoderRef ElmPrimitive where- renderRef EDate = pure "(Json.Encode.string << toISOString)"- renderRef EUnit = pure "Json.Encode.null"- renderRef EInt = pure "Json.Encode.int"- renderRef EChar = pure "Json.Encode.char"- renderRef EBool = pure "Json.Encode.bool"- renderRef EFloat = pure "Json.Encode.float"- renderRef EString = pure "Json.Encode.string"- renderRef (EList (ElmPrimitive EChar)) = pure "Json.Encode.string"- renderRef (EList datatype) = sformat ("(Json.Encode.list << List.map " % stext % ")") <$> renderRef datatype- renderRef (EMaybe datatype) =- sformat ("(Maybe.withDefault Json.Encode.null << Maybe.map " % stext % ")") <$>- renderRef datatype- renderRef (ETuple2 x y) =- sformat ("(tuple2 " % stext % " " % stext % ")") <$> renderRef x <*>- renderRef y- renderRef (EDict k datatype) =- sformat ("(dict " % stext % " " % stext % ")") <$> renderRef k <*> renderRef datatype+ renderRef EDate = pure $ parens "Json.Encode.string << toString"+ renderRef EUnit = pure "Json.Encode.null"+ renderRef EInt = pure "Json.Encode.int"+ renderRef EChar = pure "Json.Encode.char"+ renderRef EBool = pure "Json.Encode.bool"+ renderRef EFloat = pure "Json.Encode.float"+ renderRef EString = pure "Json.Encode.string"+ renderRef (EList (ElmPrimitive EChar)) = pure "Json.Encode.string"+ renderRef (EList datatype) = do+ dd <- renderRef datatype+ return . parens $ "Json.Encode.list << List.map" <+> dd+ renderRef (EMaybe datatype) = do+ dd <- renderRef datatype+ return . parens $ "Maybe.withDefault Json.Encode.null << Maybe.map" <+> dd+ renderRef (ETuple2 x y) = do+ dx <- renderRef x+ dy <- renderRef y+ return . parens $ "tuple2" <+> dx <+> dy+ renderRef (EDict k v) = do+ dk <- renderRef k+ dv <- renderRef v+ return . parens $ "dict" <+> dk <+> dv -toElmEncoderRefWith :: ElmType a => Options -> a -> Text-toElmEncoderRefWith options x = runReader (renderRef (toElmType x)) options+toElmEncoderRefWith+ :: ElmType a+ => Options -> a -> T.Text+toElmEncoderRefWith options x =+ pprinter $ runReader (renderRef (toElmType x)) options -toElmEncoderRef :: ElmType a => a -> Text+toElmEncoderRef+ :: ElmType a+ => a -> T.Text toElmEncoderRef = toElmEncoderRefWith defaultOptions -toElmEncoderSourceWith :: ElmType a => Options -> a -> Text-toElmEncoderSourceWith options x = runReader (render (toElmType x)) options+toElmEncoderSourceWith+ :: ElmType a+ => Options -> a -> T.Text+toElmEncoderSourceWith options x =+ pprinter $ runReader (render (toElmType x)) options -toElmEncoderSource :: ElmType a => a -> Text+toElmEncoderSource+ :: ElmType a+ => a -> T.Text toElmEncoderSource = toElmEncoderSourceWith defaultOptions
src/Elm/File.hs view
@@ -17,30 +17,30 @@ makePath = T.intercalate "/" data Spec = Spec- { namespace :: [Text]- , declarations :: [Text]- }+ { namespace :: [Text]+ , declarations :: [Text]+ } pathForSpec :: FilePath -> Spec -> [Text] pathForSpec rootDir spec = T.pack rootDir : namespace spec ensureDirectory :: FilePath -> Spec -> IO () ensureDirectory rootDir spec =- let dir = makePath . Data.List.init $ pathForSpec rootDir spec- in createDirectoryIfMissing True (T.unpack dir)+ let dir = makePath . Data.List.init $ pathForSpec rootDir spec+ in createDirectoryIfMissing True (T.unpack dir) specToFile :: FilePath -> Spec -> IO () specToFile rootDir spec =- let path = pathForSpec rootDir spec- file = makePath path <> ".elm"- namespaceText = T.intercalate "." (namespace spec)- body =- T.intercalate- "\n\n"- (sformat ("module " % F.stext % " exposing (..)") namespaceText :- declarations spec)- in do fprint ("Writing: " % F.stext % "\n") file- T.writeFile (T.unpack file) body+ let path = pathForSpec rootDir spec+ file = makePath path <> ".elm"+ namespaceText = T.intercalate "." (namespace spec)+ body =+ T.intercalate+ "\n\n"+ (sformat ("module " % F.stext % " exposing (..)") namespaceText :+ declarations spec)+ in do fprint ("Writing: " % F.stext % "\n") file+ T.writeFile (T.unpack file) body specsToDir :: [Spec] -> FilePath -> IO () specsToDir specs rootDir = mapM_ processSpec specs
src/Elm/Record.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+ module Elm.Record ( toElmTypeRef , toElmTypeRefWith@@ -6,80 +7,99 @@ , toElmTypeSourceWith ) where -import Control.Monad.Reader-import Data.Text-import Elm.Common-import Elm.Type-import Formatting+import Control.Monad.Reader+import Data.Monoid+import qualified Data.Text as T+import Elm.Common+import Elm.Type+import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) class HasType a where- render :: a -> Reader Options Text+ render :: a -> Reader Options Doc class HasTypeRef a where- renderRef :: a -> Reader Options Text+ renderRef :: a -> Reader Options Doc instance HasType ElmDatatype where- render d@(ElmDatatype _ constructor@(RecordConstructor _ _)) =- sformat ("type alias " % stext % " =" % cr % stext) <$> renderRef d <*> render constructor- render d@(ElmDatatype _ constructor@(MultipleConstructors _)) =- sformat ("type " % stext % cr % " = " % stext) <$> renderRef d <*> render constructor- render d@(ElmDatatype _ constructor@(NamedConstructor _ _)) =- sformat ("type " % stext % cr % " = " % stext) <$> renderRef d <*> render constructor- render (ElmPrimitive primitive) = renderRef primitive+ render d@(ElmDatatype _ constructor@(RecordConstructor _ _)) = do+ name <- renderRef d+ ctor <- render constructor+ return . nest 4 $ "type alias" <+> name <+> "=" <$$> ctor+ render d@(ElmDatatype _ constructor) = do+ name <- renderRef d+ ctor <- render constructor+ return . nest 4 $ "type" <+> name <$$> "=" <+> ctor+ render (ElmPrimitive primitive) = renderRef primitive instance HasTypeRef ElmDatatype where- renderRef (ElmDatatype typeName _) =- pure typeName-- renderRef (ElmPrimitive primitive) =- renderRef primitive-+ renderRef (ElmDatatype typeName _) = pure (stext typeName)+ renderRef (ElmPrimitive primitive) = renderRef primitive instance HasType ElmConstructor where- render (RecordConstructor _ value) =- sformat (" { " % stext % cr % " }") <$> render value- render (NamedConstructor constructorName value) =- sformat (stext % stext) constructorName <$> render value- render (MultipleConstructors constructors) =- fmap (Data.Text.intercalate "\n | ") . sequence $ render <$> constructors-+ render (RecordConstructor _ value) = do+ dv <- render value+ return $ "{" <+> dv <$$> "}"+ render (NamedConstructor constructorName value) = do+ dv <- render value+ return $ stext constructorName <+> dv+ render (MultipleConstructors constructors) =+ mintercalate (line <> "|" <> space) <$> sequence (render <$> constructors) instance HasType ElmValue where- render (ElmRef name) = pure name- render ElmEmpty = pure ""- render (Values x y) =- sformat (stext % cr % " , " % stext) <$> render x <*> render y- render (ElmPrimitiveRef primitive) = sformat (" " % stext) <$> renderRef primitive- render (ElmField name value) = do- fieldModifier <- asks fieldLabelModifier- sformat (stext % " :" % stext) (fieldModifier name) <$> render value-+ render (ElmRef name) = pure (stext name)+ render (ElmPrimitiveRef primitive) = renderRef primitive+ render ElmEmpty = pure (text "")+ render (Values x y) = do+ dx <- render x+ dy <- render y+ return $ dx <$$> comma <+> dy+ render (ElmField name value) = do+ fieldModifier <- asks fieldLabelModifier+ dv <- render value+ return $ stext (fieldModifier name) <+> ":" <+> dv instance HasTypeRef ElmPrimitive where- renderRef (EList (ElmPrimitive EChar)) = renderRef EString- renderRef (EList datatype) = sformat ("List (" % stext % ")") <$> renderRef datatype- renderRef (ETuple2 x y) =- sformat ("( " % stext % ", " % stext % " )") <$> renderRef x <*> renderRef y- renderRef (EMaybe datatype) =- sformat ("Maybe (" % stext % ")") <$> renderRef datatype- renderRef (EDict k v) =- sformat ("Dict (" % stext % ") (" % stext % ")") <$> renderRef k <*> renderRef v- renderRef EInt = pure "Int"- renderRef EDate = pure "Date"- renderRef EBool = pure "Bool"- renderRef EChar = pure "Char"- renderRef EString = pure "String"- renderRef EUnit = pure "()"- renderRef EFloat = pure "Float"+ renderRef (EList (ElmPrimitive EChar)) = renderRef EString+ renderRef (EList datatype) = do+ dt <- renderRef datatype+ return $ "List" <+> parens dt+ renderRef (ETuple2 x y) = do+ dx <- render x+ dy <- render y+ return . spaceparens $ dx <> comma <+> dy+ renderRef (EMaybe datatype) = do+ dt <- renderRef datatype+ return $ "Maybe" <+> parens dt+ renderRef (EDict k v) = do+ dk <- renderRef k+ dv <- renderRef v+ return $ "Dict" <+> parens dk <+> parens dv+ renderRef EInt = pure "Int"+ renderRef EDate = pure "Date"+ renderRef EBool = pure "Bool"+ renderRef EChar = pure "Char"+ renderRef EString = pure "String"+ renderRef EUnit = pure "()"+ renderRef EFloat = pure "Float" -toElmTypeRefWith :: ElmType a => Options -> a -> Text-toElmTypeRefWith options x = runReader (renderRef (toElmType x)) options+toElmTypeRefWith+ :: ElmType a+ => Options -> a -> T.Text+toElmTypeRefWith options x =+ pprinter $ runReader (renderRef (toElmType x)) options -toElmTypeRef :: ElmType a => a -> Text+toElmTypeRef+ :: ElmType a+ => a -> T.Text toElmTypeRef = toElmTypeRefWith defaultOptions -toElmTypeSourceWith :: ElmType a => Options -> a -> Text-toElmTypeSourceWith options x = runReader (render (toElmType x)) options+toElmTypeSourceWith+ :: ElmType a+ => Options -> a -> T.Text+toElmTypeSourceWith options x =+ pprinter $ runReader (render (toElmType x)) options -toElmTypeSource :: ElmType a => a -> Text+toElmTypeSource+ :: ElmType a+ => a -> T.Text toElmTypeSource = toElmTypeSourceWith defaultOptions
src/Elm/Type.hs view
@@ -9,6 +9,7 @@ module Elm.Type where import Data.Int (Int16, Int32, Int64, Int8)+import Data.IntMap import Data.Map import Data.Proxy import Data.Text@@ -17,166 +18,169 @@ import Prelude data ElmDatatype- = ElmDatatype Text- ElmConstructor- | ElmPrimitive ElmPrimitive- deriving (Show, Eq)+ = ElmDatatype Text+ ElmConstructor+ | ElmPrimitive ElmPrimitive+ deriving (Show, Eq) data ElmPrimitive- = EInt- | EBool- | EChar- | EDate- | EFloat- | EString- | EUnit- | EList ElmDatatype- | EMaybe ElmDatatype- | ETuple2 ElmDatatype- ElmDatatype- | EDict ElmPrimitive+ = EInt+ | EBool+ | EChar+ | EDate+ | EFloat+ | EString+ | EUnit+ | EList ElmDatatype+ | EMaybe ElmDatatype+ | ETuple2 ElmDatatype ElmDatatype- deriving (Show, Eq)-+ | EDict ElmPrimitive+ ElmDatatype+ deriving (Show, Eq) data ElmConstructor- = NamedConstructor Text- ElmValue- | RecordConstructor Text- ElmValue- | MultipleConstructors [ElmConstructor]- deriving (Show, Eq)+ = NamedConstructor Text+ ElmValue+ | RecordConstructor Text+ ElmValue+ | MultipleConstructors [ElmConstructor]+ deriving (Show, Eq) data ElmValue- = ElmRef Text- | ElmEmpty- | ElmPrimitiveRef ElmPrimitive- | Values ElmValue+ = ElmRef Text+ | ElmEmpty+ | ElmPrimitiveRef ElmPrimitive+ | Values ElmValue+ ElmValue+ | ElmField Text ElmValue- | ElmField Text- ElmValue- deriving (Show, Eq)+ deriving (Show, Eq) --------------------------------------------------------------class ElmType a where- toElmType :: a -> ElmDatatype- toElmType = genericToElmDatatype . from- default toElmType :: (Generic a, GenericElmDatatype (Rep a)) => a -> ElmDatatype+class ElmType a where+ toElmType :: a -> ElmDatatype+ toElmType = genericToElmDatatype . from+ default toElmType :: (Generic a, GenericElmDatatype (Rep a)) =>+ a -> ElmDatatype --------------------------------------------------------------class GenericElmDatatype f where- genericToElmDatatype :: f a -> ElmDatatype+class GenericElmDatatype f where+ genericToElmDatatype :: f a -> ElmDatatype instance (Datatype d, GenericElmConstructor f) => GenericElmDatatype (D1 d f) where- genericToElmDatatype datatype =- ElmDatatype- (pack (datatypeName datatype))- (genericToElmConstructor (unM1 datatype))+ genericToElmDatatype datatype =+ ElmDatatype+ (pack (datatypeName datatype))+ (genericToElmConstructor (unM1 datatype)) -- -------------------------------------------------------------class GenericElmConstructor f where- genericToElmConstructor :: f a -> ElmConstructor+class GenericElmConstructor f where+ genericToElmConstructor :: f a -> ElmConstructor instance (Constructor c, GenericElmValue f) => GenericElmConstructor (C1 c f) where- genericToElmConstructor constructor =- if conIsRecord constructor- then RecordConstructor name (genericToElmValue (unM1 constructor))- else NamedConstructor name (genericToElmValue (unM1 constructor))- where- name = pack $ conName constructor+ genericToElmConstructor constructor =+ if conIsRecord constructor+ then RecordConstructor name (genericToElmValue (unM1 constructor))+ else NamedConstructor name (genericToElmValue (unM1 constructor))+ where+ name = pack $ conName constructor instance (GenericElmConstructor f, GenericElmConstructor g) => GenericElmConstructor (f :+: g) where- genericToElmConstructor _ =- MultipleConstructors- [ genericToElmConstructor (undefined :: f p)- , genericToElmConstructor (undefined :: g p)]+ genericToElmConstructor _ =+ MultipleConstructors+ [ genericToElmConstructor (undefined :: f p)+ , genericToElmConstructor (undefined :: g p)+ ] --------------------------------------------------------------class GenericElmValue f where- genericToElmValue :: f a -> ElmValue+class GenericElmValue f where+ genericToElmValue :: f a -> ElmValue instance (Selector s, GenericElmValue a) => GenericElmValue (S1 s a) where- genericToElmValue selector =- case selName selector of- "" -> genericToElmValue (undefined :: a p)- name -> ElmField (pack name) (genericToElmValue (undefined :: a p))+ genericToElmValue selector =+ case selName selector of+ "" -> genericToElmValue (undefined :: a p)+ name -> ElmField (pack name) (genericToElmValue (undefined :: a p)) instance (GenericElmValue f, GenericElmValue g) => GenericElmValue (f :*: g) where- genericToElmValue _ =- Values- (genericToElmValue (undefined :: f p))- (genericToElmValue (undefined :: g p))+ genericToElmValue _ =+ Values+ (genericToElmValue (undefined :: f p))+ (genericToElmValue (undefined :: g p)) instance GenericElmValue U1 where- genericToElmValue _ = ElmEmpty+ genericToElmValue _ = ElmEmpty instance ElmType a => GenericElmValue (Rec0 a) where- genericToElmValue _ =- case toElmType (undefined :: a) of- ElmPrimitive primitive -> ElmPrimitiveRef primitive- ElmDatatype name _ -> ElmRef name+ genericToElmValue _ =+ case toElmType (Proxy :: Proxy a) of+ ElmPrimitive primitive -> ElmPrimitiveRef primitive+ ElmDatatype name _ -> ElmRef name -instance ElmType a => ElmType [a] where- toElmType _ = ElmPrimitive (EList (toElmType (undefined :: a)))+instance ElmType a =>+ ElmType [a] where+ toElmType _ = ElmPrimitive (EList (toElmType (Proxy :: Proxy a))) -instance ElmType a => ElmType (Maybe a) where- toElmType _ = ElmPrimitive (EMaybe (toElmType (undefined :: a)))+instance ElmType a =>+ ElmType (Maybe a) where+ toElmType _ = ElmPrimitive (EMaybe (toElmType (Proxy :: Proxy a))) instance ElmType () where- toElmType _ = ElmPrimitive EUnit+ toElmType _ = ElmPrimitive EUnit instance ElmType Text where- toElmType _ = ElmPrimitive EString+ toElmType _ = ElmPrimitive EString instance ElmType Day where- toElmType _ = ElmPrimitive EDate+ toElmType _ = ElmPrimitive EDate instance ElmType UTCTime where- toElmType _ = ElmPrimitive EDate+ toElmType _ = ElmPrimitive EDate instance ElmType Float where- toElmType _ = ElmPrimitive EFloat+ toElmType _ = ElmPrimitive EFloat instance ElmType Double where- toElmType _ = ElmPrimitive EFloat+ toElmType _ = ElmPrimitive EFloat instance ElmType Int8 where- toElmType _ = ElmPrimitive EInt+ toElmType _ = ElmPrimitive EInt instance ElmType Int16 where- toElmType _ = ElmPrimitive EInt+ toElmType _ = ElmPrimitive EInt instance ElmType Int32 where- toElmType _ = ElmPrimitive EInt+ toElmType _ = ElmPrimitive EInt instance ElmType Int64 where- toElmType _ = ElmPrimitive EInt+ toElmType _ = ElmPrimitive EInt instance (ElmType a, ElmType b) => ElmType (a, b) where- toElmType _ =- ElmPrimitive $- ETuple2 (toElmType (undefined :: a)) (toElmType (undefined :: b))-+ toElmType _ =+ ElmPrimitive $+ ETuple2 (toElmType (Proxy :: Proxy a)) (toElmType (Proxy :: Proxy b)) instance (ElmType a) => ElmType (Proxy a) where- toElmType _ = toElmType (undefined :: a)+ toElmType _ = toElmType (undefined :: a) instance (HasElmComparable k, ElmType v) => ElmType (Map k v) where- toElmType _ =- ElmPrimitive $- EDict (toElmComparable (undefined :: k)) (toElmType (undefined :: v))+ toElmType _ =+ ElmPrimitive $+ EDict (toElmComparable (undefined :: k)) (toElmType (Proxy :: Proxy v))++instance (ElmType v) =>+ ElmType (IntMap v) where+ toElmType _ = ElmPrimitive $ EDict EInt (toElmType (Proxy :: Proxy v)) class HasElmComparable a where toElmComparable :: a -> ElmPrimitive
test/CommentDecoder.elm view
@@ -1,8 +1,8 @@ module CommentDecoder exposing (..) import CommentType exposing (..)-import Date import Dict+import Exts.Json.Decode exposing (..) import Json.Decode exposing (..) import Json.Decode.Pipeline exposing (..) @@ -14,5 +14,5 @@ |> required "text" string |> required "mainCategories" (tuple2 (,) string string) |> required "published" bool- |> required "created" (customDecoder string Date.fromString)+ |> required "created" decodeDate |> required "tags" (map Dict.fromList (list (tuple2 (,) string int)))
test/CommentDecoderWithOptions.elm view
@@ -1,8 +1,8 @@ module CommentDecoderWithOptions exposing (..) import CommentType exposing (..)-import Date import Dict+import Exts.Json.Decode exposing (..) import Json.Decode exposing (..) import Json.Decode.Pipeline exposing (..) @@ -14,5 +14,5 @@ |> required "commentText" string |> required "commentMainCategories" (tuple2 (,) string string) |> required "commentPublished" bool- |> required "commentCreated" (customDecoder string Date.fromString)+ |> required "commentCreated" decodeDate |> required "commentTags" (map Dict.fromList (list (tuple2 (,) string int)))
test/CommentEncoder.elm view
@@ -1,7 +1,6 @@ module CommentEncoder exposing (..) import CommentType exposing (..)-import Exts.Date exposing (..) import Exts.Json.Encode exposing (..) import Json.Encode @@ -13,6 +12,6 @@ , ( "text", Json.Encode.string x.text ) , ( "mainCategories", (tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) , ( "published", Json.Encode.bool x.published )- , ( "created", (Json.Encode.string << toISOString) x.created )+ , ( "created", (Json.Encode.string << toString) x.created ) , ( "tags", (dict Json.Encode.string Json.Encode.int) x.tags ) ]
test/CommentEncoderWithOptions.elm view
@@ -1,7 +1,6 @@ module CommentEncoderWithOptions exposing (..) import CommentType exposing (..)-import Exts.Date exposing (..) import Exts.Json.Encode exposing (..) import Json.Encode @@ -13,6 +12,6 @@ , ( "commentText", Json.Encode.string x.text ) , ( "commentMainCategories", (tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) , ( "commentPublished", Json.Encode.bool x.published )- , ( "commentCreated", (Json.Encode.string << toISOString) x.created )+ , ( "commentCreated", (Json.Encode.string << toString) x.created ) , ( "commentTags", (dict Json.Encode.string Json.Encode.int) x.tags ) ]
test/ExportSpec.hs view
@@ -4,331 +4,360 @@ module ExportSpec where +import qualified Data.Algorithm.Diff as Diff+import qualified Data.Algorithm.DiffOutput as DiffOutput import Data.Char import Data.Int+import Data.IntMap import Data.Map import Data.Monoid import Data.Proxy-import Data.Text hiding (unlines)+import Data.Text hiding (lines, unlines) import Data.Time import Elm import GHC.Generics-import Test.Hspec hiding (Spec)-import Test.Hspec as Hspec+import Test.Hspec hiding (Spec)+import Test.Hspec as Hspec+import Test.HUnit (Assertion, assertBool) import Text.Printf -- Debugging hint: -- ghci> import GHC.Generics -- ghci> :kind! Rep Post -- ...- data Post = Post- { id :: Int- , name :: String- , age :: Maybe Double- , comments :: [Comment]- , promoted :: Maybe Comment- , author :: Maybe String- } deriving (Generic, ElmType)+ { id :: Int+ , name :: String+ , age :: Maybe Double+ , comments :: [Comment]+ , promoted :: Maybe Comment+ , author :: Maybe String+ } deriving (Generic, ElmType) data Comment = Comment- { postId :: Int- , text :: Text- , mainCategories :: (String, String)- , published :: Bool- , created :: UTCTime- , tags :: Map String Int- } deriving (Generic, ElmType)+ { postId :: Int+ , text :: Text+ , mainCategories :: (String, String)+ , published :: Bool+ , created :: UTCTime+ , tags :: Map String Int+ } deriving (Generic, ElmType) data Position = Beginning | Middle | End- deriving (Generic,ElmType)+ deriving (Generic, ElmType) data Timing = Start | Continue Double | Stop- deriving (Generic,ElmType)+ deriving (Generic, ElmType) newtype Useless =- Useless ()- deriving (Generic, ElmType)+ Useless ()+ deriving (Generic, ElmType) -newtype FavoritePlaces =- FavoritePlaces {positionsByUser :: Map String [Position]}- deriving (Generic,ElmType)+newtype FavoritePlaces = FavoritePlaces+ { positionsByUser :: Map String [Position]+ } deriving (Generic, ElmType) -- | We don't actually use this type, we just need to see that it compiles. data LotsOfInts = LotsOfInts- { intA :: Int8- , intB :: Int16- , intC :: Int32- , intD :: Int64- } deriving (Generic, ElmType)+ { intA :: Int8+ , intB :: Int16+ , intC :: Int32+ , intD :: Int64+ } deriving (Generic, ElmType) spec :: Hspec.Spec-spec =- do toElmTypeSpec- toElmDecoderSpec- toElmEncoderSpec+spec = do+ toElmTypeSpec+ toElmDecoderSpec+ toElmEncoderSpec toElmTypeSpec :: Hspec.Spec toElmTypeSpec =- describe "Convert to Elm types." $- do it "toElmTypeSource Post" $- shouldMatchTypeSource- (unlines ["module PostType exposing (..)"- ,""- ,"import CommentType exposing (..)"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy Post)- "test/PostType.elm"- it "toElmTypeSource Comment" $- shouldMatchTypeSource- (unlines ["module CommentType exposing (..)"- ,""- ,"import Date exposing (Date)"- ,"import Dict exposing (Dict)"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy Comment)- "test/CommentType.elm"- it "toElmTypeSource Position" $- shouldMatchTypeSource- (unlines ["module PositionType exposing (..)","","","%s"])- defaultOptions- (Proxy :: Proxy Position)- "test/PositionType.elm"- it "toElmTypeSource Timing" $- shouldMatchTypeSource- (unlines ["module TimingType exposing (..)","","","%s"])- defaultOptions- (Proxy :: Proxy Timing)- "test/TimingType.elm"- it "toElmTypeSource Useless" $- shouldMatchTypeSource- (unlines ["module UselessType exposing (..)","","","%s"])- defaultOptions- (Proxy :: Proxy Useless)- "test/UselessType.elm"- it "toElmTypeSource FavoritePlaces" $- shouldMatchTypeSource- (unlines ["module FavoritePlacesType exposing (..)"- ,""- ,"import PositionType exposing (..)"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy FavoritePlaces)- "test/FavoritePlacesType.elm"- it "toElmTypeSourceWithOptions Post" $- shouldMatchTypeSource- (unlines ["module PostTypeWithOptions exposing (..)"- ,""- ,"import CommentType exposing (..)"- ,""- ,""- ,"%s"])- (defaultOptions {fieldLabelModifier = withPrefix "post"})- (Proxy :: Proxy Post)- "test/PostTypeWithOptions.elm"- it "toElmTypeSourceWithOptions Comment" $- shouldMatchTypeSource- (unlines ["module CommentTypeWithOptions exposing (..)"- ,""- ,"import Date exposing (Date)"- ,"import Dict exposing (Dict)"- ,""- ,""- ,"%s"])- (defaultOptions {fieldLabelModifier = withPrefix "comment"})- (Proxy :: Proxy Comment)- "test/CommentTypeWithOptions.elm"- describe "Convert to Elm type references." $- do it "toElmTypeRef Post" $- toElmTypeRef (Proxy :: Proxy Post)- `shouldBe` "Post"- it "toElmTypeRef [Comment]" $- toElmTypeRef (Proxy :: Proxy [Comment])- `shouldBe` "List (Comment)"- it "toElmTypeRef String" $- toElmTypeRef (Proxy :: Proxy String)- `shouldBe` "String"- it "toElmTypeRef (Maybe String)" $- toElmTypeRef (Proxy :: Proxy (Maybe String))- `shouldBe` "Maybe (String)"- it "toElmTypeRef [Maybe String]" $- toElmTypeRef (Proxy :: Proxy [Maybe String])- `shouldBe` "List (Maybe (String))"- it "toElmTypeRef (Map String (Maybe String))" $- toElmTypeRef (Proxy :: Proxy (Map String (Maybe String)))- `shouldBe` "Dict (String) (Maybe (String))"+ describe "Convert to Elm types." $ do+ it "toElmTypeSource Post" $+ shouldMatchTypeSource+ (unlines+ [ "module PostType exposing (..)"+ , ""+ , "import CommentType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Post)+ "test/PostType.elm"+ it "toElmTypeSource Comment" $+ shouldMatchTypeSource+ (unlines+ [ "module CommentType exposing (..)"+ , ""+ , "import Date exposing (Date)"+ , "import Dict exposing (Dict)"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentType.elm"+ it "toElmTypeSource Position" $+ shouldMatchTypeSource+ (unlines ["module PositionType exposing (..)", "", "", "%s"])+ defaultOptions+ (Proxy :: Proxy Position)+ "test/PositionType.elm"+ it "toElmTypeSource Timing" $+ shouldMatchTypeSource+ (unlines ["module TimingType exposing (..)", "", "", "%s"])+ defaultOptions+ (Proxy :: Proxy Timing)+ "test/TimingType.elm"+ it "toElmTypeSource Useless" $+ shouldMatchTypeSource+ (unlines ["module UselessType exposing (..)", "", "", "%s"])+ defaultOptions+ (Proxy :: Proxy Useless)+ "test/UselessType.elm"+ it "toElmTypeSource FavoritePlaces" $+ shouldMatchTypeSource+ (unlines+ [ "module FavoritePlacesType exposing (..)"+ , ""+ , "import Dict exposing (..)"+ , "import PositionType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy FavoritePlaces)+ "test/FavoritePlacesType.elm"+ it "toElmTypeSourceWithOptions Post" $+ shouldMatchTypeSource+ (unlines+ [ "module PostTypeWithOptions exposing (..)"+ , ""+ , "import CommentType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostTypeWithOptions.elm"+ it "toElmTypeSourceWithOptions Comment" $+ shouldMatchTypeSource+ (unlines+ [ "module CommentTypeWithOptions exposing (..)"+ , ""+ , "import Date exposing (Date)"+ , "import Dict exposing (Dict)"+ , ""+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentTypeWithOptions.elm"+ describe "Convert to Elm type references." $ do+ it "toElmTypeRef Post" $+ toElmTypeRef (Proxy :: Proxy Post) `shouldBe` "Post"+ it "toElmTypeRef [Comment]" $+ toElmTypeRef (Proxy :: Proxy [Comment]) `shouldBe` "List (Comment)"+ it "toElmTypeRef String" $+ toElmTypeRef (Proxy :: Proxy String) `shouldBe` "String"+ it "toElmTypeRef (Maybe String)" $+ toElmTypeRef (Proxy :: Proxy (Maybe String)) `shouldBe` "Maybe (String)"+ it "toElmTypeRef [Maybe String]" $+ toElmTypeRef (Proxy :: Proxy [Maybe String]) `shouldBe`+ "List (Maybe (String))"+ it "toElmTypeRef (Map String (Maybe String))" $+ toElmTypeRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe`+ "Dict (String) (Maybe (String))"+ it "toElmTypeRef (IntMap (Maybe String))" $+ toElmTypeRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe`+ "Dict (Int) (Maybe (String))" toElmDecoderSpec :: Hspec.Spec toElmDecoderSpec =- describe "Convert to Elm decoders." $- do it "toElmDecoderSource Comment" $- shouldMatchDecoderSource- (unlines ["module CommentDecoder exposing (..)"- ,""- ,"import CommentType exposing (..)"- ,"import Date"- ,"import Dict"- ,"import Json.Decode exposing (..)"- ,"import Json.Decode.Pipeline exposing (..)"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy Comment)- "test/CommentDecoder.elm"- it "toElmDecoderSource Post" $- shouldMatchDecoderSource- (unlines ["module PostDecoder exposing (..)"- ,""- ,"import CommentDecoder exposing (..)"- ,"import Json.Decode exposing (..)"- ,"import Json.Decode.Pipeline exposing (..)"- ,"import PostType exposing (..)"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy Post)- "test/PostDecoder.elm"- it "toElmDecoderSourceWithOptions Post" $- shouldMatchDecoderSource- (unlines ["module PostDecoderWithOptions exposing (..)"- ,""- ,"import CommentDecoder exposing (..)"- ,"import Json.Decode exposing (..)"- ,"import Json.Decode.Pipeline exposing (..)"- ,"import PostType exposing (..)"- ,""- ,""- ,"%s"])- (defaultOptions {fieldLabelModifier = withPrefix "post"})- (Proxy :: Proxy Post)- "test/PostDecoderWithOptions.elm"- it "toElmDecoderSourceWithOptions Comment" $- shouldMatchDecoderSource- (unlines ["module CommentDecoderWithOptions exposing (..)"- ,""- ,"import CommentType exposing (..)"- ,"import Date"- ,"import Dict"- ,"import Json.Decode exposing (..)"- ,"import Json.Decode.Pipeline exposing (..)"- ,""- ,""- ,"%s"])- (defaultOptions {fieldLabelModifier = withPrefix "comment"})- (Proxy :: Proxy Comment)- "test/CommentDecoderWithOptions.elm"- describe "Convert to Elm decoder references." $- do it "toElmDecoderRef Post" $- toElmDecoderRef (Proxy :: Proxy Post)- `shouldBe` "decodePost"- it "toElmDecoderRef [Comment]" $- toElmDecoderRef (Proxy :: Proxy [Comment])- `shouldBe` "(list decodeComment)"- it "toElmDecoderRef String" $- toElmDecoderRef (Proxy :: Proxy String)- `shouldBe` "string"- it "toElmDecoderRef (Maybe String)" $- toElmDecoderRef (Proxy :: Proxy (Maybe String))- `shouldBe` "(maybe string)"- it "toElmDecoderRef [Maybe String]" $- toElmDecoderRef (Proxy :: Proxy [Maybe String])- `shouldBe` "(list (maybe string))"- it "toElmDecoderRef (Map String (Maybe String))" $- toElmDecoderRef (Proxy :: Proxy (Map String (Maybe String)))- `shouldBe` "(map Dict.fromList (list (tuple2 (,) string (maybe string))))"+ describe "Convert to Elm decoders." $ do+ it "toElmDecoderSource Comment" $+ shouldMatchDecoderSource+ (unlines+ [ "module CommentDecoder exposing (..)"+ , ""+ , "import CommentType exposing (..)"+ , "import Dict"+ , "import Exts.Json.Decode exposing (..)"+ , "import Json.Decode exposing (..)"+ , "import Json.Decode.Pipeline exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentDecoder.elm"+ it "toElmDecoderSource Post" $+ shouldMatchDecoderSource+ (unlines+ [ "module PostDecoder exposing (..)"+ , ""+ , "import CommentDecoder exposing (..)"+ , "import Json.Decode exposing (..)"+ , "import Json.Decode.Pipeline exposing (..)"+ , "import PostType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Post)+ "test/PostDecoder.elm"+ it "toElmDecoderSourceWithOptions Post" $+ shouldMatchDecoderSource+ (unlines+ [ "module PostDecoderWithOptions exposing (..)"+ , ""+ , "import CommentDecoder exposing (..)"+ , "import Json.Decode exposing (..)"+ , "import Json.Decode.Pipeline exposing (..)"+ , "import PostType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostDecoderWithOptions.elm"+ it "toElmDecoderSourceWithOptions Comment" $+ shouldMatchDecoderSource+ (unlines+ [ "module CommentDecoderWithOptions exposing (..)"+ , ""+ , "import CommentType exposing (..)"+ , "import Dict"+ , "import Exts.Json.Decode exposing (..)"+ , "import Json.Decode exposing (..)"+ , "import Json.Decode.Pipeline exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentDecoderWithOptions.elm"+ describe "Convert to Elm decoder references." $ do+ it "toElmDecoderRef Post" $+ toElmDecoderRef (Proxy :: Proxy Post) `shouldBe` "decodePost"+ it "toElmDecoderRef [Comment]" $+ toElmDecoderRef (Proxy :: Proxy [Comment]) `shouldBe`+ "(list decodeComment)"+ it "toElmDecoderRef String" $+ toElmDecoderRef (Proxy :: Proxy String) `shouldBe` "string"+ it "toElmDecoderRef (Maybe String)" $+ toElmDecoderRef (Proxy :: Proxy (Maybe String)) `shouldBe`+ "(maybe string)"+ it "toElmDecoderRef [Maybe String]" $+ toElmDecoderRef (Proxy :: Proxy [Maybe String]) `shouldBe`+ "(list (maybe string))"+ it "toElmDecoderRef (Map String (Maybe String))" $+ toElmDecoderRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe`+ "(map Dict.fromList (list (tuple2 (,) string (maybe string))))"+ it "toElmDecoderRef (IntMap (Maybe String))" $+ toElmDecoderRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe`+ "(map Dict.fromList (list (tuple2 (,) int (maybe string))))" toElmEncoderSpec :: Hspec.Spec toElmEncoderSpec =- describe "Convert to Elm encoders." $- do it "toElmEncoderSource Comment" $- shouldMatchEncoderSource- (unlines ["module CommentEncoder exposing (..)"- ,""- ,"import CommentType exposing (..)"- ,"import Exts.Date exposing (..)"- ,"import Exts.Json.Encode exposing (..)"- ,"import Json.Encode"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy Comment)- "test/CommentEncoder.elm"- it "toElmEncoderSource Post" $- shouldMatchEncoderSource- (unlines ["module PostEncoder exposing (..)"- ,""- ,"import CommentEncoder exposing (..)"- ,"import Json.Encode"- ,"import PostType exposing (..)"- ,""- ,""- ,"%s"])- defaultOptions- (Proxy :: Proxy Post)- "test/PostEncoder.elm"- it "toElmEncoderSourceWithOptions Comment" $- shouldMatchEncoderSource- (unlines ["module CommentEncoderWithOptions exposing (..)"- ,""- ,"import CommentType exposing (..)"- ,"import Exts.Date exposing (..)"- ,"import Exts.Json.Encode exposing (..)"- ,"import Json.Encode"- ,""- ,""- ,"%s"])- (defaultOptions {fieldLabelModifier = withPrefix "comment"})- (Proxy :: Proxy Comment)- "test/CommentEncoderWithOptions.elm"- it "toElmEncoderSourceWithOptions Post" $- shouldMatchEncoderSource- (unlines ["module PostEncoderWithOptions exposing (..)"- ,""- ,"import CommentEncoder exposing (..)"- ,"import Json.Encode"- ,"import PostType exposing (..)"- ,""- ,""- ,"%s"])- (defaultOptions {fieldLabelModifier = withPrefix "post"})- (Proxy :: Proxy Post)- "test/PostEncoderWithOptions.elm"- describe "Convert to Elm encoder references." $- do it "toElmEncoderRef Post" $- toElmEncoderRef (Proxy :: Proxy Post)- `shouldBe` "encodePost"- it "toElmEncoderRef [Comment]" $- toElmEncoderRef (Proxy :: Proxy [Comment])- `shouldBe` "(Json.Encode.list << List.map encodeComment)"- it "toElmEncoderRef String" $- toElmEncoderRef (Proxy :: Proxy String)- `shouldBe` "Json.Encode.string"- it "toElmEncoderRef (Maybe String)" $- toElmEncoderRef (Proxy :: Proxy (Maybe String))- `shouldBe` "(Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string)"- it "toElmEncoderRef [Maybe String]" $- toElmEncoderRef (Proxy :: Proxy [Maybe String])- `shouldBe` "(Json.Encode.list << List.map (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))"- it "toElmEncoderRef (Map String (Maybe String))" $- toElmEncoderRef (Proxy :: Proxy (Map String (Maybe String)))- `shouldBe` "(dict Json.Encode.string (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))"+ describe "Convert to Elm encoders." $ do+ it "toElmEncoderSource Comment" $+ shouldMatchEncoderSource+ (unlines+ [ "module CommentEncoder exposing (..)"+ , ""+ , "import CommentType exposing (..)"+ , "import Exts.Json.Encode exposing (..)"+ , "import Json.Encode"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Comment)+ "test/CommentEncoder.elm"+ it "toElmEncoderSource Post" $+ shouldMatchEncoderSource+ (unlines+ [ "module PostEncoder exposing (..)"+ , ""+ , "import CommentEncoder exposing (..)"+ , "import Json.Encode"+ , "import PostType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ defaultOptions+ (Proxy :: Proxy Post)+ "test/PostEncoder.elm"+ it "toElmEncoderSourceWithOptions Comment" $+ shouldMatchEncoderSource+ (unlines+ [ "module CommentEncoderWithOptions exposing (..)"+ , ""+ , "import CommentType exposing (..)"+ , "import Exts.Json.Encode exposing (..)"+ , "import Json.Encode"+ , ""+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "comment"})+ (Proxy :: Proxy Comment)+ "test/CommentEncoderWithOptions.elm"+ it "toElmEncoderSourceWithOptions Post" $+ shouldMatchEncoderSource+ (unlines+ [ "module PostEncoderWithOptions exposing (..)"+ , ""+ , "import CommentEncoder exposing (..)"+ , "import Json.Encode"+ , "import PostType exposing (..)"+ , ""+ , ""+ , "%s"+ ])+ (defaultOptions {fieldLabelModifier = withPrefix "post"})+ (Proxy :: Proxy Post)+ "test/PostEncoderWithOptions.elm"+ describe "Convert to Elm encoder references." $ do+ it "toElmEncoderRef Post" $+ toElmEncoderRef (Proxy :: Proxy Post) `shouldBe` "encodePost"+ it "toElmEncoderRef [Comment]" $+ toElmEncoderRef (Proxy :: Proxy [Comment]) `shouldBe`+ "(Json.Encode.list << List.map encodeComment)"+ it "toElmEncoderRef String" $+ toElmEncoderRef (Proxy :: Proxy String) `shouldBe` "Json.Encode.string"+ it "toElmEncoderRef (Maybe String)" $+ toElmEncoderRef (Proxy :: Proxy (Maybe String)) `shouldBe`+ "(Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string)"+ it "toElmEncoderRef [Maybe String]" $+ toElmEncoderRef (Proxy :: Proxy [Maybe String]) `shouldBe`+ "(Json.Encode.list << List.map (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))"+ it "toElmEncoderRef (Map String (Maybe String))" $+ toElmEncoderRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe`+ "(dict Json.Encode.string (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))"+ it "toElmEncoderRef (IntMap (Maybe String))" $+ toElmEncoderRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe`+ "(dict Json.Encode.int (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))" shouldMatchTypeSource :: ElmType a@@ -349,15 +378,22 @@ shouldMatchFile . printf wrapping $ toElmEncoderSourceWith options x shouldMatchFile :: String -> FilePath -> IO ()-shouldMatchFile actual fileExpected =- do source <- readFile fileExpected- actual `shouldBe` source+shouldMatchFile actual fileExpected = do+ source <- readFile fileExpected+ actual `shouldBeDiff` (fileExpected, source) +shouldBeDiff :: String -> (String, String) -> Assertion+shouldBeDiff a (fpath, b) =+ assertBool+ ("< generated\n" <> "> " <> fpath <> "\n" <>+ DiffOutput.ppDiff (Diff.getGroupedDiff (lines a) (lines b)))+ (a == b)+ initCap :: Text -> Text initCap t =- case uncons t of- Nothing -> t- Just (c, cs) -> cons (Data.Char.toUpper c) cs+ case uncons t of+ Nothing -> t+ Just (c, cs) -> cons (Data.Char.toUpper c) cs withPrefix :: Text -> Text -> Text-withPrefix prefix s = prefix <> ( initCap s)+withPrefix prefix s = prefix <> (initCap s)
test/FavoritePlacesType.elm view
@@ -1,5 +1,6 @@ module FavoritePlacesType exposing (..) +import Dict exposing (..) import PositionType exposing (..)
test/TypesSpec.hs view
@@ -1,10 +1,10 @@-{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DeriveAnyClass #-}+{-# LANGUAGE DeriveGeneric #-} module TypesSpec where -import Elm-import GHC.Generics+import Elm+import GHC.Generics import Test.Hspec as Hspec -- All the types in this file should be Elm-encodable.