packages feed

elm-export 0.4.1.1 → 0.5.0.0

raw patch · 22 files changed

+515/−525 lines, 22 filesdep ~QuickCheckdep ~elm-exportdep ~hspecPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: QuickCheck, elm-export, hspec, hspec-core, text

API changes (from Hackage documentation)

Files

elm-export.cabal view
@@ -1,5 +1,5 @@ name: elm-export-version: 0.4.1.1+version: 0.5.0.0 cabal-version: >=1.10 build-type: Simple license: OtherLicense@@ -13,8 +13,6 @@     Generate Elm source code automatically from Haskell types. Using GHC.Generics, we can automatically derive Elm type declarations, and Aeson-compatible JSON decoders & encoders. category: Web author: Kris Jenkins-extra-source-files:-    test/*.elm  source-repository head     type: git@@ -30,7 +28,7 @@         directory >=1.2.2.0 && <1.3,         formatting >=6.2.2 && <6.3,         mtl >=2.2.1 && <2.3,-        text >=1.2.2.0 && <1.3,+        text >=1.2.2.1 && <1.3,         time >=1.5.0.1 && <1.6     default-language: Haskell2010     hs-source-dirs: src@@ -41,23 +39,25 @@         Elm.Encoder         Elm.File         Elm.Record+    ghc-options: -Wall  test-suite elm-export-test     type: exitcode-stdio-1.0     main-is: Spec.hs     build-depends:-        QuickCheck >=2.8.1 && <2.9,+        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.4.1.1 && <0.5,-        hspec >=2.2.2 && <2.3,-        hspec-core >=2.2.2 && <2.3,+        elm-export >=0.5.0.0 && <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.0 && <1.3,+        text >=1.2.2.1 && <1.3,         time >=1.5.0.1 && <1.6     default-language: Haskell2010     hs-source-dirs: test     other-modules:         ExportSpec-    ghc-options: -threaded -rtsopts -with-rtsopts=-N+        TypesSpec+    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall
src/Elm/Common.hs view
@@ -1,24 +1,14 @@ {-# LANGUAGE OverloadedStrings #-} module Elm.Common  where -import           Data.Monoid ((<>))-import           Data.Text-import           Elm.Type--isTopLevel :: ElmTypeExpr -> Bool-isTopLevel (Primitive _) = True-isTopLevel (DataType _ _) = True-isTopLevel (Product (Primitive "List") (Primitive "Char")) = True-isTopLevel _ = False---- Put parentheses around the string if the Elm type requires it (i.e. it's not a--- Primitive Elm type nor a named DataType).-parenthesize :: ElmTypeExpr -> Text -> Text-parenthesize t s =-  if isTopLevel t then s else ("(" <> s <> ")")+import           Data.Text  (Text)+import           Formatting  data Options =   Options {fieldLabelModifier :: Text -> Text}  defaultOptions :: Options defaultOptions = Options {fieldLabelModifier = id}++cr :: Format r r+cr = now "\n"
src/Elm/Decoder.hs view
@@ -5,7 +5,9 @@ {-# LANGUAGE TypeOperators     #-}  module Elm.Decoder-  ( toElmDecoderSource+  ( toElmDecoderRef+  , toElmDecoderRefWith+  , toElmDecoderSource   , toElmDecoderSourceWith   ) where @@ -15,69 +17,82 @@ import           Elm.Type import           Formatting -cr :: Format r r-cr = now "\n"+class HasDecoder a where+  render :: a -> Reader Options Text -render :: ElmTypeExpr -> Reader Options Text+class HasDecoderRef a where+  renderRef :: a -> Reader Options Text -render (TopLevel (DataType d t)) =-    sformat-        (stext % " : Decoder " % stext % cr % stext % " =" % cr % stext)-        fnName-        d-        fnName <$>-    render t-  where-    fnName = sformat ("decode" % stext) d+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 (DataType d _) = pure $ sformat ("decode" % stext) d+instance HasDecoderRef ElmDatatype where+    renderRef (ElmDatatype name _) =+        pure $ sformat ("decode" % stext) name -render (Record n t) =-    sformat ("    decode " % stext % cr % stext) n <$> render t+    renderRef (ElmPrimitive primitive) =+        renderRef primitive -render (Product (Primitive "List") (Primitive "Char")) =-    render (Primitive "String") -render (Product (Primitive "List") t) =-    sformat ("(list " % stext % ")") <$> render t+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 (Product (Primitive "Maybe") t) =-    sformat ("(maybe " % stext % ")") <$> render t -render (Product x y) =-    sformat (stext % cr % stext) <$> render x <*> render y+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 (Selector n t) = do-    fieldModifier <- asks fieldLabelModifier-    sformat-        ("        |> required \"" % stext % "\" " % stext)-        (fieldModifier n) <$>-        render t -render (Tuple2 x y) =-    sformat ("(tuple2 (,) " % stext % " " % stext % ")") <$> render x <*>-    render y+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" -render (Dict x y) =-    sformat ("(map Dict.fromList (list " % stext % "))") <$>-    render (Tuple2 x y) -render (Primitive "String") = pure "string"-render (Primitive "Int") = pure "int"-render (Primitive "Double") = pure "float"-render (Primitive "Float") = pure "float"-render (Primitive "Date") = pure "(customDecoder string Date.fromString)"-render (Primitive "Bool") = pure "bool"-render (Field t) = render t-render x = pure $ sformat ("<" % shown % ">") x+toElmDecoderRefWith :: ElmType a => Options -> a -> Text+toElmDecoderRefWith options x = runReader (renderRef (toElmType x)) options  -toElmDecoderSourceWith-    :: ElmType a-    => Options -> a -> Text-toElmDecoderSourceWith options x = runReader (render . TopLevel $ toElmType x) options+toElmDecoderRef :: ElmType a => a -> Text+toElmDecoderRef = toElmDecoderRefWith defaultOptions -toElmDecoderSource-    :: ElmType a-    => a -> Text++toElmDecoderSourceWith :: ElmType a => Options -> a -> Text+toElmDecoderSourceWith options x = runReader (render (toElmType x)) options+++toElmDecoderSource :: ElmType a => a -> Text toElmDecoderSource = toElmDecoderSourceWith defaultOptions
src/Elm/Encoder.hs view
@@ -1,6 +1,10 @@ {-# LANGUAGE OverloadedStrings #-}-module Elm.Encoder (toElmEncoderSource, toElmEncoderSourceWith)-       where+module Elm.Encoder+  ( toElmEncoderRef+  , toElmEncoderRefWith+  , toElmEncoderSource+  , toElmEncoderSourceWith+  ) where  import           Control.Monad.Reader import           Data.Text@@ -8,62 +12,75 @@ import           Elm.Type import           Formatting -render :: ElmTypeExpr -> Reader Options Text--render (TopLevel (DataType d t)) =-    sformat-        (stext % " : " % stext % " -> Value\n" % stext % " x =" % stext)-        fnName-        d-        fnName <$>-    render t-  where-    fnName = sformat ("encode" % stext) d--render (DataType d _) = return $ sformat ("encode" % stext) d+class HasEncoder a where+  render :: a -> Reader Options Text -render (Record _ t) =-  sformat ("\n    object\n        [ " % stext % "\n        ]") <$> render t+class HasEncoderRef a where+  renderRef :: a -> Reader Options Text -render (Product (Primitive "List") (Primitive "Char")) =-  render (Primitive "String")+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 (Product (Primitive "List") t) =-  sformat ("(list << List.map " % stext % ")") <$> render t+instance HasEncoderRef ElmDatatype where+    renderRef (ElmDatatype name _) =+        pure $ sformat ("encode" % stext) name -render (Product (Primitive "Maybe") t) =-  sformat ("(Maybe.withDefault null << Maybe.map " % stext % ")") <$> render t+    renderRef (ElmPrimitive primitive) =+        renderRef primitive -render (Tuple2 x y) =-  do bodyX <- render x-     bodyY <- render y-     return $ sformat ("tuple2 " % stext % " " % stext) bodyX bodyY+instance HasEncoder ElmConstructor where+    render (RecordConstructor _ value) =+      sformat (cr % "    Json.Encode.object" % cr % "        [ " % stext % cr % "        ]") <$> render value -render (Dict x y) =-  do bodyX <- render x-     bodyY <- render y-     return $ sformat ("dict " % stext % " " % stext) bodyX bodyY+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 (Product x y) =-  do bodyX <- render x-     bodyY <- render y-     return $ sformat (stext % "\n        , " % stext) bodyX bodyY+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 -render (Selector n t) =-  do fieldModifier <- asks fieldLabelModifier-     typeBody <- render t-     return $ sformat ("( \"" % stext % "\", " % stext % " x." % stext % " )") (fieldModifier n) typeBody n+toElmEncoderRefWith :: ElmType a => Options -> a -> Text+toElmEncoderRefWith options x = runReader (renderRef (toElmType x)) options -render  (Primitive "String") = return "string"-render  (Primitive "Int") = return "int"-render  (Primitive "Double") = return "float"-render  (Primitive "Float") = return "float"-render  (Primitive "Date") = return "(string << toISOString)"-render  (Primitive "Bool") = return "bool"-render  (Field t) = render t+toElmEncoderRef :: ElmType a => a -> Text+toElmEncoderRef = toElmEncoderRefWith defaultOptions  toElmEncoderSourceWith :: ElmType a => Options -> a -> Text-toElmEncoderSourceWith options x = runReader (render . TopLevel $ toElmType x) options+toElmEncoderSourceWith options x = runReader (render (toElmType x)) options  toElmEncoderSource :: ElmType a => a -> Text toElmEncoderSource = toElmEncoderSourceWith defaultOptions
src/Elm/File.hs view
@@ -1,38 +1,48 @@-module Elm.File (Spec(..),specsToDir) where+{-# LANGUAGE OverloadedStrings #-} +module Elm.File+  ( Spec(..)+  , specsToDir+  ) where+ import           Data.List+import           Data.Monoid+import           Data.Text        (Text)+import qualified Data.Text        as T+import qualified Data.Text.IO     as T+import           Formatting       as F import           System.Directory-import           Text.Printf -pathString :: [String] -> String-pathString = intercalate "/"+makePath :: [Text] -> Text+makePath = T.intercalate "/" -data Spec =-  Spec {namespace    :: [String]-       ,declarations :: [String]}+data Spec = Spec+    { namespace    :: [Text]+    , declarations :: [Text]+    } -pathForSpec :: FilePath -> Spec -> [String]-pathForSpec rootDir spec = rootDir : namespace spec+pathForSpec :: FilePath -> Spec -> [Text]+pathForSpec rootDir spec = T.pack rootDir : namespace spec  ensureDirectory :: FilePath -> Spec -> IO () ensureDirectory rootDir spec =-  let dir = pathString . init $ pathForSpec rootDir spec-  in createDirectoryIfMissing True 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 = pathString path ++ ".elm"-      namespaceString =-        intercalate "."-                    (namespace spec)-      body =-        intercalate-          "\n\n"-          (printf "module %s exposing (..)" namespaceString : declarations spec)-  in do printf "Writing: %s\n" file-        writeFile 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-  where processSpec = ensureDirectory rootDir >> specToFile rootDir+  where+    processSpec = ensureDirectory rootDir >> specToFile rootDir
src/Elm/Record.hs view
@@ -1,73 +1,85 @@ {-# LANGUAGE OverloadedStrings #-}-module Elm.Record (toElmTypeSource,toElmTypeSourceWith) where+module Elm.Record+  ( toElmTypeRef+  , toElmTypeRefWith+  , toElmTypeSource+  , toElmTypeSourceWith+  ) where  import           Control.Monad.Reader+import           Data.Text import           Elm.Common import           Elm.Type import           Formatting-import Data.Text -render :: ElmTypeExpr -> Reader Options Text--render (TopLevel (DataType dataTypeName record@(Record _ _))) =-    sformat ("type alias " % stext % " =\n    { " % stext % "\n    }") dataTypeName <$>-    render record+class HasType a where+  render :: a -> Reader Options Text -render (TopLevel (DataType d s@(Sum _ _))) =-    sformat ("type " % stext % "\n    = " % stext) d <$> render s+class HasTypeRef a where+  renderRef :: a -> Reader Options Text +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 (DataType d _) = return d-render (Primitive s) = return s+instance HasTypeRef ElmDatatype where+    renderRef (ElmDatatype typeName _) =+        pure typeName -render (Sum x y) =-    sformat (stext % "\n    | " % stext) <$> render x <*> render y+    renderRef (ElmPrimitive primitive) =+        renderRef primitive  -render (Field t) = render t--render (Selector s t) = do-    fieldModifier <- asks fieldLabelModifier-    sformat (stext % " : " % stext) (fieldModifier s) <$> render t--render (Constructor c Unit) = pure c--render (Constructor c t) = sformat (stext % " " % stext) c <$> render t--render (Tuple2 x y) =-    sformat ("( " % stext % ", " % stext % " )") <$> render x <*> render y--render (Dict x y) =-    sformat ("Dict " % stext % " " % stext) <$> render x <*> render y+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 (Product (Primitive "List") (Primitive "Char")) = return "String"--render (Product (Primitive "List") p@(Product _ _)) =-  sformat ("List (" % stext % ")") <$> render p--render (Product (Primitive "List") t) = sformat ("List " % stext) <$> render t--render (Product (Primitive "Dict") (Product k v)) =-    sformat ("Dict " % stext % " " % stext) <$> render k <*> render v+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 (Product x y) =-  do bodyX <- render x-     bodyY <- render y-     return $ sformat (stext % " " % stext) bodyX (parenthesize y  bodyY)--render (Record n (Product x y)) =-  do bodyX <- render (Record n x)-     bodyY <- render (Record n y)-     return $ sformat (stext % "\n    , " % stext) bodyX bodyY+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" -render (Record _ s@(Selector _ _)) = render s+toElmTypeRefWith :: ElmType a => Options -> a -> Text+toElmTypeRefWith options x = runReader (renderRef (toElmType x)) options -render Unit = return ""+toElmTypeRef :: ElmType a => a -> Text+toElmTypeRef = toElmTypeRefWith defaultOptions  toElmTypeSourceWith :: ElmType a => Options -> a -> Text-toElmTypeSourceWith options x = runReader (render . TopLevel $ toElmType x) options+toElmTypeSourceWith options x = runReader (render (toElmType x)) options  toElmTypeSource :: ElmType a => a -> Text toElmTypeSource = toElmTypeSourceWith defaultOptions
src/Elm/Type.hs view
@@ -1,14 +1,13 @@-{-# LANGUAGE DefaultSignatures   #-}-{-# LANGUAGE FlexibleContexts    #-}-{-# LANGUAGE FlexibleInstances   #-}-{-# LANGUAGE GADTs               #-}-{-# LANGUAGE OverloadedStrings   #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# LANGUAGE TypeOperators       #-}+{-# LANGUAGE DefaultSignatures    #-}+{-# LANGUAGE FlexibleContexts     #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE OverloadedStrings    #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TypeOperators        #-}+{-# LANGUAGE TypeSynonymInstances #-}  module Elm.Type where -import           Data.Int     (Int16, Int32, Int64, Int8) import           Data.Map import           Data.Proxy import           Data.Text@@ -16,134 +15,167 @@ import           GHC.Generics import           Prelude --- TODO Without doubt, this definition can be tightened up so that--- there are fewer (or hopefully zero) representable illegal states.-data ElmTypeExpr where-        TopLevel :: ElmTypeExpr -> ElmTypeExpr-        DataType :: Text -> ElmTypeExpr -> ElmTypeExpr-        Record :: Text -> ElmTypeExpr -> ElmTypeExpr-        Constructor :: Text -> ElmTypeExpr -> ElmTypeExpr-        Selector :: Text -> ElmTypeExpr -> ElmTypeExpr-        Field :: ElmTypeExpr -> ElmTypeExpr-        Sum :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr-        Dict :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr-        Tuple2 :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr-        Product :: ElmTypeExpr -> ElmTypeExpr -> ElmTypeExpr-        Unit :: ElmTypeExpr-        Primitive :: Text -> ElmTypeExpr-    deriving (Eq, Show)+data ElmDatatype+    = ElmDatatype Text+                  ElmConstructor+    | ElmPrimitive ElmPrimitive+     deriving (Show, Eq) -class ElmType a  where-    toElmType :: a -> ElmTypeExpr-    toElmType = genericToElmType . from-    default toElmType :: (Generic a, GenericElmType (Rep a)) => a -> ElmTypeExpr+data ElmPrimitive+    = EInt+    | EBool+    | EChar+    | EDate+    | EFloat+    | EString+    | EUnit+    | EList ElmDatatype+    | EMaybe ElmDatatype+    | ETuple2 ElmDatatype+              ElmDatatype+    | EDict ElmPrimitive+            ElmDatatype+     deriving (Show, Eq) -instance ElmType Bool where-    toElmType _ = Primitive "Bool" -instance ElmType Char where-    toElmType _ = Primitive "Char"+data ElmConstructor+    = NamedConstructor Text+                       ElmValue+    | RecordConstructor Text+                        ElmValue+    | MultipleConstructors [ElmConstructor]+     deriving (Show, Eq) -instance ElmType Text where-    toElmType _ = Primitive "String"+data ElmValue+    = ElmRef Text+    | ElmEmpty+    | ElmPrimitiveRef ElmPrimitive+    | Values ElmValue+             ElmValue+    | ElmField Text+               ElmValue+     deriving (Show, Eq) -instance ElmType Float where-    toElmType _ = Primitive "Float"+------------------------------------------------------------ -instance ElmType UTCTime where-    toElmType _ = Primitive "Date"+class ElmType a  where+    toElmType :: a -> ElmDatatype+    toElmType = genericToElmDatatype . from+    default toElmType :: (Generic a, GenericElmDatatype (Rep a)) => a -> ElmDatatype -instance ElmType Day where-    toElmType _ = Primitive "Date"+------------------------------------------------------------ -instance ElmType Double where-    toElmType _ = Primitive "Float"+class GenericElmDatatype f  where+    genericToElmDatatype :: f a -> ElmDatatype -instance ElmType Int where-    toElmType _ = Primitive "Int"+instance (Datatype d, GenericElmConstructor f) =>+         GenericElmDatatype (D1 d f) where+    genericToElmDatatype datatype =+        ElmDatatype+            (pack (datatypeName datatype))+            (genericToElmConstructor (unM1 datatype)) -instance ElmType Integer where-    toElmType _ = Primitive "Int"+-- ------------------------------------------------------------+class GenericElmConstructor f  where+    genericToElmConstructor :: f a -> ElmConstructor -instance ElmType Int8 where-    toElmType _ = Primitive "Int"+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 -instance ElmType Int16 where-    toElmType _ = Primitive "Int"+instance (GenericElmConstructor f, GenericElmConstructor g) =>+         GenericElmConstructor (f :+: g) where+    genericToElmConstructor _ =+        MultipleConstructors+            [ genericToElmConstructor (undefined :: f p)+            , genericToElmConstructor (undefined :: g p)] -instance ElmType Int32 where-    toElmType _ = Primitive "Int"+------------------------------------------------------------ -instance ElmType Int64 where-    toElmType _ = Primitive "Int"+class GenericElmValue f  where+    genericToElmValue :: f a -> ElmValue -instance (ElmType a, ElmType b) =>-         ElmType (a, b) where-    toElmType _ =-        Tuple2 (toElmType (Proxy :: Proxy a)) (toElmType (Proxy :: Proxy b))+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)) -instance ElmType a =>-         ElmType [a] where-    toElmType _ = Product (Primitive "List") (toElmType (Proxy :: Proxy a))+instance (GenericElmValue f, GenericElmValue g) =>+         GenericElmValue (f :*: g) where+    genericToElmValue _ =+        Values+            (genericToElmValue (undefined :: f p))+            (genericToElmValue (undefined :: g p)) +instance GenericElmValue U1 where+    genericToElmValue _ = ElmEmpty+ instance ElmType a =>-         ElmType (Maybe a) where-    toElmType _ = Product (Primitive "Maybe") (toElmType (Proxy :: Proxy a))+         GenericElmValue (Rec0 a) where+    genericToElmValue _ =+        case toElmType (undefined :: a) of+            ElmPrimitive primitive -> ElmPrimitiveRef primitive+            ElmDatatype name _ -> ElmRef name -instance (ElmType k, ElmType v) =>-         ElmType (Map k v) where-    toElmType _ =-        Dict (toElmType (Proxy :: Proxy k)) (toElmType (Proxy :: Proxy v))+instance ElmType a => ElmType [a] where+    toElmType _ = ElmPrimitive (EList (toElmType (undefined :: a))) -instance ElmType a =>-         ElmType (Proxy a) where-    toElmType _ = toElmType (undefined :: a)+instance ElmType a => ElmType (Maybe a) where+    toElmType _ = ElmPrimitive (EMaybe (toElmType (undefined :: a))) -------------------------------------------------------------+instance ElmType () where+    toElmType _ = ElmPrimitive EUnit -class GenericElmType f  where-    genericToElmType :: f a -> ElmTypeExpr+instance ElmType Text where+    toElmType _ = ElmPrimitive EString -instance (Datatype d, GenericElmType f) =>-         GenericElmType (D1 d f) where-    genericToElmType datatype =-        DataType-            (pack (datatypeName datatype))-            (genericToElmType (unM1 datatype))+instance ElmType Day where+    toElmType _ = ElmPrimitive EDate -instance (Constructor c, GenericElmType f) =>-         GenericElmType (C1 c f) where-    genericToElmType constructor =-        if conIsRecord constructor-            then Record name body-            else Constructor name body-      where-        name = pack $ conName constructor-        body = genericToElmType (unM1 constructor)+instance ElmType UTCTime where+    toElmType _ = ElmPrimitive EDate -instance (Selector c, GenericElmType f) =>-         GenericElmType (S1 c f) where-    genericToElmType selector =-        Selector (pack (selName selector)) (genericToElmType (unM1 selector))+instance ElmType Float where+    toElmType _ = ElmPrimitive EFloat -instance GenericElmType U1 where-    genericToElmType _ = Unit+instance ElmType Double where+    toElmType _ = ElmPrimitive EFloat -instance (ElmType c) =>-         GenericElmType (Rec0 c) where-    genericToElmType parameter = Field (toElmType (unK1 parameter))+instance (ElmType a, ElmType b) =>+         ElmType (a, b) where+    toElmType _ =+        ElmPrimitive $+        ETuple2 (toElmType (undefined :: a)) (toElmType (undefined :: b))  -instance (GenericElmType f, GenericElmType g) =>-         GenericElmType (f :+: g) where-    genericToElmType _ =-        Sum-            (genericToElmType (undefined :: f p))-            (genericToElmType (undefined :: g p))+instance (ElmType a) =>+         ElmType (Proxy a) where+    toElmType _ = toElmType (undefined :: a) -instance (GenericElmType f, GenericElmType g) =>-         GenericElmType (f :*: g) where-    genericToElmType _ =-        Product-            (genericToElmType (undefined :: f p))-            (genericToElmType (undefined :: g p))+instance (HasElmComparable k, ElmType v) =>+         ElmType (Map k v) where+    toElmType _ =+        ElmPrimitive $+        EDict (toElmComparable (undefined :: k)) (toElmType (undefined :: v))++class HasElmComparable a where+  toElmComparable :: a -> ElmPrimitive++instance HasElmComparable String where+  toElmComparable _ = EString++instance ElmType Int where+  toElmType _ = ElmPrimitive EInt++instance ElmType Char where+  toElmType _ = ElmPrimitive EChar++instance ElmType Bool where+  toElmType _ = ElmPrimitive EBool
− test/CommentDecoder.elm 
@@ -1,18 +0,0 @@-module CommentDecoder exposing (..)--import CommentType exposing (..)-import Date-import Dict-import Json.Decode exposing (..)-import Json.Decode.Pipeline exposing (..)---decodeComment : Decoder Comment-decodeComment =-    decode Comment-        |> required "postId" int-        |> required "text" string-        |> required "mainCategories" (tuple2 (,) string string)-        |> required "published" bool-        |> required "created" (customDecoder string Date.fromString)-        |> required "tags" (map Dict.fromList (list (tuple2 (,) string int)))
− test/CommentDecoderWithOptions.elm 
@@ -1,18 +0,0 @@-module CommentDecoderWithOptions exposing (..)--import CommentType exposing (..)-import Date-import Dict-import Json.Decode exposing (..)-import Json.Decode.Pipeline exposing (..)---decodeComment : Decoder Comment-decodeComment =-    decode Comment-        |> required "commentPostId" int-        |> required "commentText" string-        |> required "commentMainCategories" (tuple2 (,) string string)-        |> required "commentPublished" bool-        |> required "commentCreated" (customDecoder string Date.fromString)-        |> required "commentTags" (map Dict.fromList (list (tuple2 (,) string int)))
− test/CommentEncoder.elm 
@@ -1,18 +0,0 @@-module CommentEncoder exposing (..)--import CommentType exposing (..)-import Exts.Date exposing (..)-import Exts.Json.Encode exposing (..)-import Json.Encode exposing (..)---encodeComment : Comment -> Value-encodeComment x =-    object-        [ ( "postId", int x.postId )-        , ( "text", string x.text )-        , ( "mainCategories", tuple2 string string x.mainCategories )-        , ( "published", bool x.published )-        , ( "created", (string << toISOString) x.created )-        , ( "tags", dict string int x.tags )-        ]
− test/CommentEncoderWithOptions.elm 
@@ -1,18 +0,0 @@-module CommentEncoderWithOptions exposing (..)--import CommentType exposing (..)-import Exts.Date exposing (..)-import Exts.Json.Encode exposing (..)-import Json.Encode exposing (..)---encodeComment : Comment -> Value-encodeComment x =-    object-        [ ( "commentPostId", int x.postId )-        , ( "commentText", string x.text )-        , ( "commentMainCategories", tuple2 string string x.mainCategories )-        , ( "commentPublished", bool x.published )-        , ( "commentCreated", (string << toISOString) x.created )-        , ( "commentTags", dict string int x.tags )-        ]
− test/CommentType.elm 
@@ -1,14 +0,0 @@-module CommentType exposing (..)--import Date exposing (Date)-import Dict exposing (Dict)---type alias Comment =-    { postId : Int-    , text : String-    , mainCategories : ( String, String )-    , published : Bool-    , created : Date-    , tags : Dict String Int-    }
− test/CommentTypeWithOptions.elm 
@@ -1,14 +0,0 @@-module CommentTypeWithOptions exposing (..)--import Date exposing (Date)-import Dict exposing (Dict)---type alias Comment =-    { commentPostId : Int-    , commentText : String-    , commentMainCategories : ( String, String )-    , commentPublished : Bool-    , commentCreated : Date-    , commentTags : Dict String Int-    }
test/ExportSpec.hs view
@@ -16,30 +16,49 @@ import           Test.Hspec   as Hspec import           Text.Printf -data Post =-  Post {id       :: Int-       ,name     :: String-       ,age      :: Maybe Double-       ,comments :: [Comment]-       ,promoted :: Maybe Comment-       ,author   :: Maybe String}-  deriving (Generic,ElmType)+-- Debugging hint:+-- ghci> import GHC.Generics+-- ghci> :kind! Rep Post+-- ... -data Comment =-  Comment {postId         :: Int-          ,text           :: Text-          ,mainCategories :: (String,String)-          ,published      :: Bool-          ,created        :: UTCTime-          ,tags           :: Map String Int}-  deriving (Generic,ElmType)+data Post = Post+    { 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)+ data Position   = Beginning   | Middle   | End   deriving (Generic,ElmType) +data Timing+  = Start+  | Continue Double+  | Stop+  deriving (Generic,ElmType)++newtype Useless =+    Useless ()+     deriving (Generic, ElmType)++newtype FavoritePlaces =+  FavoritePlaces {positionsByUser :: Map String [Position]}+  deriving (Generic,ElmType)+ spec :: Hspec.Spec spec =   do toElmTypeSpec@@ -78,6 +97,29 @@          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 (..)"@@ -101,6 +143,25 @@          (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))"  toElmDecoderSpec :: Hspec.Spec toElmDecoderSpec =@@ -163,6 +224,25 @@          (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))))"  toElmEncoderSpec :: Hspec.Spec toElmEncoderSpec =@@ -174,7 +254,7 @@                   ,"import CommentType exposing (..)"                   ,"import Exts.Date exposing (..)"                   ,"import Exts.Json.Encode exposing (..)"-                  ,"import Json.Encode exposing (..)"+                  ,"import Json.Encode"                   ,""                   ,""                   ,"%s"])@@ -186,7 +266,7 @@          (unlines ["module PostEncoder exposing (..)"                   ,""                   ,"import CommentEncoder exposing (..)"-                  ,"import Json.Encode exposing (..)"+                  ,"import Json.Encode"                   ,"import PostType exposing (..)"                   ,""                   ,""@@ -201,7 +281,7 @@                   ,"import CommentType exposing (..)"                   ,"import Exts.Date exposing (..)"                   ,"import Exts.Json.Encode exposing (..)"-                  ,"import Json.Encode exposing (..)"+                  ,"import Json.Encode"                   ,""                   ,""                   ,"%s"])@@ -213,7 +293,7 @@          (unlines ["module PostEncoderWithOptions exposing (..)"                   ,""                   ,"import CommentEncoder exposing (..)"-                  ,"import Json.Encode exposing (..)"+                  ,"import Json.Encode"                   ,"import PostType exposing (..)"                   ,""                   ,""@@ -221,6 +301,25 @@          (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))"  shouldMatchTypeSource   :: ElmType a
− test/PositionType.elm 
@@ -1,7 +0,0 @@-module PositionType exposing (..)---type Position-    = Beginning-    | Middle-    | End
− test/PostDecoder.elm 
@@ -1,17 +0,0 @@-module PostDecoder exposing (..)--import CommentDecoder exposing (..)-import Json.Decode exposing (..)-import Json.Decode.Pipeline exposing (..)-import PostType exposing (..)---decodePost : Decoder Post-decodePost =-    decode Post-        |> required "id" int-        |> required "name" string-        |> required "age" (maybe float)-        |> required "comments" (list decodeComment)-        |> required "promoted" (maybe decodeComment)-        |> required "author" (maybe string)
− test/PostDecoderWithOptions.elm 
@@ -1,17 +0,0 @@-module PostDecoderWithOptions exposing (..)--import CommentDecoder exposing (..)-import Json.Decode exposing (..)-import Json.Decode.Pipeline exposing (..)-import PostType exposing (..)---decodePost : Decoder Post-decodePost =-    decode Post-        |> required "postId" int-        |> required "postName" string-        |> required "postAge" (maybe float)-        |> required "postComments" (list decodeComment)-        |> required "postPromoted" (maybe decodeComment)-        |> required "postAuthor" (maybe string)
− test/PostEncoder.elm 
@@ -1,17 +0,0 @@-module PostEncoder exposing (..)--import CommentEncoder exposing (..)-import Json.Encode exposing (..)-import PostType exposing (..)---encodePost : Post -> Value-encodePost x =-    object-        [ ( "id", int x.id )-        , ( "name", string x.name )-        , ( "age", (Maybe.withDefault null << Maybe.map float) x.age )-        , ( "comments", (list << List.map encodeComment) x.comments )-        , ( "promoted", (Maybe.withDefault null << Maybe.map encodeComment) x.promoted )-        , ( "author", (Maybe.withDefault null << Maybe.map string) x.author )-        ]
− test/PostEncoderWithOptions.elm 
@@ -1,17 +0,0 @@-module PostEncoderWithOptions exposing (..)--import CommentEncoder exposing (..)-import Json.Encode exposing (..)-import PostType exposing (..)---encodePost : Post -> Value-encodePost x =-    object-        [ ( "postId", int x.id )-        , ( "postName", string x.name )-        , ( "postAge", (Maybe.withDefault null << Maybe.map float) x.age )-        , ( "postComments", (list << List.map encodeComment) x.comments )-        , ( "postPromoted", (Maybe.withDefault null << Maybe.map encodeComment) x.promoted )-        , ( "postAuthor", (Maybe.withDefault null << Maybe.map string) x.author )-        ]
− test/PostType.elm 
@@ -1,13 +0,0 @@-module PostType exposing (..)--import CommentType exposing (..)---type alias Post =-    { id : Int-    , name : String-    , age : Maybe Float-    , comments : List Comment-    , promoted : Maybe Comment-    , author : Maybe String-    }
− test/PostTypeWithOptions.elm 
@@ -1,13 +0,0 @@-module PostTypeWithOptions exposing (..)--import CommentType exposing (..)---type alias Post =-    { postId : Int-    , postName : String-    , postAge : Maybe Float-    , postComments : List Comment-    , postPromoted : Maybe Comment-    , postAuthor : Maybe String-    }
+ test/TypesSpec.hs view
@@ -0,0 +1,16 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DeriveAnyClass #-}++module TypesSpec where++import Elm+import GHC.Generics+import           Test.Hspec   as Hspec++-- All the types in this file should be Elm-encodable.+data Person = Person+    { personName :: String+    } deriving (Generic, ElmType)++spec :: Hspec.Spec+spec = return ()