From 214537e6ccda46fb3ac2ab34a05310972f40aa3f Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Tue, 24 Jan 2017 22:21:50 +0000 Subject: [PATCH 01/24] Add moduleSpec and renderType functions. --- README.md | 16 ++++------------ src/Elm/Common.hs | 25 ++++++++++++++++++++++++- src/Elm/Decoder.hs | 20 +++++++++++++++----- src/Elm/Encoder.hs | 22 +++++++++++++++------- src/Elm/File.hs | 25 +++++++++++++++++++++++-- src/Elm/Record.hs | 17 +++++++++++------ test/CommentEncoder.elm | 4 ++-- test/CommentEncoderWithOptions.elm | 4 ++-- test/ExportSpec.hs | 26 +++++++++++++++++++++++--- 9 files changed, 119 insertions(+), 40 deletions(-) diff --git a/README.md b/README.md index 08053ab..0934908 100644 --- a/README.md +++ b/README.md @@ -42,13 +42,10 @@ import Elm spec :: Spec spec = - Spec - ["Db", "Types"] - [ "import Json.Decode exposing (..)" - , "import Json.Decode.Pipeline exposing (..)" - , toElmTypeSource (Proxy :: Proxy Person) - , toElmDecoderSource (Proxy :: Proxy Person) - ] + moduleSpec ["Db", "Types"] $ do + renderType (Proxy :: Proxy Person) + renderDecoder (Proxy :: Proxy Person) + renderEncoder (Proxy :: Proxy Person) main :: IO () main = specsToDir [spec] "some/where/output" @@ -57,11 +54,6 @@ main = specsToDir [spec] "some/where/output" Run this and the directory `some/where/output` will be created, and under that the Elm source file `Db/Types.elm` will be found. -All the hard work here is done by `toElmTypeSource` and -`toElmDecoderSource`. The `Spec` code is just wrapping to make it easy -to create a complete Elm file from the meat that `ElmType` gives -you. - ### Required Elm Packages The decoders we produce require these extra Elm packages installed: diff --git a/src/Elm/Common.hs b/src/Elm/Common.hs index 6963ab8..c36fab0 100644 --- a/src/Elm/Common.hs +++ b/src/Elm/Common.hs @@ -2,11 +2,14 @@ module Elm.Common where +import Control.Monad.Reader +import Control.Monad.Writer import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) -import Data.Monoid import Data.Text (Text) import qualified Data.Text.Lazy as LT import Formatting hiding (text) +import Data.Set (Set) +import qualified Data.Set as S data Options = Options { fieldLabelModifier :: Text -> Text @@ -33,3 +36,23 @@ stext = text . LT.fromStrict spaceparens :: Doc -> Doc spaceparens doc = "(" <+> doc <+> ")" + +-- + +type RenderM a = + WriterT ( Set Text -- The set of required imports + , [Text] -- Declarations + ) + (Reader Options) a + +{-| Add an import to the set. +-} +require :: Text -> RenderM () +require dep = tell (S.singleton dep, []) + +{-| Take the result of a RenderM computation and put it into the Writer's +declarations. +-} +collectDeclaration :: RenderM Doc -> RenderM () +collectDeclaration = + mapWriterT (fmap (\(defn, (imports, _)) -> ((), (imports, [pprinter defn])))) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 5883961..cf37669 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -8,20 +8,21 @@ module Elm.Decoder , toElmDecoderRefWith , toElmDecoderSource , toElmDecoderSourceWith + , renderDecoder ) where import Control.Monad.Reader -import Data.Monoid +import Control.Monad.Writer 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 Doc + render :: a -> RenderM Doc class HasDecoderRef a where - renderRef :: a -> Reader Options Doc + renderRef :: a -> RenderM Doc instance HasDecoder ElmDatatype where render d@(ElmDatatype name constructor) = do @@ -62,6 +63,7 @@ instance HasDecoderRef ElmPrimitive where dt <- renderRef datatype return . parens $ "list" <+> dt renderRef (EDict key value) = do + require "Dict" d <- renderRef (EList (ElmPrimitive (ETuple2 (ElmPrimitive key) value))) return . parens $ "map Dict.fromList" <+> d renderRef (EMaybe datatype) = do @@ -83,7 +85,8 @@ instance HasDecoderRef ElmPrimitive where toElmDecoderRefWith :: ElmType a => Options -> a -> T.Text -toElmDecoderRefWith options x = pprinter $ runReader (renderRef (toElmType x)) options +toElmDecoderRefWith options x = + pprinter . fst $ runReader (runWriterT (renderRef (toElmType x))) options toElmDecoderRef :: ElmType a @@ -93,9 +96,16 @@ toElmDecoderRef = toElmDecoderRefWith defaultOptions toElmDecoderSourceWith :: ElmType a => Options -> a -> T.Text -toElmDecoderSourceWith options x = pprinter $ runReader (render (toElmType x)) options +toElmDecoderSourceWith options x = + pprinter . fst $ runReader (runWriterT (render (toElmType x))) options toElmDecoderSource :: ElmType a => a -> T.Text toElmDecoderSource = toElmDecoderSourceWith defaultOptions + +renderDecoder :: ElmType a => a -> RenderM () +renderDecoder x = + require "Json.Decode exposing (..)" >> + require "Json.Decode.Pipeline exposing (..)" >> + (collectDeclaration . render . toElmType $ x) diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index 1ec4ff6..495c7ef 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -5,20 +5,21 @@ module Elm.Encoder , toElmEncoderRefWith , toElmEncoderSource , toElmEncoderSourceWith + , renderEncoder ) where import Control.Monad.Reader -import Data.Monoid +import Control.Monad.Writer 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 Doc + render :: a -> RenderM Doc class HasEncoderRef a where - renderRef :: a -> Reader Options Doc + renderRef :: a -> RenderM Doc instance HasEncoder ElmDatatype where render d@(ElmDatatype name constructor) = do @@ -70,17 +71,19 @@ instance HasEncoderRef ElmPrimitive where renderRef (ETuple2 x y) = do dx <- renderRef x dy <- renderRef y - return . parens $ "tuple2" <+> dx <+> dy + require "Exts.Json.Encode" + return . parens $ "Exts.Json.Encode.tuple2" <+> dx <+> dy renderRef (EDict k v) = do dk <- renderRef k dv <- renderRef v - return . parens $ "dict" <+> dk <+> dv + require "Exts.Json.Encode" + return . parens $ "Exts.Json.Encode.dict" <+> dk <+> dv toElmEncoderRefWith :: ElmType a => Options -> a -> T.Text toElmEncoderRefWith options x = - pprinter $ runReader (renderRef (toElmType x)) options + pprinter . fst $ runReader (runWriterT (renderRef (toElmType x))) options toElmEncoderRef :: ElmType a @@ -91,9 +94,14 @@ toElmEncoderSourceWith :: ElmType a => Options -> a -> T.Text toElmEncoderSourceWith options x = - pprinter $ runReader (render (toElmType x)) options + pprinter . fst $ runReader (runWriterT (render (toElmType x))) options toElmEncoderSource :: ElmType a => a -> T.Text toElmEncoderSource = toElmEncoderSourceWith defaultOptions + +renderEncoder :: ElmType a => a -> RenderM () +renderEncoder x = + require "Json.Encode" >> + (collectDeclaration . render . toElmType $ x) diff --git a/src/Elm/File.hs b/src/Elm/File.hs index 5a664f5..9464697 100644 --- a/src/Elm/File.hs +++ b/src/Elm/File.hs @@ -3,13 +3,18 @@ module Elm.File ( Spec(..) , specsToDir + , moduleSpec + , moduleSpecWith ) where +import Control.Monad.Reader +import Control.Monad.Writer import Data.List -import Data.Monoid +import qualified Data.Set as S import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.IO as T +import Elm.Common import Formatting as F import System.Directory @@ -19,7 +24,7 @@ makePath = T.intercalate "/" data Spec = Spec { namespace :: [Text] , declarations :: [Text] - } + } deriving (Eq, Show) pathForSpec :: FilePath -> Spec -> [Text] pathForSpec rootDir spec = T.pack rootDir : namespace spec @@ -46,3 +51,19 @@ specsToDir :: [Spec] -> FilePath -> IO () specsToDir specs rootDir = mapM_ processSpec specs where processSpec = ensureDirectory rootDir >> specToFile rootDir + +moduleSpecWith :: Options -> [Text] -> RenderM () -> Spec +moduleSpecWith options ns m = + let + (imports, defns) = + runReader (execWriterT m) options + in + Spec + { namespace = ns + , declarations = + (T.intercalate "\n" . fmap ("import " <>) . S.toAscList $ imports) + : defns + } + +moduleSpec :: [Text] -> RenderM () -> Spec +moduleSpec = moduleSpecWith defaultOptions diff --git a/src/Elm/Record.hs b/src/Elm/Record.hs index 97eded0..b3063a7 100644 --- a/src/Elm/Record.hs +++ b/src/Elm/Record.hs @@ -5,20 +5,21 @@ module Elm.Record , toElmTypeRefWith , toElmTypeSource , toElmTypeSourceWith + , renderType ) where import Control.Monad.Reader -import Data.Monoid +import Control.Monad.Writer 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 Doc + render :: a -> RenderM Doc class HasTypeRef a where - renderRef :: a -> Reader Options Doc + renderRef :: a -> RenderM Doc instance HasType ElmDatatype where render d@(ElmDatatype _ constructor@(RecordConstructor _ _)) = do @@ -71,11 +72,12 @@ instance HasTypeRef ElmPrimitive where dt <- renderRef datatype return $ "Maybe" <+> parens dt renderRef (EDict k v) = do + require "Dict" dk <- renderRef k dv <- renderRef v return $ "Dict" <+> parens dk <+> parens dv renderRef EInt = pure "Int" - renderRef EDate = pure "Date" + renderRef EDate = require "Date" >> pure "Date" renderRef EBool = pure "Bool" renderRef EChar = pure "Char" renderRef EString = pure "String" @@ -86,7 +88,7 @@ toElmTypeRefWith :: ElmType a => Options -> a -> T.Text toElmTypeRefWith options x = - pprinter $ runReader (renderRef (toElmType x)) options + pprinter . fst $ runReader (runWriterT (renderRef (toElmType x))) options toElmTypeRef :: ElmType a @@ -97,9 +99,12 @@ toElmTypeSourceWith :: ElmType a => Options -> a -> T.Text toElmTypeSourceWith options x = - pprinter $ runReader (render (toElmType x)) options + pprinter . fst $ runReader (runWriterT (render (toElmType x))) options toElmTypeSource :: ElmType a => a -> T.Text toElmTypeSource = toElmTypeSourceWith defaultOptions + +renderType :: ElmType a => a -> RenderM () +renderType = collectDeclaration . render . toElmType diff --git a/test/CommentEncoder.elm b/test/CommentEncoder.elm index bc916b9..0acc9be 100644 --- a/test/CommentEncoder.elm +++ b/test/CommentEncoder.elm @@ -10,8 +10,8 @@ encodeComment x = Json.Encode.object [ ( "postId", Json.Encode.int x.postId ) , ( "text", Json.Encode.string x.text ) - , ( "mainCategories", (tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) + , ( "mainCategories", (Exts.Json.Encode.tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) , ( "published", Json.Encode.bool x.published ) , ( "created", (Json.Encode.string << toString) x.created ) - , ( "tags", (dict Json.Encode.string Json.Encode.int) x.tags ) + , ( "tags", (Exts.Json.Encode.dict Json.Encode.string Json.Encode.int) x.tags ) ] diff --git a/test/CommentEncoderWithOptions.elm b/test/CommentEncoderWithOptions.elm index 7f314e1..5769e68 100644 --- a/test/CommentEncoderWithOptions.elm +++ b/test/CommentEncoderWithOptions.elm @@ -10,8 +10,8 @@ encodeComment x = Json.Encode.object [ ( "commentPostId", Json.Encode.int x.postId ) , ( "commentText", Json.Encode.string x.text ) - , ( "commentMainCategories", (tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) + , ( "commentMainCategories", (Exts.Json.Encode.tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) , ( "commentPublished", Json.Encode.bool x.published ) , ( "commentCreated", (Json.Encode.string << toString) x.created ) - , ( "commentTags", (dict Json.Encode.string Json.Encode.int) x.tags ) + , ( "commentTags", (Exts.Json.Encode.dict Json.Encode.string Json.Encode.int) x.tags ) ] diff --git a/test/ExportSpec.hs b/test/ExportSpec.hs index 650dc1c..7e753fa 100644 --- a/test/ExportSpec.hs +++ b/test/ExportSpec.hs @@ -12,7 +12,7 @@ import Data.IntMap import Data.Map import Data.Monoid import Data.Proxy -import Data.Text hiding (lines, unlines) +import Data.Text hiding (head, lines, unlines) import Data.Time import Elm import GHC.Generics @@ -76,6 +76,7 @@ spec = do toElmTypeSpec toElmDecoderSpec toElmEncoderSpec + moduleSpecsSpec toElmTypeSpec :: Hspec.Spec toElmTypeSpec = @@ -356,10 +357,29 @@ toElmEncoderSpec = "(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))" + "(Exts.Json.Encode.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))" + "(Exts.Json.Encode.dict Json.Encode.int (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))" + +moduleSpecsSpec :: Hspec.Spec +moduleSpecsSpec = + describe "Generating a module Spec" $ do + let mySpec = + moduleSpec ["My", "Module"] $ do + renderType (Proxy :: Proxy Post) + renderDecoder (Proxy :: Proxy Post) + renderType (Proxy :: Proxy Comment) + it "sets the module namespace" $ + namespace mySpec `shouldBe` ["My", "Module"] + it "inserts the correct imports" $ + head (declarations mySpec) `shouldBe` + intercalate "\n" + [ "import Date" + , "import Dict" + , "import Json.Decode exposing (..)" + , "import Json.Decode.Pipeline exposing (..)" + ] shouldMatchTypeSource :: ElmType a From 66f7ed139b9f27d57d20361b5f0b4e41a17c71db Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Fri, 10 Feb 2017 10:32:29 +0000 Subject: [PATCH 02/24] Readme updates. --- README.md | 14 ++++++++++++-- 1 file changed, 12 insertions(+), 2 deletions(-) diff --git a/README.md b/README.md index 0934908..5ea01f7 100644 --- a/README.md +++ b/README.md @@ -43,6 +43,7 @@ import Elm spec :: Spec spec = moduleSpec ["Db", "Types"] $ do + require "Date exposing (Date)" renderType (Proxy :: Proxy Person) renderDecoder (Proxy :: Proxy Person) renderEncoder (Proxy :: Proxy Person) @@ -81,6 +82,15 @@ stack test --file-watch ## Change Log +### V0.6.x +Updated to Elm 0.18. + +### V0.5.x +??? + +### V0.4.x +??? + ### V0.3.0.0 * Renamed `ToElmType` to `ElmType`, for brevity. @@ -92,8 +102,8 @@ stack test --file-watch ## Status -Alpha. The author is using it in production, but it is not yet -expected to work for every reasonable case. +Beta. Several people are using it in production, reliably, but it is +not yet expected to work for every reasonable datatype. There are some Haskell datatypes that cannot be represented in Elm. Obviously we will not support those. But there are some which are From 2a0e578f93a57f7752ab4a705366cfd60911f49f Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Sat, 11 Feb 2017 21:32:36 +0000 Subject: [PATCH 03/24] Exporting Elm.Common.require, for the new moduleSpec code. --- src/Elm.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Elm.hs b/src/Elm.hs index 854ba3e..0e04e3d 100644 --- a/src/Elm.hs +++ b/src/Elm.hs @@ -2,7 +2,7 @@ module Elm ( module X ) where -import Elm.Common as X (Options(..), defaultOptions) +import Elm.Common as X (Options(..), defaultOptions, require) import Elm.Decoder as X import Elm.Encoder as X import Elm.File as X From b300274c80a15eebeca0de6819ccb5e166bc469e Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Sat, 11 Feb 2017 21:34:36 +0000 Subject: [PATCH 04/24] Whitespace changes. --- src/Elm/Common.hs | 23 ++++++++++------------- src/Elm/Decoder.hs | 4 +++- src/Elm/Encoder.hs | 7 ++++--- src/Elm/File.hs | 39 ++++++++++++++++++--------------------- src/Elm/Record.hs | 4 +++- src/Elm/Type.hs | 32 ++++++++++++++++---------------- 6 files changed, 54 insertions(+), 55 deletions(-) diff --git a/src/Elm/Common.hs b/src/Elm/Common.hs index c36fab0..75a6e2a 100644 --- a/src/Elm/Common.hs +++ b/src/Elm/Common.hs @@ -2,14 +2,14 @@ module Elm.Common where -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.Reader +import Control.Monad.Writer +import Data.Set (Set) +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text.Lazy as LT +import Formatting hiding (text) import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) -import Data.Text (Text) -import qualified Data.Text.Lazy as LT -import Formatting hiding (text) -import Data.Set (Set) -import qualified Data.Set as S data Options = Options { fieldLabelModifier :: Text -> Text @@ -38,12 +38,9 @@ spaceparens :: Doc -> Doc spaceparens doc = "(" <+> doc <+> ")" -- - -type RenderM a = - WriterT ( Set Text -- The set of required imports - , [Text] -- Declarations - ) - (Reader Options) a +type RenderM a = WriterT (Set Text -- The set of required imports + , [Text] -- Declarations + ) (Reader Options) a {-| Add an import to the set. -} diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index cf37669..9204a63 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -104,7 +104,9 @@ toElmDecoderSource => a -> T.Text toElmDecoderSource = toElmDecoderSourceWith defaultOptions -renderDecoder :: ElmType a => a -> RenderM () +renderDecoder + :: ElmType a + => a -> RenderM () renderDecoder x = require "Json.Decode exposing (..)" >> require "Json.Decode.Pipeline exposing (..)" >> diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index 495c7ef..ea44711 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -101,7 +101,8 @@ toElmEncoderSource => a -> T.Text toElmEncoderSource = toElmEncoderSourceWith defaultOptions -renderEncoder :: ElmType a => a -> RenderM () +renderEncoder + :: ElmType a + => a -> RenderM () renderEncoder x = - require "Json.Encode" >> - (collectDeclaration . render . toElmType $ x) + require "Json.Encode" >> (collectDeclaration . render . toElmType $ x) diff --git a/src/Elm/File.hs b/src/Elm/File.hs index 9464697..3f75233 100644 --- a/src/Elm/File.hs +++ b/src/Elm/File.hs @@ -7,22 +7,22 @@ module Elm.File , moduleSpecWith ) where -import Control.Monad.Reader -import Control.Monad.Writer -import Data.List -import qualified Data.Set as S -import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Text.IO as T -import Elm.Common -import Formatting as F -import System.Directory +import Control.Monad.Reader +import Control.Monad.Writer +import Data.List +import qualified Data.Set as S +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as T +import Elm.Common +import Formatting as F +import System.Directory makePath :: [Text] -> Text makePath = T.intercalate "/" data Spec = Spec - { namespace :: [Text] + { namespace :: [Text] , declarations :: [Text] } deriving (Eq, Show) @@ -54,16 +54,13 @@ specsToDir specs rootDir = mapM_ processSpec specs moduleSpecWith :: Options -> [Text] -> RenderM () -> Spec moduleSpecWith options ns m = - let - (imports, defns) = - runReader (execWriterT m) options - in - Spec - { namespace = ns - , declarations = - (T.intercalate "\n" . fmap ("import " <>) . S.toAscList $ imports) - : defns - } + let (imports, defns) = runReader (execWriterT m) options + in Spec + { namespace = ns + , declarations = + (T.intercalate "\n" . fmap ("import " <>) . S.toAscList $ imports) : + defns + } moduleSpec :: [Text] -> RenderM () -> Spec moduleSpec = moduleSpecWith defaultOptions diff --git a/src/Elm/Record.hs b/src/Elm/Record.hs index b3063a7..1cebfcb 100644 --- a/src/Elm/Record.hs +++ b/src/Elm/Record.hs @@ -106,5 +106,7 @@ toElmTypeSource => a -> T.Text toElmTypeSource = toElmTypeSourceWith defaultOptions -renderType :: ElmType a => a -> RenderM () +renderType + :: ElmType a + => a -> RenderM () renderType = collectDeclaration . render . toElmType diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs index 7a0d39c..dccbfb6 100644 --- a/src/Elm/Type.hs +++ b/src/Elm/Type.hs @@ -1,21 +1,21 @@ -{-# LANGUAGE DefaultSignatures #-} -{-# LANGUAGE FlexibleContexts #-} -{-# LANGUAGE FlexibleInstances #-} -{-# 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.IntMap -import Data.Map -import Data.Proxy -import Data.Text -import Data.Time -import GHC.Generics -import Prelude +import Data.Int (Int16, Int32, Int64, Int8) +import Data.IntMap +import Data.Map +import Data.Proxy +import Data.Text +import Data.Time +import GHC.Generics +import Prelude data ElmDatatype = ElmDatatype Text @@ -104,7 +104,7 @@ instance (Selector s, GenericElmValue a) => GenericElmValue (S1 s a) where genericToElmValue selector = case selName selector of - "" -> genericToElmValue (undefined :: a p) + "" -> genericToElmValue (undefined :: a p) name -> ElmField (pack name) (genericToElmValue (undefined :: a p)) instance (GenericElmValue f, GenericElmValue g) => @@ -122,7 +122,7 @@ instance ElmType a => genericToElmValue _ = case toElmType (Proxy :: Proxy a) of ElmPrimitive primitive -> ElmPrimitiveRef primitive - ElmDatatype name _ -> ElmRef name + ElmDatatype name _ -> ElmRef name instance ElmType a => ElmType [a] where From 872576ab9c6beaaef733a43045502a150d207dda Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Sun, 12 Feb 2017 16:38:33 +0000 Subject: [PATCH 05/24] Use Control.Monad.RWS. --- src/Elm/Common.hs | 11 +++++------ src/Elm/Decoder.hs | 7 +++---- src/Elm/Encoder.hs | 7 +++---- src/Elm/File.hs | 5 ++--- src/Elm/Record.hs | 7 +++---- 5 files changed, 16 insertions(+), 21 deletions(-) diff --git a/src/Elm/Common.hs b/src/Elm/Common.hs index 75a6e2a..b574770 100644 --- a/src/Elm/Common.hs +++ b/src/Elm/Common.hs @@ -2,8 +2,7 @@ module Elm.Common where -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.RWS import Data.Set (Set) import qualified Data.Set as S import Data.Text (Text) @@ -38,9 +37,9 @@ spaceparens :: Doc -> Doc spaceparens doc = "(" <+> doc <+> ")" -- -type RenderM a = WriterT (Set Text -- The set of required imports - , [Text] -- Declarations - ) (Reader Options) a +type RenderM = RWS Options (Set Text -- The set of required imports + , [Text] -- Generated declarations + ) () {-| Add an import to the set. -} @@ -52,4 +51,4 @@ declarations. -} collectDeclaration :: RenderM Doc -> RenderM () collectDeclaration = - mapWriterT (fmap (\(defn, (imports, _)) -> ((), (imports, [pprinter defn])))) + mapRWS ((\(defn, (), (imports, _)) -> ((), (), (imports, [pprinter defn])))) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 9204a63..0b604a5 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -11,8 +11,7 @@ module Elm.Decoder , renderDecoder ) where -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.RWS import qualified Data.Text as T import Elm.Common import Elm.Type @@ -86,7 +85,7 @@ toElmDecoderRefWith :: ElmType a => Options -> a -> T.Text toElmDecoderRefWith options x = - pprinter . fst $ runReader (runWriterT (renderRef (toElmType x))) options + pprinter . fst $ evalRWS (renderRef (toElmType x)) options () toElmDecoderRef :: ElmType a @@ -97,7 +96,7 @@ toElmDecoderSourceWith :: ElmType a => Options -> a -> T.Text toElmDecoderSourceWith options x = - pprinter . fst $ runReader (runWriterT (render (toElmType x))) options + pprinter . fst $ evalRWS (render (toElmType x)) options () toElmDecoderSource :: ElmType a diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index ea44711..5b8d1ac 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -8,8 +8,7 @@ module Elm.Encoder , renderEncoder ) where -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.RWS import qualified Data.Text as T import Elm.Common import Elm.Type @@ -83,7 +82,7 @@ toElmEncoderRefWith :: ElmType a => Options -> a -> T.Text toElmEncoderRefWith options x = - pprinter . fst $ runReader (runWriterT (renderRef (toElmType x))) options + pprinter . fst $ evalRWS (renderRef (toElmType x)) options () toElmEncoderRef :: ElmType a @@ -94,7 +93,7 @@ toElmEncoderSourceWith :: ElmType a => Options -> a -> T.Text toElmEncoderSourceWith options x = - pprinter . fst $ runReader (runWriterT (render (toElmType x))) options + pprinter . fst $ evalRWS (render (toElmType x)) options () toElmEncoderSource :: ElmType a diff --git a/src/Elm/File.hs b/src/Elm/File.hs index 3f75233..4cadbb4 100644 --- a/src/Elm/File.hs +++ b/src/Elm/File.hs @@ -7,8 +7,7 @@ module Elm.File , moduleSpecWith ) where -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.RWS import Data.List import qualified Data.Set as S import Data.Text (Text) @@ -54,7 +53,7 @@ specsToDir specs rootDir = mapM_ processSpec specs moduleSpecWith :: Options -> [Text] -> RenderM () -> Spec moduleSpecWith options ns m = - let (imports, defns) = runReader (execWriterT m) options + let ((), (imports, defns)) = execRWS m options () in Spec { namespace = ns , declarations = diff --git a/src/Elm/Record.hs b/src/Elm/Record.hs index 1cebfcb..3af1a5b 100644 --- a/src/Elm/Record.hs +++ b/src/Elm/Record.hs @@ -8,8 +8,7 @@ module Elm.Record , renderType ) where -import Control.Monad.Reader -import Control.Monad.Writer +import Control.Monad.RWS import qualified Data.Text as T import Elm.Common import Elm.Type @@ -88,7 +87,7 @@ toElmTypeRefWith :: ElmType a => Options -> a -> T.Text toElmTypeRefWith options x = - pprinter . fst $ runReader (runWriterT (renderRef (toElmType x))) options + pprinter . fst $ evalRWS (renderRef (toElmType x)) options () toElmTypeRef :: ElmType a @@ -99,7 +98,7 @@ toElmTypeSourceWith :: ElmType a => Options -> a -> T.Text toElmTypeSourceWith options x = - pprinter . fst $ runReader (runWriterT (render (toElmType x))) options + pprinter . fst $ evalRWS (render (toElmType x)) options () toElmTypeSource :: ElmType a From b445ebfca7db0eba18be90639deb254a1174b140 Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Tue, 21 Feb 2017 23:13:02 +0000 Subject: [PATCH 06/24] Whitespace changes. --- test/ExportSpec.hs | 60 ++++++++++++++++++++++++---------------------- 1 file changed, 31 insertions(+), 29 deletions(-) diff --git a/test/ExportSpec.hs b/test/ExportSpec.hs index 7e753fa..4abeb84 100644 --- a/test/ExportSpec.hs +++ b/test/ExportSpec.hs @@ -1,46 +1,46 @@ -{-# LANGUAGE DeriveAnyClass #-} -{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} module ExportSpec where -import qualified Data.Algorithm.Diff as Diff +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 (head, lines, unlines) -import Data.Time -import Elm -import GHC.Generics -import Test.Hspec hiding (Spec) -import Test.Hspec as Hspec -import Test.HUnit (Assertion, assertBool) -import Text.Printf +import Data.Char +import Data.Int +import Data.IntMap +import Data.Map +import Data.Monoid +import Data.Proxy +import Data.Text hiding (head, lines, unlines) +import Data.Time +import Elm +import GHC.Generics +import Test.HUnit (Assertion, assertBool) +import Test.Hspec hiding (Spec) +import Test.Hspec as Hspec +import Text.Printf -- Debugging hint: -- ghci> import GHC.Generics -- ghci> :kind! Rep Post -- ... data Post = Post - { id :: Int - , name :: String - , age :: Maybe Double + { id :: Int + , name :: String + , age :: Maybe Double , comments :: [Comment] , promoted :: Maybe Comment - , author :: Maybe String + , author :: Maybe String } deriving (Generic, ElmType) data Comment = Comment - { postId :: Int - , text :: Text + { postId :: Int + , text :: Text , mainCategories :: (String, String) - , published :: Bool - , created :: UTCTime - , tags :: Map String Int + , published :: Bool + , created :: UTCTime + , tags :: Map String Int } deriving (Generic, ElmType) data Position @@ -173,7 +173,8 @@ toElmTypeSpec = it "toElmTypeRef [Comment]" $ toElmTypeRef (Proxy :: Proxy [Comment]) `shouldBe` "List (Comment)" it "toElmTypeRef (Comment, String)" $ - toElmTypeRef (Proxy :: Proxy (Comment, String)) `shouldBe` "(Comment, String)" + toElmTypeRef (Proxy :: Proxy (Comment, String)) `shouldBe` + "(Comment, String)" it "toElmTypeRef String" $ toElmTypeRef (Proxy :: Proxy String) `shouldBe` "String" it "toElmTypeRef (Maybe String)" $ @@ -374,7 +375,8 @@ moduleSpecsSpec = namespace mySpec `shouldBe` ["My", "Module"] it "inserts the correct imports" $ head (declarations mySpec) `shouldBe` - intercalate "\n" + intercalate + "\n" [ "import Date" , "import Dict" , "import Json.Decode exposing (..)" @@ -414,7 +416,7 @@ shouldBeDiff a (fpath, b) = initCap :: Text -> Text initCap t = case uncons t of - Nothing -> t + Nothing -> t Just (c, cs) -> cons (Data.Char.toUpper c) cs withPrefix :: Text -> Text -> Text From 0ba463e8792ca94778b5e6e2fd8c23d98dca794d Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Tue, 21 Feb 2017 23:11:55 +0000 Subject: [PATCH 07/24] Replacing some usages `>>` with do-blocks. It's a small change, but I find it more readable. --- src/Elm/Decoder.hs | 8 ++++---- src/Elm/Encoder.hs | 5 +++-- src/Elm/Record.hs | 4 +++- 3 files changed, 10 insertions(+), 7 deletions(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 0b604a5..2f92f59 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -106,7 +106,7 @@ toElmDecoderSource = toElmDecoderSourceWith defaultOptions renderDecoder :: ElmType a => a -> RenderM () -renderDecoder x = - require "Json.Decode exposing (..)" >> - require "Json.Decode.Pipeline exposing (..)" >> - (collectDeclaration . render . toElmType $ x) +renderDecoder x = do + require "Json.Decode exposing (..)" + require "Json.Decode.Pipeline exposing (..)" + collectDeclaration . render . toElmType $ x diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index 5b8d1ac..16de03b 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -103,5 +103,6 @@ toElmEncoderSource = toElmEncoderSourceWith defaultOptions renderEncoder :: ElmType a => a -> RenderM () -renderEncoder x = - require "Json.Encode" >> (collectDeclaration . render . toElmType $ x) +renderEncoder x = do + require "Json.Encode" + collectDeclaration . render . toElmType $ x diff --git a/src/Elm/Record.hs b/src/Elm/Record.hs index 3af1a5b..6789531 100644 --- a/src/Elm/Record.hs +++ b/src/Elm/Record.hs @@ -76,7 +76,9 @@ instance HasTypeRef ElmPrimitive where dv <- renderRef v return $ "Dict" <+> parens dk <+> parens dv renderRef EInt = pure "Int" - renderRef EDate = require "Date" >> pure "Date" + renderRef EDate = do + require "Date" + pure "Date" renderRef EBool = pure "Bool" renderRef EChar = pure "Char" renderRef EString = pure "String" From a3df6c74690c93944717cd33191060195b7482f2 Mon Sep 17 00:00:00 2001 From: Kris Jenkins Date: Tue, 21 Feb 2017 23:13:24 +0000 Subject: [PATCH 08/24] Replacing the use of Json.Decode.maybe with .nullable. This more accurately reflects our intent. With `nullable` the value must decode exactly, or be `null`. With `maybe` the value must decode exactly, you get a `Nothing` even if total junk is present. --- src/Elm/Decoder.hs | 2 +- test/ExportSpec.hs | 8 ++++---- test/PostDecoder.elm | 6 +++--- test/PostDecoderWithOptions.elm | 6 +++--- 4 files changed, 11 insertions(+), 11 deletions(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 2f92f59..8b0acf4 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -67,7 +67,7 @@ instance HasDecoderRef ElmPrimitive where return . parens $ "map Dict.fromList" <+> d renderRef (EMaybe datatype) = do dt <- renderRef datatype - return . parens $ "maybe" <+> dt + return . parens $ "nullable" <+> dt renderRef (ETuple2 x y) = do dx <- renderRef x dy <- renderRef y diff --git a/test/ExportSpec.hs b/test/ExportSpec.hs index 4abeb84..2561c0b 100644 --- a/test/ExportSpec.hs +++ b/test/ExportSpec.hs @@ -268,16 +268,16 @@ toElmDecoderSpec = toElmDecoderRef (Proxy :: Proxy String) `shouldBe` "string" it "toElmDecoderRef (Maybe String)" $ toElmDecoderRef (Proxy :: Proxy (Maybe String)) `shouldBe` - "(maybe string)" + "(nullable string)" it "toElmDecoderRef [Maybe String]" $ toElmDecoderRef (Proxy :: Proxy [Maybe String]) `shouldBe` - "(list (maybe string))" + "(list (nullable string))" it "toElmDecoderRef (Map String (Maybe String))" $ toElmDecoderRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe` - "(map Dict.fromList (list (map2 (,) (index 0 string) (index 1 (maybe string)))))" + "(map Dict.fromList (list (map2 (,) (index 0 string) (index 1 (nullable string)))))" it "toElmDecoderRef (IntMap (Maybe String))" $ toElmDecoderRef (Proxy :: Proxy (IntMap (Maybe String))) `shouldBe` - "(map Dict.fromList (list (map2 (,) (index 0 int) (index 1 (maybe string)))))" + "(map Dict.fromList (list (map2 (,) (index 0 int) (index 1 (nullable string)))))" toElmEncoderSpec :: Hspec.Spec toElmEncoderSpec = diff --git a/test/PostDecoder.elm b/test/PostDecoder.elm index 462d798..deeb35a 100644 --- a/test/PostDecoder.elm +++ b/test/PostDecoder.elm @@ -11,7 +11,7 @@ decodePost = decode Post |> required "id" int |> required "name" string - |> required "age" (maybe float) + |> required "age" (nullable float) |> required "comments" (list decodeComment) - |> required "promoted" (maybe decodeComment) - |> required "author" (maybe string) + |> required "promoted" (nullable decodeComment) + |> required "author" (nullable string) diff --git a/test/PostDecoderWithOptions.elm b/test/PostDecoderWithOptions.elm index c88acdb..9f8a8b6 100644 --- a/test/PostDecoderWithOptions.elm +++ b/test/PostDecoderWithOptions.elm @@ -11,7 +11,7 @@ decodePost = decode Post |> required "postId" int |> required "postName" string - |> required "postAge" (maybe float) + |> required "postAge" (nullable float) |> required "postComments" (list decodeComment) - |> required "postPromoted" (maybe decodeComment) - |> required "postAuthor" (maybe string) + |> required "postPromoted" (nullable decodeComment) + |> required "postAuthor" (nullable string) From a2599f142b6aff024e411b8479b13b68e83e13d4 Mon Sep 17 00:00:00 2001 From: Matt Bray Date: Sun, 5 Mar 2017 17:56:53 +0000 Subject: [PATCH 09/24] Add a contributing section to the Readme. --- README.md | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/README.md b/README.md index 5ea01f7..44c043e 100644 --- a/README.md +++ b/README.md @@ -80,6 +80,17 @@ stack build stack test --file-watch ``` +### Contributing guide + +Development happens on the `devel` branch. Pull requests target this branch. + +Generated Elm code adheres to the [`elm-format`][1] style. + +JSON encoders and decoders match the default behavior of [Aeson][2]. + +[1]: https://github.com/avh4/elm-format +[2]: https://hackage.haskell.org/package/aeson + ## Change Log ### V0.6.x From 7ca89b88393925ebd27ace8c919cec1fe0f511c0 Mon Sep 17 00:00:00 2001 From: Luke Taylor Date: Wed, 8 Mar 2017 00:41:54 +0000 Subject: [PATCH 10/24] Add HasElmComparable instance for Text --- src/Elm/Type.hs | 3 +++ 1 file changed, 3 insertions(+) diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs index dccbfb6..7c2ea19 100644 --- a/src/Elm/Type.hs +++ b/src/Elm/Type.hs @@ -188,6 +188,9 @@ class HasElmComparable a where instance HasElmComparable String where toElmComparable _ = EString +instance HasElmComparable Text where + toElmComparable _ = EString + instance ElmType Int where toElmType _ = ElmPrimitive EInt From bad9f74e211fae26f95fda86bedcacdbba2c6ae2 Mon Sep 17 00:00:00 2001 From: Falco Peijnenburg Date: Sun, 26 Feb 2017 21:12:25 +0100 Subject: [PATCH 11/24] support for algebraic sum types --- src/Elm/Common.hs | 6 ++ src/Elm/Decoder.hs | 50 ++++++++++++++ src/Elm/Encoder.hs | 102 +++++++++++++++++++++++++++++ src/Elm/Record.hs | 27 ++++++-- src/Elm/Type.hs | 10 ++- test/ExportSpec.hs | 126 ++++++++++++++++++++++++++++++++++++ test/MonstrosityDecoder.elm | 14 ++++ test/MonstrosityEncoder.elm | 21 ++++++ test/MonstrosityType.elm | 7 ++ test/PositionDecoder.elm | 14 ++++ test/PositionEncoder.elm | 12 ++++ test/TimingDecoder.elm | 14 ++++ test/TimingEncoder.elm | 21 ++++++ test/UselessDecoder.elm | 11 ++++ 14 files changed, 430 insertions(+), 5 deletions(-) create mode 100644 test/MonstrosityDecoder.elm create mode 100644 test/MonstrosityEncoder.elm create mode 100644 test/MonstrosityType.elm create mode 100644 test/PositionDecoder.elm create mode 100644 test/PositionEncoder.elm create mode 100644 test/TimingDecoder.elm create mode 100644 test/TimingEncoder.elm create mode 100644 test/UselessDecoder.elm diff --git a/src/Elm/Common.hs b/src/Elm/Common.hs index b574770..8a5a69f 100644 --- a/src/Elm/Common.hs +++ b/src/Elm/Common.hs @@ -52,3 +52,9 @@ declarations. collectDeclaration :: RenderM Doc -> RenderM () collectDeclaration = mapRWS ((\(defn, (), (imports, _)) -> ((), (), (imports, [pprinter defn])))) + +squarebracks :: Doc -> Doc +squarebracks doc = "[" <+> doc <+> "]" + +pair :: Doc -> Doc -> Doc +pair l r = spaceparens $ l <> comma <+> r diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 8b0acf4..2800aae 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -44,6 +44,56 @@ instance HasDecoder ElmConstructor where dv <- render value return $ "decode" <+> stext name <$$> indent 4 dv + render mc@(MultipleConstructors constrs) = do + cstrs <- mapM renderSum constrs + pure $ constructorName <+> "|> andThen" <+> + spaceparens ("\\x ->" <$$> indent 4 (hsep cstrs) <+> + "fail \"Constructor not matched\"") + where + constructorName :: Doc + constructorName = + if isEnumeration mc then "string" else "field \"tag\" string" + +-- | required "contents" +requiredContents :: Doc +requiredContents = "required" <+> dquotes "contents" + +-- | if x == "" then decode +-- else +renderSumCondition :: T.Text -> Doc -> RenderM Doc +renderSumCondition name contents = + pure $ "if x ==" <+> dquotes (stext name) <+> "then decode" <+> + stext name <+> contents <$$> "else" + +-- | Render a sum type constructor in context of a data type with multiple +-- constructors. +renderSum :: ElmConstructor -> RenderM Doc +renderSum (NamedConstructor name ElmEmpty) = renderSumCondition name mempty +renderSum (NamedConstructor name v@(Values _ _)) = do + (_, val) <- renderConstructorArgs 0 v + renderSumCondition name val +renderSum (NamedConstructor name value) = do + val <- render value + renderSumCondition name $ "|>" <+> requiredContents <+> val +renderSum (RecordConstructor name value) = do + val <- render value + renderSumCondition name val +renderSum (MultipleConstructors constrs) = + hsep <$> mapM renderSum constrs + +-- | Render the decoding of a constructor's arguments. Note the constructor must +-- be from a data type with multiple constructors and that it has multiple +-- constructors itself. +renderConstructorArgs :: Int -> ElmValue -> RenderM (Int, Doc) +renderConstructorArgs i (Values l r) = do + (iL, rndrL) <- renderConstructorArgs i l + (iR, rndrR) <- renderConstructorArgs (iL + 1) r + pure (iR, rndrL <+> rndrR) +renderConstructorArgs i val = do + rndrVal <- render val + let index = parens $ "index" <+> int i <+> rndrVal + pure (i, "|>" <+> requiredContents <+> index) + instance HasDecoder ElmValue where render (ElmRef name) = pure $ "decode" <> stext name render (ElmPrimitiveRef primitive) = renderRef primitive diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index 16de03b..99f9990 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -34,10 +34,80 @@ instance HasEncoderRef ElmDatatype where renderRef (ElmPrimitive primitive) = renderRef primitive instance HasEncoder ElmConstructor where + -- Single constructor, no values: empty array + render (NamedConstructor _name ElmEmpty) = + return $ "Json.Encode.list []" + + -- Single constructor, multiple values: create array with values + render (NamedConstructor name value@(Values _ _)) = do + let ps = constructorParameters 0 value + + (dv, _) <- renderVariable ps value + + let cs = stext name <+> foldl1 (<+>) ps <+> "->" + return . nest 4 $ "case x of" <$$> + (nest 4 $ cs <+> "Json.Encode.list" <$$> "[" <+> dv <$$> "]") + + -- Single constructor, one value: skip constructor and render just the value + render (NamedConstructor _name val) = + render val + + render (RecordConstructor _ value) = do dv <- render value return . nest 4 $ "Json.Encode.object" <$$> "[" <+> dv <$$> "]" + render mc@(MultipleConstructors constrs) = do + let rndr = if isEnumeration mc then renderEnumeration else renderSum + dc <- mapM rndr constrs + return . nest 4 $ "case x of" <$$> foldl1 (<$$>) dc + +renderSum :: ElmConstructor -> RenderM Doc +renderSum c@(NamedConstructor name ElmEmpty) = do + dc <- render c + let cs = stext name <+> "->" + let tag = pair (dquotes "tag") ("Json.Encode.string" <+> dquotes (stext name)) + let ct = comma <+> pair (dquotes "contents") dc + return . nest 4 $ cs <+> "Json.Encode.object" <$$> "[" <+> tag <$$> + ct <$$> + "]" + +renderSum (NamedConstructor name value) = do + let ps = constructorParameters 0 value + + (dc, _) <- renderVariable ps value + let dc' = if length ps > 1 then "Json.Encode.list" <+> squarebracks dc else dc + let cs = stext name <+> foldl1 (<+>) ps <+> "->" + let tag = pair (dquotes "tag") ("Json.Encode.string" <+> dquotes (stext name)) + let ct = comma <+> pair (dquotes "contents") dc' + return . nest 4 $ cs <+> "Json.Encode.object" <$$> "[" <+> tag <$$> + ct <$$> + "]" + +renderSum (RecordConstructor name value) = do + dv <- render value + let cs = stext name <+> "->" + let tag = pair (dquotes "tag") (dquotes $ stext name) + let ct = comma <+> dv + return . nest 4 $ cs <+> "Json.Encode.object" <$$> "[" <+> tag <$$> + ct <$$> + "]" + +renderSum (MultipleConstructors constrs) = do + dc <- mapM renderSum constrs + return $ foldl1 (<$$>) dc + + +renderEnumeration :: ElmConstructor -> RenderM Doc +renderEnumeration (NamedConstructor name _) = + return $ stext name <+> "->" <+> + "Json.Encode.string" <+> dquotes (stext name) +renderEnumeration (MultipleConstructors constrs) = do + dc <- mapM renderEnumeration constrs + return $ foldl1 (<$$>) dc +renderEnumeration c = render c + + instance HasEncoder ElmValue where render (ElmField name value) = do fieldModifier <- asks fieldLabelModifier @@ -106,3 +176,35 @@ renderEncoder renderEncoder x = do require "Json.Encode" collectDeclaration . render . toElmType $ x + +-- | Variable names for the members of constructors +-- Used in pattern matches +constructorParameters :: Int -> ElmValue -> [Doc] +constructorParameters _ ElmEmpty = [ empty ] +constructorParameters i (Values l r) = + left ++ right + where + left = constructorParameters i l + right = constructorParameters (length left + i) r +constructorParameters i _ = [ "y" <> int i ] + + +-- | Encode variables following the recipe of an ElmValue +renderVariable :: [Doc] -> ElmValue -> RenderM (Doc, [Doc]) +renderVariable (d : ds) v@(ElmRef {}) = do + v' <- render v + return (v' <+> d, ds) +renderVariable ds ElmEmpty = return (empty, ds) +renderVariable (_ : ds) (ElmPrimitiveRef EUnit) = + return ("Json.Encode.null", ds) +renderVariable (d : ds) (ElmPrimitiveRef ref) = do + r <- renderRef ref + return (r <+> d, ds) +renderVariable ds (Values l r) = do + (left, dsl) <- renderVariable ds l + (right, dsr) <- renderVariable dsl r + return (left <> comma <+> right, dsr) +renderVariable ds f@(ElmField _ _) = do + f' <- render f + return (f', ds) +renderVariable [] _ = error "Amount of variables does not match variables" diff --git a/src/Elm/Record.hs b/src/Elm/Record.hs index 6789531..eb92a42 100644 --- a/src/Elm/Record.hs +++ b/src/Elm/Record.hs @@ -17,6 +17,9 @@ import Text.PrettyPrint.Leijen.Text hiding ((<$>), (<>)) class HasType a where render :: a -> RenderM Doc +class HasRecordType a where + renderRecord :: a -> RenderM Doc + class HasTypeRef a where renderRef :: a -> RenderM Doc @@ -37,7 +40,7 @@ instance HasTypeRef ElmDatatype where instance HasType ElmConstructor where render (RecordConstructor _ value) = do - dv <- render value + dv <- renderRecord value return $ "{" <+> dv <$$> "}" render (NamedConstructor constructorName value) = do dv <- render value @@ -47,17 +50,25 @@ instance HasType ElmConstructor where instance HasType ElmValue where render (ElmRef name) = pure (stext name) - render (ElmPrimitiveRef primitive) = renderRef primitive + render (ElmPrimitiveRef primitive) = elmRefParens primitive <$> renderRef primitive render ElmEmpty = pure (text "") render (Values x y) = do dx <- render x dy <- render y - return $ dx <$$> comma <+> dy + return $ dx <+> dy render (ElmField name value) = do fieldModifier <- asks fieldLabelModifier - dv <- render value + dv <- renderRecord value return $ stext (fieldModifier name) <+> ":" <+> dv +instance HasRecordType ElmValue where + renderRecord (ElmPrimitiveRef primitive) = renderRef primitive + renderRecord (Values x y) = do + dx <- renderRecord x + dy <- renderRecord y + return $ dx <$$> comma <+> dy + renderRecord value = render value + instance HasTypeRef ElmPrimitive where renderRef (EList (ElmPrimitive EChar)) = renderRef EString renderRef (EList datatype) = do @@ -85,6 +96,14 @@ instance HasTypeRef ElmPrimitive where renderRef EUnit = pure "()" renderRef EFloat = pure "Float" +-- | Puts parentheses around the doc of an elm ref if it contains spaces. +elmRefParens :: ElmPrimitive -> Doc -> Doc +elmRefParens (EList (ElmPrimitive EChar)) = id +elmRefParens (EList _) = parens +elmRefParens (EMaybe _) = parens +elmRefParens (EDict _ _) = parens +elmRefParens _ = id + toElmTypeRefWith :: ElmType a => Options -> a -> T.Text diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs index 7c2ea19..3141df2 100644 --- a/src/Elm/Type.hs +++ b/src/Elm/Type.hs @@ -12,7 +12,7 @@ import Data.Int (Int16, Int32, Int64, Int8) import Data.IntMap import Data.Map import Data.Proxy -import Data.Text +import Data.Text hiding (all) import Data.Time import GHC.Generics import Prelude @@ -199,3 +199,11 @@ instance ElmType Char where instance ElmType Bool where toElmType _ = ElmPrimitive EBool + +-- | Whether a set of constructors is an enumeration, i.e. whether they lack +-- values. data A = A | B | C would be simple data A = A Int | B | C would not +-- be simple. +isEnumeration :: ElmConstructor -> Bool +isEnumeration (NamedConstructor _ ElmEmpty) = True +isEnumeration (MultipleConstructors cs) = all isEnumeration cs +isEnumeration _ = False diff --git a/test/ExportSpec.hs b/test/ExportSpec.hs index 2561c0b..dd4b2bc 100644 --- a/test/ExportSpec.hs +++ b/test/ExportSpec.hs @@ -55,6 +55,12 @@ data Timing | Stop deriving (Generic, ElmType) +data Monstrosity + = NotSpecial + | OkayIGuess Monstrosity + | Ridiculous Int String [Monstrosity] + deriving (Generic, ElmType) + newtype Useless = Useless () deriving (Generic, ElmType) @@ -120,6 +126,12 @@ toElmTypeSpec = defaultOptions (Proxy :: Proxy Timing) "test/TimingType.elm" + it "toElmTypeSource Monstrosity" $ + shouldMatchTypeSource + (unlines ["module MonstrosityType exposing (..)", "", "", "%s"]) + defaultOptions + (Proxy :: Proxy Monstrosity) + "test/MonstrosityType.elm" it "toElmTypeSource Useless" $ shouldMatchTypeSource (unlines ["module UselessType exposing (..)", "", "", "%s"]) @@ -241,6 +253,51 @@ toElmDecoderSpec = (defaultOptions {fieldLabelModifier = withPrefix "post"}) (Proxy :: Proxy Post) "test/PostDecoderWithOptions.elm" + it "toElmDecoderSource Position" $ + shouldMatchDecoderSource + (unlines + [ "module PositionDecoder exposing (..)" + , "" + , "import Json.Decode exposing (..)" + , "import Json.Decode.Pipeline exposing (..)" + , "import PositionType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Position) + "test/PositionDecoder.elm" + it "toElmDecoderSource Timing" $ + shouldMatchDecoderSource + (unlines + [ "module TimingDecoder exposing (..)" + , "" + , "import Json.Decode exposing (..)" + , "import Json.Decode.Pipeline exposing (..)" + , "import TimingType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Timing) + "test/TimingDecoder.elm" + it "toElmDecoderSource Monstrosity" $ + shouldMatchDecoderSource + (unlines + [ "module MonstrosityDecoder exposing (..)" + , "" + , "import Json.Decode exposing (..)" + , "import Json.Decode.Pipeline exposing (..)" + , "import MonstrosityType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Monstrosity) + "test/MonstrosityDecoder.elm" it "toElmDecoderSourceWithOptions Comment" $ shouldMatchDecoderSource (unlines @@ -258,9 +315,30 @@ toElmDecoderSpec = (defaultOptions {fieldLabelModifier = withPrefix "comment"}) (Proxy :: Proxy Comment) "test/CommentDecoderWithOptions.elm" + it "toElmDecoderSource Useless" $ + shouldMatchDecoderSource + (unlines + [ "module UselessDecoder exposing (..)" + , "" + , "import Json.Decode exposing (..)" + , "import Json.Decode.Pipeline exposing (..)" + , "import UselessType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Useless) + "test/UselessDecoder.elm" describe "Convert to Elm decoder references." $ do it "toElmDecoderRef Post" $ toElmDecoderRef (Proxy :: Proxy Post) `shouldBe` "decodePost" + it "toElmDecoderRef Position" $ + toElmDecoderRef (Proxy :: Proxy Position) `shouldBe` "decodePosition" + it "toElmDecoderRef Timing" $ + toElmDecoderRef (Proxy :: Proxy Timing) `shouldBe` "decodeTiming" + it "toElmDecoderRef Monstrosity" $ + toElmDecoderRef (Proxy :: Proxy Monstrosity) `shouldBe` "decodeMonstrosity" it "toElmDecoderRef [Comment]" $ toElmDecoderRef (Proxy :: Proxy [Comment]) `shouldBe` "(list decodeComment)" @@ -342,12 +420,60 @@ toElmEncoderSpec = (defaultOptions {fieldLabelModifier = withPrefix "post"}) (Proxy :: Proxy Post) "test/PostEncoderWithOptions.elm" + it "toElmEncoderSource Position" $ + shouldMatchEncoderSource + (unlines + [ "module PositionEncoder exposing (..)" + , "" + , "import Json.Encode" + , "import PositionType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Position) + "test/PositionEncoder.elm" + it "toElmEncoderSourceWithOptions Timing" $ + shouldMatchEncoderSource + (unlines + [ "module TimingEncoder exposing (..)" + , "" + , "import Json.Encode" + , "import TimingType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Timing) + "test/TimingEncoder.elm" + it "toElmEncoderSourceWithOptions Monstrosity" $ + shouldMatchEncoderSource + (unlines + [ "module MonstrosityEncoder exposing (..)" + , "" + , "import Json.Encode" + , "import MonstrosityType exposing (..)" + , "" + , "" + , "%s" + ]) + defaultOptions + (Proxy :: Proxy Monstrosity) + "test/MonstrosityEncoder.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 Position" $ + toElmEncoderRef (Proxy :: Proxy Position) `shouldBe` "encodePosition" + it "toElmEncoderRef Timing" $ + toElmEncoderRef (Proxy :: Proxy Timing) `shouldBe` "encodeTiming" + it "toElmEncoderRef Monstrosity" $ + toElmEncoderRef (Proxy :: Proxy Monstrosity) `shouldBe` "encodeMonstrosity" it "toElmEncoderRef String" $ toElmEncoderRef (Proxy :: Proxy String) `shouldBe` "Json.Encode.string" it "toElmEncoderRef (Maybe String)" $ diff --git a/test/MonstrosityDecoder.elm b/test/MonstrosityDecoder.elm new file mode 100644 index 0000000..0ae9051 --- /dev/null +++ b/test/MonstrosityDecoder.elm @@ -0,0 +1,14 @@ +module MonstrosityDecoder exposing (..) + +import Json.Decode exposing (..) +import Json.Decode.Pipeline exposing (..) +import MonstrosityType exposing (..) + + +decodeMonstrosity : Decoder Monstrosity +decodeMonstrosity = + field "tag" string |> andThen ( \x -> + if x == "NotSpecial" then decode NotSpecial + else if x == "OkayIGuess" then decode OkayIGuess |> required "contents" decodeMonstrosity + else if x == "Ridiculous" then decode Ridiculous |> required "contents" (index 0 int) |> required "contents" (index 1 string) |> required "contents" (index 2 (list decodeMonstrosity)) + else fail "Constructor not matched" ) diff --git a/test/MonstrosityEncoder.elm b/test/MonstrosityEncoder.elm new file mode 100644 index 0000000..76ad390 --- /dev/null +++ b/test/MonstrosityEncoder.elm @@ -0,0 +1,21 @@ +module MonstrosityEncoder exposing (..) + +import Json.Encode +import MonstrosityType exposing (..) + + +encodeMonstrosity : Monstrosity -> Json.Encode.Value +encodeMonstrosity x = + case x of + NotSpecial -> Json.Encode.object + [ ( "tag", Json.Encode.string "NotSpecial" ) + , ( "contents", Json.Encode.list [] ) + ] + OkayIGuess y0 -> Json.Encode.object + [ ( "tag", Json.Encode.string "OkayIGuess" ) + , ( "contents", encodeMonstrosity y0 ) + ] + Ridiculous y0 y1 y2 -> Json.Encode.object + [ ( "tag", Json.Encode.string "Ridiculous" ) + , ( "contents", Json.Encode.list [ Json.Encode.int y0, Json.Encode.string y1, (Json.Encode.list << List.map encodeMonstrosity) y2 ] ) + ] diff --git a/test/MonstrosityType.elm b/test/MonstrosityType.elm new file mode 100644 index 0000000..5a25b98 --- /dev/null +++ b/test/MonstrosityType.elm @@ -0,0 +1,7 @@ +module MonstrosityType exposing (..) + + +type Monstrosity + = NotSpecial + | OkayIGuess Monstrosity + | Ridiculous Int String (List (Monstrosity)) diff --git a/test/PositionDecoder.elm b/test/PositionDecoder.elm new file mode 100644 index 0000000..a4793ed --- /dev/null +++ b/test/PositionDecoder.elm @@ -0,0 +1,14 @@ +module PositionDecoder exposing (..) + +import Json.Decode exposing (..) +import Json.Decode.Pipeline exposing (..) +import PositionType exposing (..) + + +decodePosition : Decoder Position +decodePosition = + string |> andThen ( \x -> + if x == "Beginning" then decode Beginning + else if x == "Middle" then decode Middle + else if x == "End" then decode End + else fail "Constructor not matched" ) diff --git a/test/PositionEncoder.elm b/test/PositionEncoder.elm new file mode 100644 index 0000000..2d0c499 --- /dev/null +++ b/test/PositionEncoder.elm @@ -0,0 +1,12 @@ +module PositionEncoder exposing (..) + +import Json.Encode +import PositionType exposing (..) + + +encodePosition : Position -> Json.Encode.Value +encodePosition x = + case x of + Beginning -> Json.Encode.string "Beginning" + Middle -> Json.Encode.string "Middle" + End -> Json.Encode.string "End" diff --git a/test/TimingDecoder.elm b/test/TimingDecoder.elm new file mode 100644 index 0000000..ab4c49c --- /dev/null +++ b/test/TimingDecoder.elm @@ -0,0 +1,14 @@ +module TimingDecoder exposing (..) + +import Json.Decode exposing (..) +import Json.Decode.Pipeline exposing (..) +import TimingType exposing (..) + + +decodeTiming : Decoder Timing +decodeTiming = + field "tag" string |> andThen ( \x -> + if x == "Start" then decode Start + else if x == "Continue" then decode Continue |> required "contents" float + else if x == "Stop" then decode Stop + else fail "Constructor not matched" ) diff --git a/test/TimingEncoder.elm b/test/TimingEncoder.elm new file mode 100644 index 0000000..934a55f --- /dev/null +++ b/test/TimingEncoder.elm @@ -0,0 +1,21 @@ +module TimingEncoder exposing (..) + +import Json.Encode +import TimingType exposing (..) + + +encodeTiming : Timing -> Json.Encode.Value +encodeTiming x = + case x of + Start -> Json.Encode.object + [ ( "tag", Json.Encode.string "Start" ) + , ( "contents", Json.Encode.list [] ) + ] + Continue y0 -> Json.Encode.object + [ ( "tag", Json.Encode.string "Continue" ) + , ( "contents", Json.Encode.float y0 ) + ] + Stop -> Json.Encode.object + [ ( "tag", Json.Encode.string "Stop" ) + , ( "contents", Json.Encode.list [] ) + ] diff --git a/test/UselessDecoder.elm b/test/UselessDecoder.elm new file mode 100644 index 0000000..965f323 --- /dev/null +++ b/test/UselessDecoder.elm @@ -0,0 +1,11 @@ +module UselessDecoder exposing (..) + +import Json.Decode exposing (..) +import Json.Decode.Pipeline exposing (..) +import UselessType exposing (..) + + +decodeUseless : Decoder Useless +decodeUseless = + decode Useless + (succeed ()) From 5e4971ba6a90abd8d040dbaa77e1c892357a452b Mon Sep 17 00:00:00 2001 From: Falco Peijnenburg Date: Sat, 11 Mar 2017 11:20:45 +0100 Subject: [PATCH 12/24] Algebraic sum encoders and decoders follow elm-format --- src/Elm/Common.hs | 12 ++++++++++++ src/Elm/Decoder.hs | 25 ++++++++++++++++--------- src/Elm/Encoder.hs | 33 ++++++++++++++++++--------------- test/MonstrosityDecoder.elm | 25 ++++++++++++++++++++----- test/MonstrosityEncoder.elm | 29 +++++++++++++++++------------ test/PositionDecoder.elm | 21 ++++++++++++++++----- test/PositionEncoder.elm | 11 ++++++++--- test/TimingDecoder.elm | 22 +++++++++++++++++----- test/TimingEncoder.elm | 29 +++++++++++++++++------------ 9 files changed, 141 insertions(+), 66 deletions(-) diff --git a/src/Elm/Common.hs b/src/Elm/Common.hs index 8a5a69f..e8ea2e3 100644 --- a/src/Elm/Common.hs +++ b/src/Elm/Common.hs @@ -36,6 +36,18 @@ stext = text . LT.fromStrict spaceparens :: Doc -> Doc spaceparens doc = "(" <+> doc <+> ")" +-- | Parentheses of which the right parenthesis exists on a new line +newlineparens :: Doc -> Doc +newlineparens doc = "(" <> doc <$$> ")" + +-- | An empty line, regardless of current indentation +emptyline :: Doc +emptyline = nest minBound linebreak + +-- | Like <$$>, but with an empty line in between +(<$+$>) :: Doc -> Doc -> Doc +l <$+$> r = l <> emptyline <$$> r + -- type RenderM = RWS Options (Set Text -- The set of required imports , [Text] -- Generated declarations diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 2800aae..a1eff34 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -46,9 +46,16 @@ instance HasDecoder ElmConstructor where render mc@(MultipleConstructors constrs) = do cstrs <- mapM renderSum constrs - pure $ constructorName <+> "|> andThen" <+> - spaceparens ("\\x ->" <$$> indent 4 (hsep cstrs) <+> - "fail \"Constructor not matched\"") + pure $ constructorName <$$> indent 4 + ("|> andThen" <$$> + indent 4 (newlineparens ("\\x ->" <$$> + (indent 4 $ "case x of" <$$> + (indent 4 $ foldl1 (<$+$>) cstrs <$+$> + "_ ->" <$$> indent 4 "fail \"Constructor not matched\"" + ) + ) + )) + ) where constructorName :: Doc constructorName = @@ -58,12 +65,12 @@ instance HasDecoder ElmConstructor where requiredContents :: Doc requiredContents = "required" <+> dquotes "contents" --- | if x == "" then decode --- else +-- | "" -> decode renderSumCondition :: T.Text -> Doc -> RenderM Doc renderSumCondition name contents = - pure $ "if x ==" <+> dquotes (stext name) <+> "then decode" <+> - stext name <+> contents <$$> "else" + pure $ dquotes (stext name) <+> "->" <$$> + indent 4 + ("decode" <+> stext name <$$> indent 4 contents) -- | Render a sum type constructor in context of a data type with multiple -- constructors. @@ -79,7 +86,7 @@ renderSum (RecordConstructor name value) = do val <- render value renderSumCondition name val renderSum (MultipleConstructors constrs) = - hsep <$> mapM renderSum constrs + foldl1 (<$+$>) <$> mapM renderSum constrs -- | Render the decoding of a constructor's arguments. Note the constructor must -- be from a data type with multiple constructors and that it has multiple @@ -88,7 +95,7 @@ renderConstructorArgs :: Int -> ElmValue -> RenderM (Int, Doc) renderConstructorArgs i (Values l r) = do (iL, rndrL) <- renderConstructorArgs i l (iR, rndrR) <- renderConstructorArgs (iL + 1) r - pure (iR, rndrL <+> rndrR) + pure (iR, rndrL <$$> rndrR) renderConstructorArgs i val = do rndrVal <- render val let index = parens $ "index" <+> int i <+> rndrVal diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index 99f9990..e035843 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -46,7 +46,7 @@ instance HasEncoder ElmConstructor where let cs = stext name <+> foldl1 (<+>) ps <+> "->" return . nest 4 $ "case x of" <$$> - (nest 4 $ cs <+> "Json.Encode.list" <$$> "[" <+> dv <$$> "]") + (nest 4 $ cs <$$> nest 4 ("Json.Encode.list" <$$> "[" <+> dv <$$> "]")) -- Single constructor, one value: skip constructor and render just the value render (NamedConstructor _name val) = @@ -60,7 +60,14 @@ instance HasEncoder ElmConstructor where render mc@(MultipleConstructors constrs) = do let rndr = if isEnumeration mc then renderEnumeration else renderSum dc <- mapM rndr constrs - return . nest 4 $ "case x of" <$$> foldl1 (<$$>) dc + return . nest 4 $ "case x of" <$$> foldl1 (<$+$>) dc + +jsonEncodeObject :: Doc -> Doc -> Doc -> Doc +jsonEncodeObject constructor tag contents = + nest 4 $ constructor <$$> + nest 4 ("Json.Encode.object" <$$> "[" <+> tag <$$> + contents <$$> + "]") renderSum :: ElmConstructor -> RenderM Doc renderSum c@(NamedConstructor name ElmEmpty) = do @@ -68,9 +75,8 @@ renderSum c@(NamedConstructor name ElmEmpty) = do let cs = stext name <+> "->" let tag = pair (dquotes "tag") ("Json.Encode.string" <+> dquotes (stext name)) let ct = comma <+> pair (dquotes "contents") dc - return . nest 4 $ cs <+> "Json.Encode.object" <$$> "[" <+> tag <$$> - ct <$$> - "]" + + return $ jsonEncodeObject cs tag ct renderSum (NamedConstructor name value) = do let ps = constructorParameters 0 value @@ -80,31 +86,28 @@ renderSum (NamedConstructor name value) = do let cs = stext name <+> foldl1 (<+>) ps <+> "->" let tag = pair (dquotes "tag") ("Json.Encode.string" <+> dquotes (stext name)) let ct = comma <+> pair (dquotes "contents") dc' - return . nest 4 $ cs <+> "Json.Encode.object" <$$> "[" <+> tag <$$> - ct <$$> - "]" + + return $ jsonEncodeObject cs tag ct renderSum (RecordConstructor name value) = do dv <- render value let cs = stext name <+> "->" let tag = pair (dquotes "tag") (dquotes $ stext name) let ct = comma <+> dv - return . nest 4 $ cs <+> "Json.Encode.object" <$$> "[" <+> tag <$$> - ct <$$> - "]" + return $ jsonEncodeObject cs tag ct renderSum (MultipleConstructors constrs) = do dc <- mapM renderSum constrs - return $ foldl1 (<$$>) dc + return $ foldl1 (<$+$>) dc renderEnumeration :: ElmConstructor -> RenderM Doc renderEnumeration (NamedConstructor name _) = - return $ stext name <+> "->" <+> - "Json.Encode.string" <+> dquotes (stext name) + return . nest 4 $ stext name <+> "->" <$$> + "Json.Encode.string" <+> dquotes (stext name) renderEnumeration (MultipleConstructors constrs) = do dc <- mapM renderEnumeration constrs - return $ foldl1 (<$$>) dc + return $ foldl1 (<$+$>) dc renderEnumeration c = render c diff --git a/test/MonstrosityDecoder.elm b/test/MonstrosityDecoder.elm index 0ae9051..8139eaa 100644 --- a/test/MonstrosityDecoder.elm +++ b/test/MonstrosityDecoder.elm @@ -7,8 +7,23 @@ import MonstrosityType exposing (..) decodeMonstrosity : Decoder Monstrosity decodeMonstrosity = - field "tag" string |> andThen ( \x -> - if x == "NotSpecial" then decode NotSpecial - else if x == "OkayIGuess" then decode OkayIGuess |> required "contents" decodeMonstrosity - else if x == "Ridiculous" then decode Ridiculous |> required "contents" (index 0 int) |> required "contents" (index 1 string) |> required "contents" (index 2 (list decodeMonstrosity)) - else fail "Constructor not matched" ) + field "tag" string + |> andThen + (\x -> + case x of + "NotSpecial" -> + decode NotSpecial + + "OkayIGuess" -> + decode OkayIGuess + |> required "contents" decodeMonstrosity + + "Ridiculous" -> + decode Ridiculous + |> required "contents" (index 0 int) + |> required "contents" (index 1 string) + |> required "contents" (index 2 (list decodeMonstrosity)) + + _ -> + fail "Constructor not matched" + ) diff --git a/test/MonstrosityEncoder.elm b/test/MonstrosityEncoder.elm index 76ad390..addb424 100644 --- a/test/MonstrosityEncoder.elm +++ b/test/MonstrosityEncoder.elm @@ -7,15 +7,20 @@ import MonstrosityType exposing (..) encodeMonstrosity : Monstrosity -> Json.Encode.Value encodeMonstrosity x = case x of - NotSpecial -> Json.Encode.object - [ ( "tag", Json.Encode.string "NotSpecial" ) - , ( "contents", Json.Encode.list [] ) - ] - OkayIGuess y0 -> Json.Encode.object - [ ( "tag", Json.Encode.string "OkayIGuess" ) - , ( "contents", encodeMonstrosity y0 ) - ] - Ridiculous y0 y1 y2 -> Json.Encode.object - [ ( "tag", Json.Encode.string "Ridiculous" ) - , ( "contents", Json.Encode.list [ Json.Encode.int y0, Json.Encode.string y1, (Json.Encode.list << List.map encodeMonstrosity) y2 ] ) - ] + NotSpecial -> + Json.Encode.object + [ ( "tag", Json.Encode.string "NotSpecial" ) + , ( "contents", Json.Encode.list [] ) + ] + + OkayIGuess y0 -> + Json.Encode.object + [ ( "tag", Json.Encode.string "OkayIGuess" ) + , ( "contents", encodeMonstrosity y0 ) + ] + + Ridiculous y0 y1 y2 -> + Json.Encode.object + [ ( "tag", Json.Encode.string "Ridiculous" ) + , ( "contents", Json.Encode.list [ Json.Encode.int y0, Json.Encode.string y1, (Json.Encode.list << List.map encodeMonstrosity) y2 ] ) + ] diff --git a/test/PositionDecoder.elm b/test/PositionDecoder.elm index a4793ed..651da91 100644 --- a/test/PositionDecoder.elm +++ b/test/PositionDecoder.elm @@ -7,8 +7,19 @@ import PositionType exposing (..) decodePosition : Decoder Position decodePosition = - string |> andThen ( \x -> - if x == "Beginning" then decode Beginning - else if x == "Middle" then decode Middle - else if x == "End" then decode End - else fail "Constructor not matched" ) + string + |> andThen + (\x -> + case x of + "Beginning" -> + decode Beginning + + "Middle" -> + decode Middle + + "End" -> + decode End + + _ -> + fail "Constructor not matched" + ) diff --git a/test/PositionEncoder.elm b/test/PositionEncoder.elm index 2d0c499..dbca6df 100644 --- a/test/PositionEncoder.elm +++ b/test/PositionEncoder.elm @@ -7,6 +7,11 @@ import PositionType exposing (..) encodePosition : Position -> Json.Encode.Value encodePosition x = case x of - Beginning -> Json.Encode.string "Beginning" - Middle -> Json.Encode.string "Middle" - End -> Json.Encode.string "End" + Beginning -> + Json.Encode.string "Beginning" + + Middle -> + Json.Encode.string "Middle" + + End -> + Json.Encode.string "End" diff --git a/test/TimingDecoder.elm b/test/TimingDecoder.elm index ab4c49c..bef3b72 100644 --- a/test/TimingDecoder.elm +++ b/test/TimingDecoder.elm @@ -7,8 +7,20 @@ import TimingType exposing (..) decodeTiming : Decoder Timing decodeTiming = - field "tag" string |> andThen ( \x -> - if x == "Start" then decode Start - else if x == "Continue" then decode Continue |> required "contents" float - else if x == "Stop" then decode Stop - else fail "Constructor not matched" ) + field "tag" string + |> andThen + (\x -> + case x of + "Start" -> + decode Start + + "Continue" -> + decode Continue + |> required "contents" float + + "Stop" -> + decode Stop + + _ -> + fail "Constructor not matched" + ) diff --git a/test/TimingEncoder.elm b/test/TimingEncoder.elm index 934a55f..d6a1afe 100644 --- a/test/TimingEncoder.elm +++ b/test/TimingEncoder.elm @@ -7,15 +7,20 @@ import TimingType exposing (..) encodeTiming : Timing -> Json.Encode.Value encodeTiming x = case x of - Start -> Json.Encode.object - [ ( "tag", Json.Encode.string "Start" ) - , ( "contents", Json.Encode.list [] ) - ] - Continue y0 -> Json.Encode.object - [ ( "tag", Json.Encode.string "Continue" ) - , ( "contents", Json.Encode.float y0 ) - ] - Stop -> Json.Encode.object - [ ( "tag", Json.Encode.string "Stop" ) - , ( "contents", Json.Encode.list [] ) - ] + Start -> + Json.Encode.object + [ ( "tag", Json.Encode.string "Start" ) + , ( "contents", Json.Encode.list [] ) + ] + + Continue y0 -> + Json.Encode.object + [ ( "tag", Json.Encode.string "Continue" ) + , ( "contents", Json.Encode.float y0 ) + ] + + Stop -> + Json.Encode.object + [ ( "tag", Json.Encode.string "Stop" ) + , ( "contents", Json.Encode.list [] ) + ] From ed8e4e7312042211c8aa62905a6cd649d005ea28 Mon Sep 17 00:00:00 2001 From: Dimitri Sabadie Date: Tue, 20 Jun 2017 15:12:29 +0200 Subject: [PATCH 13/24] Fixed compilation warnings. --- src/Elm/Decoder.hs | 1 + src/Elm/Encoder.hs | 1 + 2 files changed, 2 insertions(+) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index a1eff34..0fc3b3a 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -112,6 +112,7 @@ instance HasDecoder ElmValue where fieldModifier <- asks fieldLabelModifier dv <- render value return $ "|> required" <+> dquotes (stext (fieldModifier name)) <+> dv + render _ = error "instance HasDecoder ElmValue: should not happen" instance HasDecoderRef ElmPrimitive where renderRef (EList (ElmPrimitive EChar)) = pure "string" diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index e035843..2b3ceac 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -124,6 +124,7 @@ instance HasEncoder ElmValue where dx <- render x dy <- render y return $ dx <$$> comma <+> dy + render _ = error "HasEncoderRef ElmValue: should not happen" instance HasEncoderRef ElmPrimitive where renderRef EDate = pure $ parens "Json.Encode.string << toString" From 7971532914a8503c6382e92a52dd70d95e6704be Mon Sep 17 00:00:00 2001 From: Dimitri Sabadie Date: Fri, 25 Aug 2017 14:37:46 +0200 Subject: [PATCH 14/24] Add more information on an error if it happens. --- src/Elm/Decoder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 0fc3b3a..afe31ee 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -112,7 +112,7 @@ instance HasDecoder ElmValue where fieldModifier <- asks fieldLabelModifier dv <- render value return $ "|> required" <+> dquotes (stext (fieldModifier name)) <+> dv - render _ = error "instance HasDecoder ElmValue: should not happen" + render v = error $ "instance HasDecoder ElmValue: should not happen (" ++ show v ++ ")" instance HasDecoderRef ElmPrimitive where renderRef (EList (ElmPrimitive EChar)) = pure "string" From f7ffcc2de542d2eee4c1f81dc325848f2db09e07 Mon Sep 17 00:00:00 2001 From: Dimitri Sabadie Date: Fri, 25 Aug 2017 15:13:57 +0200 Subject: [PATCH 15/24] Complete fix for HasDecoder ElmValue. --- src/Elm/Decoder.hs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index afe31ee..01ac785 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -112,7 +112,7 @@ instance HasDecoder ElmValue where fieldModifier <- asks fieldLabelModifier dv <- render value return $ "|> required" <+> dquotes (stext (fieldModifier name)) <+> dv - render v = error $ "instance HasDecoder ElmValue: should not happen (" ++ show v ++ ")" + render ElmEmpty = pure (stext "") instance HasDecoderRef ElmPrimitive where renderRef (EList (ElmPrimitive EChar)) = pure "string" From 3854ed57c87df96c6eda094328ec5b252f7ae42f Mon Sep 17 00:00:00 2001 From: Dimitri Sabadie Date: Fri, 2 Mar 2018 17:59:27 +0100 Subject: [PATCH 16/24] Add support for Natural. --- src/Elm/Type.hs | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs index 3141df2..6ed0dd9 100644 --- a/src/Elm/Type.hs +++ b/src/Elm/Type.hs @@ -15,6 +15,7 @@ import Data.Proxy import Data.Text hiding (all) import Data.Time import GHC.Generics +import Numeric.Natural (Natural) import Prelude data ElmDatatype @@ -162,6 +163,9 @@ instance ElmType Int32 where instance ElmType Int64 where toElmType _ = ElmPrimitive EInt +instance ElmType Natural where + toElmType _ = ElmPrimitive EInt + instance (ElmType a, ElmType b) => ElmType (a, b) where toElmType _ = From c4dabff7b3926d1d2d0100ea3bf3e0eb416e741f Mon Sep 17 00:00:00 2001 From: Dimitri Sabadie Date: Fri, 9 Mar 2018 11:13:09 +0100 Subject: [PATCH 17/24] Add support for non-empty lists (ElmType). --- elm-export.cabal | 1 + src/Elm/Type.hs | 5 +++++ 2 files changed, 6 insertions(+) diff --git a/elm-export.cabal b/elm-export.cabal index f6b6ab3..7e4968c 100644 --- a/elm-export.cabal +++ b/elm-export.cabal @@ -23,6 +23,7 @@ library , directory , formatting , mtl + , semigroups , text , time , wl-pprint-text diff --git a/src/Elm/Type.hs b/src/Elm/Type.hs index 6ed0dd9..46c6ef4 100644 --- a/src/Elm/Type.hs +++ b/src/Elm/Type.hs @@ -10,6 +10,7 @@ module Elm.Type where import Data.Int (Int16, Int32, Int64, Int8) import Data.IntMap +import Data.List.NonEmpty (NonEmpty) import Data.Map import Data.Proxy import Data.Text hiding (all) @@ -129,6 +130,10 @@ instance ElmType a => ElmType [a] where toElmType _ = ElmPrimitive (EList (toElmType (Proxy :: Proxy a))) +instance ElmType a => + ElmType (NonEmpty a) where + toElmType _ = toElmType (Proxy :: Proxy [a]) + instance ElmType a => ElmType (Maybe a) where toElmType _ = ElmPrimitive (EMaybe (toElmType (Proxy :: Proxy a))) From be3f5664eaa80b2724068c5956ccc3be4cb7b5ec Mon Sep 17 00:00:00 2001 From: Dimitri Sabadie Date: Sat, 24 Mar 2018 03:23:39 +0100 Subject: [PATCH 18/24] Fix the Date encoder. --- README.md | 1 + src/Elm/Encoder.hs | 2 +- 2 files changed, 2 insertions(+), 1 deletion(-) diff --git a/README.md b/README.md index 44c043e..3a6a6e9 100644 --- a/README.md +++ b/README.md @@ -62,6 +62,7 @@ The decoders we produce require these extra Elm packages installed: ``` sh elm package install NoRedInk/elm-decode-pipeline elm package install krisajenkins/elm-exts +elm-package install justinmimbs/elm-date-extra ``` ## Development diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index 2b3ceac..f7e4db6 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -127,7 +127,7 @@ instance HasEncoder ElmValue where render _ = error "HasEncoderRef ElmValue: should not happen" instance HasEncoderRef ElmPrimitive where - renderRef EDate = pure $ parens "Json.Encode.string << toString" + renderRef EDate = pure $ parens "Json.Encode.string << toUtcIsoString" renderRef EUnit = pure "Json.Encode.null" renderRef EInt = pure "Json.Encode.int" renderRef EChar = pure "Json.Encode.char" From 2d09892fcacbbda8c9b4b49dc4353063a5d8cf31 Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Tue, 16 Oct 2018 14:47:10 +0200 Subject: [PATCH 19/24] Fix ADT support for Elm 0.19 --- src/Elm/Decoder.hs | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 01ac785..e14101d 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -39,10 +39,10 @@ instance HasDecoderRef ElmDatatype where instance HasDecoder ElmConstructor where render (NamedConstructor name value) = do dv <- render value - return $ "decode" <+> stext name <$$> indent 4 dv + return $ "Json.Decode.succeed" <+> stext name <$$> indent 4 dv render (RecordConstructor name value) = do dv <- render value - return $ "decode" <+> stext name <$$> indent 4 dv + return $ "Json.Decode.succeed" <+> stext name <$$> indent 4 dv render mc@(MultipleConstructors constrs) = do cstrs <- mapM renderSum constrs @@ -65,12 +65,12 @@ instance HasDecoder ElmConstructor where requiredContents :: Doc requiredContents = "required" <+> dquotes "contents" --- | "" -> decode +-- | "" -> Json.Decode.succeed renderSumCondition :: T.Text -> Doc -> RenderM Doc renderSumCondition name contents = pure $ dquotes (stext name) <+> "->" <$$> indent 4 - ("decode" <+> stext name <$$> indent 4 contents) + ("Json.Decode.succeed" <+> stext name <$$> indent 4 contents) -- | Render a sum type constructor in context of a data type with multiple -- constructors. From 3bbee9d0e5ff063ad3fd6dc18c8401d3183bd268 Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Tue, 16 Oct 2018 22:22:42 +0200 Subject: [PATCH 20/24] Fix time support for Elm 0.19 Not very pretty. Build with "rtfeldman/elm-iso8601-date-strings": "1.1.2" --- src/Elm/Decoder.hs | 2 +- src/Elm/Encoder.hs | 2 +- src/Elm/Record.hs | 4 ++-- 3 files changed, 4 insertions(+), 4 deletions(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index e14101d..602c6c1 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -132,7 +132,7 @@ instance HasDecoderRef ElmPrimitive where return . parens $ "map2 (,)" <+> parens ("index 0" <+> dx) <+> parens ("index 1" <+> dy) renderRef EUnit = pure $ parens "succeed ()" - renderRef EDate = pure "decodeDate" + renderRef EDate = pure "Iso8601.decoder" renderRef EInt = pure "int" renderRef EBool = pure "bool" renderRef EChar = pure "char" diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index f7e4db6..d5b0712 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -127,7 +127,7 @@ instance HasEncoder ElmValue where render _ = error "HasEncoderRef ElmValue: should not happen" instance HasEncoderRef ElmPrimitive where - renderRef EDate = pure $ parens "Json.Encode.string << toUtcIsoString" + renderRef EDate = pure "Iso8601.encode" renderRef EUnit = pure "Json.Encode.null" renderRef EInt = pure "Json.Encode.int" renderRef EChar = pure "Json.Encode.char" diff --git a/src/Elm/Record.hs b/src/Elm/Record.hs index eb92a42..f58ef04 100644 --- a/src/Elm/Record.hs +++ b/src/Elm/Record.hs @@ -88,8 +88,8 @@ instance HasTypeRef ElmPrimitive where return $ "Dict" <+> parens dk <+> parens dv renderRef EInt = pure "Int" renderRef EDate = do - require "Date" - pure "Date" + require "Time" + pure "Time.Posix" renderRef EBool = pure "Bool" renderRef EChar = pure "Char" renderRef EString = pure "String" From 99b58d040f93d405aa5d13ba24170fc6ca2ed89c Mon Sep 17 00:00:00 2001 From: Robert Hensing Date: Tue, 16 Oct 2018 22:23:56 +0200 Subject: [PATCH 21/24] Fix Json.Encode.list usage for Elm 0.19 --- src/Elm/Encoder.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index d5b0712..e55db62 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -36,7 +36,7 @@ instance HasEncoderRef ElmDatatype where instance HasEncoder ElmConstructor where -- Single constructor, no values: empty array render (NamedConstructor _name ElmEmpty) = - return $ "Json.Encode.list []" + return $ "Json.Encode.list Json.Encode.bool []" -- Single constructor, multiple values: create array with values render (NamedConstructor name value@(Values _ _)) = do @@ -137,7 +137,7 @@ instance HasEncoderRef ElmPrimitive where renderRef (EList (ElmPrimitive EChar)) = pure "Json.Encode.string" renderRef (EList datatype) = do dd <- renderRef datatype - return . parens $ "Json.Encode.list << List.map" <+> dd + return . parens $ "Json.Encode.list" <+> dd renderRef (EMaybe datatype) = do dd <- renderRef datatype return . parens $ "Maybe.withDefault Json.Encode.null << Maybe.map" <+> dd From 87b07daabe0e22df5d48d4157e7e090368defe3b Mon Sep 17 00:00:00 2001 From: Gergo Date: Mon, 10 Dec 2018 08:55:56 +0900 Subject: [PATCH 22/24] Fix tests --- test/CommentDecoder.elm | 4 ++-- test/CommentDecoderWithOptions.elm | 4 ++-- test/CommentEncoder.elm | 2 +- test/CommentEncoderWithOptions.elm | 2 +- test/CommentType.elm | 4 ++-- test/CommentTypeWithOptions.elm | 4 ++-- test/ExportSpec.hs | 12 ++++++------ test/MonstrosityDecoder.elm | 6 +++--- test/MonstrosityEncoder.elm | 4 ++-- test/PositionDecoder.elm | 6 +++--- test/PostDecoder.elm | 2 +- test/PostDecoderWithOptions.elm | 2 +- test/PostEncoder.elm | 2 +- test/PostEncoderWithOptions.elm | 2 +- test/TimingDecoder.elm | 6 +++--- test/TimingEncoder.elm | 4 ++-- test/UselessDecoder.elm | 2 +- 17 files changed, 34 insertions(+), 34 deletions(-) diff --git a/test/CommentDecoder.elm b/test/CommentDecoder.elm index 95122b0..3037276 100644 --- a/test/CommentDecoder.elm +++ b/test/CommentDecoder.elm @@ -9,10 +9,10 @@ import Json.Decode.Pipeline exposing (..) decodeComment : Decoder Comment decodeComment = - decode Comment + Json.Decode.succeed Comment |> required "postId" int |> required "text" string |> required "mainCategories" (map2 (,) (index 0 string) (index 1 string)) |> required "published" bool - |> required "created" decodeDate + |> required "created" Iso8601.decoder |> required "tags" (map Dict.fromList (list (map2 (,) (index 0 string) (index 1 int)))) diff --git a/test/CommentDecoderWithOptions.elm b/test/CommentDecoderWithOptions.elm index 24419a2..8b631ba 100644 --- a/test/CommentDecoderWithOptions.elm +++ b/test/CommentDecoderWithOptions.elm @@ -9,10 +9,10 @@ import Json.Decode.Pipeline exposing (..) decodeComment : Decoder Comment decodeComment = - decode Comment + Json.Decode.succeed Comment |> required "commentPostId" int |> required "commentText" string |> required "commentMainCategories" (map2 (,) (index 0 string) (index 1 string)) |> required "commentPublished" bool - |> required "commentCreated" decodeDate + |> required "commentCreated" Iso8601.decoder |> required "commentTags" (map Dict.fromList (list (map2 (,) (index 0 string) (index 1 int)))) diff --git a/test/CommentEncoder.elm b/test/CommentEncoder.elm index 0acc9be..dfd5965 100644 --- a/test/CommentEncoder.elm +++ b/test/CommentEncoder.elm @@ -12,6 +12,6 @@ encodeComment x = , ( "text", Json.Encode.string x.text ) , ( "mainCategories", (Exts.Json.Encode.tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) , ( "published", Json.Encode.bool x.published ) - , ( "created", (Json.Encode.string << toString) x.created ) + , ( "created", Iso8601.encode x.created ) , ( "tags", (Exts.Json.Encode.dict Json.Encode.string Json.Encode.int) x.tags ) ] diff --git a/test/CommentEncoderWithOptions.elm b/test/CommentEncoderWithOptions.elm index 5769e68..e59730f 100644 --- a/test/CommentEncoderWithOptions.elm +++ b/test/CommentEncoderWithOptions.elm @@ -12,6 +12,6 @@ encodeComment x = , ( "commentText", Json.Encode.string x.text ) , ( "commentMainCategories", (Exts.Json.Encode.tuple2 Json.Encode.string Json.Encode.string) x.mainCategories ) , ( "commentPublished", Json.Encode.bool x.published ) - , ( "commentCreated", (Json.Encode.string << toString) x.created ) + , ( "commentCreated", Iso8601.encode x.created ) , ( "commentTags", (Exts.Json.Encode.dict Json.Encode.string Json.Encode.int) x.tags ) ] diff --git a/test/CommentType.elm b/test/CommentType.elm index 8fb5920..9150c74 100644 --- a/test/CommentType.elm +++ b/test/CommentType.elm @@ -1,6 +1,6 @@ module CommentType exposing (..) -import Date exposing (Date) +import Time import Dict exposing (Dict) @@ -9,6 +9,6 @@ type alias Comment = , text : String , mainCategories : (String, String) , published : Bool - , created : Date + , created : Time.Posix , tags : Dict (String) (Int) } diff --git a/test/CommentTypeWithOptions.elm b/test/CommentTypeWithOptions.elm index 8417985..b88a564 100644 --- a/test/CommentTypeWithOptions.elm +++ b/test/CommentTypeWithOptions.elm @@ -1,6 +1,6 @@ module CommentTypeWithOptions exposing (..) -import Date exposing (Date) +import Time import Dict exposing (Dict) @@ -9,6 +9,6 @@ type alias Comment = , commentText : String , commentMainCategories : (String, String) , commentPublished : Bool - , commentCreated : Date + , commentCreated : Time.Posix , commentTags : Dict (String) (Int) } diff --git a/test/ExportSpec.hs b/test/ExportSpec.hs index dd4b2bc..2d9a38b 100644 --- a/test/ExportSpec.hs +++ b/test/ExportSpec.hs @@ -105,7 +105,7 @@ toElmTypeSpec = (unlines [ "module CommentType exposing (..)" , "" - , "import Date exposing (Date)" + , "import Time" , "import Dict exposing (Dict)" , "" , "" @@ -170,7 +170,7 @@ toElmTypeSpec = (unlines [ "module CommentTypeWithOptions exposing (..)" , "" - , "import Date exposing (Date)" + , "import Time" , "import Dict exposing (Dict)" , "" , "" @@ -467,7 +467,7 @@ toElmEncoderSpec = toElmEncoderRef (Proxy :: Proxy Post) `shouldBe` "encodePost" it "toElmEncoderRef [Comment]" $ toElmEncoderRef (Proxy :: Proxy [Comment]) `shouldBe` - "(Json.Encode.list << List.map encodeComment)" + "(Json.Encode.list encodeComment)" it "toElmEncoderRef Position" $ toElmEncoderRef (Proxy :: Proxy Position) `shouldBe` "encodePosition" it "toElmEncoderRef Timing" $ @@ -481,7 +481,7 @@ toElmEncoderSpec = "(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))" + "(Json.Encode.list (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))" it "toElmEncoderRef (Map String (Maybe String))" $ toElmEncoderRef (Proxy :: Proxy (Map String (Maybe String))) `shouldBe` "(Exts.Json.Encode.dict Json.Encode.string (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string))" @@ -503,10 +503,10 @@ moduleSpecsSpec = head (declarations mySpec) `shouldBe` intercalate "\n" - [ "import Date" - , "import Dict" + [ "import Dict" , "import Json.Decode exposing (..)" , "import Json.Decode.Pipeline exposing (..)" + , "import Time" ] shouldMatchTypeSource diff --git a/test/MonstrosityDecoder.elm b/test/MonstrosityDecoder.elm index 8139eaa..5854541 100644 --- a/test/MonstrosityDecoder.elm +++ b/test/MonstrosityDecoder.elm @@ -12,14 +12,14 @@ decodeMonstrosity = (\x -> case x of "NotSpecial" -> - decode NotSpecial + Json.Decode.succeed NotSpecial "OkayIGuess" -> - decode OkayIGuess + Json.Decode.succeed OkayIGuess |> required "contents" decodeMonstrosity "Ridiculous" -> - decode Ridiculous + Json.Decode.succeed Ridiculous |> required "contents" (index 0 int) |> required "contents" (index 1 string) |> required "contents" (index 2 (list decodeMonstrosity)) diff --git a/test/MonstrosityEncoder.elm b/test/MonstrosityEncoder.elm index addb424..8d787e4 100644 --- a/test/MonstrosityEncoder.elm +++ b/test/MonstrosityEncoder.elm @@ -10,7 +10,7 @@ encodeMonstrosity x = NotSpecial -> Json.Encode.object [ ( "tag", Json.Encode.string "NotSpecial" ) - , ( "contents", Json.Encode.list [] ) + , ( "contents", Json.Encode.list Json.Encode.bool [] ) ] OkayIGuess y0 -> @@ -22,5 +22,5 @@ encodeMonstrosity x = Ridiculous y0 y1 y2 -> Json.Encode.object [ ( "tag", Json.Encode.string "Ridiculous" ) - , ( "contents", Json.Encode.list [ Json.Encode.int y0, Json.Encode.string y1, (Json.Encode.list << List.map encodeMonstrosity) y2 ] ) + , ( "contents", Json.Encode.list [ Json.Encode.int y0, Json.Encode.string y1, (Json.Encode.list encodeMonstrosity) y2 ] ) ] diff --git a/test/PositionDecoder.elm b/test/PositionDecoder.elm index 651da91..8b501a2 100644 --- a/test/PositionDecoder.elm +++ b/test/PositionDecoder.elm @@ -12,13 +12,13 @@ decodePosition = (\x -> case x of "Beginning" -> - decode Beginning + Json.Decode.succeed Beginning "Middle" -> - decode Middle + Json.Decode.succeed Middle "End" -> - decode End + Json.Decode.succeed End _ -> fail "Constructor not matched" diff --git a/test/PostDecoder.elm b/test/PostDecoder.elm index deeb35a..416b931 100644 --- a/test/PostDecoder.elm +++ b/test/PostDecoder.elm @@ -8,7 +8,7 @@ import PostType exposing (..) decodePost : Decoder Post decodePost = - decode Post + Json.Decode.succeed Post |> required "id" int |> required "name" string |> required "age" (nullable float) diff --git a/test/PostDecoderWithOptions.elm b/test/PostDecoderWithOptions.elm index 9f8a8b6..0821682 100644 --- a/test/PostDecoderWithOptions.elm +++ b/test/PostDecoderWithOptions.elm @@ -8,7 +8,7 @@ import PostType exposing (..) decodePost : Decoder Post decodePost = - decode Post + Json.Decode.succeed Post |> required "postId" int |> required "postName" string |> required "postAge" (nullable float) diff --git a/test/PostEncoder.elm b/test/PostEncoder.elm index d2e109f..9b43801 100644 --- a/test/PostEncoder.elm +++ b/test/PostEncoder.elm @@ -11,7 +11,7 @@ encodePost x = [ ( "id", Json.Encode.int x.id ) , ( "name", Json.Encode.string x.name ) , ( "age", (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.float) x.age ) - , ( "comments", (Json.Encode.list << List.map encodeComment) x.comments ) + , ( "comments", (Json.Encode.list encodeComment) x.comments ) , ( "promoted", (Maybe.withDefault Json.Encode.null << Maybe.map encodeComment) x.promoted ) , ( "author", (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string) x.author ) ] diff --git a/test/PostEncoderWithOptions.elm b/test/PostEncoderWithOptions.elm index 5d75345..ab7bdf5 100644 --- a/test/PostEncoderWithOptions.elm +++ b/test/PostEncoderWithOptions.elm @@ -11,7 +11,7 @@ encodePost x = [ ( "postId", Json.Encode.int x.id ) , ( "postName", Json.Encode.string x.name ) , ( "postAge", (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.float) x.age ) - , ( "postComments", (Json.Encode.list << List.map encodeComment) x.comments ) + , ( "postComments", (Json.Encode.list encodeComment) x.comments ) , ( "postPromoted", (Maybe.withDefault Json.Encode.null << Maybe.map encodeComment) x.promoted ) , ( "postAuthor", (Maybe.withDefault Json.Encode.null << Maybe.map Json.Encode.string) x.author ) ] diff --git a/test/TimingDecoder.elm b/test/TimingDecoder.elm index bef3b72..5ce3aa3 100644 --- a/test/TimingDecoder.elm +++ b/test/TimingDecoder.elm @@ -12,14 +12,14 @@ decodeTiming = (\x -> case x of "Start" -> - decode Start + Json.Decode.succeed Start "Continue" -> - decode Continue + Json.Decode.succeed Continue |> required "contents" float "Stop" -> - decode Stop + Json.Decode.succeed Stop _ -> fail "Constructor not matched" diff --git a/test/TimingEncoder.elm b/test/TimingEncoder.elm index d6a1afe..19e9184 100644 --- a/test/TimingEncoder.elm +++ b/test/TimingEncoder.elm @@ -10,7 +10,7 @@ encodeTiming x = Start -> Json.Encode.object [ ( "tag", Json.Encode.string "Start" ) - , ( "contents", Json.Encode.list [] ) + , ( "contents", Json.Encode.list Json.Encode.bool [] ) ] Continue y0 -> @@ -22,5 +22,5 @@ encodeTiming x = Stop -> Json.Encode.object [ ( "tag", Json.Encode.string "Stop" ) - , ( "contents", Json.Encode.list [] ) + , ( "contents", Json.Encode.list Json.Encode.bool [] ) ] diff --git a/test/UselessDecoder.elm b/test/UselessDecoder.elm index 965f323..775b936 100644 --- a/test/UselessDecoder.elm +++ b/test/UselessDecoder.elm @@ -7,5 +7,5 @@ import UselessType exposing (..) decodeUseless : Decoder Useless decodeUseless = - decode Useless + Json.Decode.succeed Useless (succeed ()) From 8199983f1150f3ae9654c393874d8c97e936f98e Mon Sep 17 00:00:00 2001 From: Gergo Date: Mon, 10 Dec 2018 09:35:56 +0900 Subject: [PATCH 23/24] Add Iso8601 to imports in date encoders/decoders --- src/Elm/Decoder.hs | 4 +++- src/Elm/Encoder.hs | 4 +++- test/CommentDecoder.elm | 1 + test/CommentDecoderWithOptions.elm | 1 + test/CommentEncoder.elm | 1 + test/CommentEncoderWithOptions.elm | 1 + test/ExportSpec.hs | 4 ++++ 7 files changed, 14 insertions(+), 2 deletions(-) diff --git a/src/Elm/Decoder.hs b/src/Elm/Decoder.hs index 602c6c1..86fb17a 100644 --- a/src/Elm/Decoder.hs +++ b/src/Elm/Decoder.hs @@ -132,7 +132,9 @@ instance HasDecoderRef ElmPrimitive where return . parens $ "map2 (,)" <+> parens ("index 0" <+> dx) <+> parens ("index 1" <+> dy) renderRef EUnit = pure $ parens "succeed ()" - renderRef EDate = pure "Iso8601.decoder" + renderRef EDate = do + require "Iso8601" + pure "Iso8601.decoder" renderRef EInt = pure "int" renderRef EBool = pure "bool" renderRef EChar = pure "char" diff --git a/src/Elm/Encoder.hs b/src/Elm/Encoder.hs index e55db62..ed3b6fb 100644 --- a/src/Elm/Encoder.hs +++ b/src/Elm/Encoder.hs @@ -127,7 +127,9 @@ instance HasEncoder ElmValue where render _ = error "HasEncoderRef ElmValue: should not happen" instance HasEncoderRef ElmPrimitive where - renderRef EDate = pure "Iso8601.encode" + renderRef EDate = do + require "Iso8601" + pure "Iso8601.encode" renderRef EUnit = pure "Json.Encode.null" renderRef EInt = pure "Json.Encode.int" renderRef EChar = pure "Json.Encode.char" diff --git a/test/CommentDecoder.elm b/test/CommentDecoder.elm index 3037276..e0aa5e1 100644 --- a/test/CommentDecoder.elm +++ b/test/CommentDecoder.elm @@ -3,6 +3,7 @@ module CommentDecoder exposing (..) import CommentType exposing (..) import Dict import Exts.Json.Decode exposing (..) +import Iso8601 import Json.Decode exposing (..) import Json.Decode.Pipeline exposing (..) diff --git a/test/CommentDecoderWithOptions.elm b/test/CommentDecoderWithOptions.elm index 8b631ba..1c74cb3 100644 --- a/test/CommentDecoderWithOptions.elm +++ b/test/CommentDecoderWithOptions.elm @@ -3,6 +3,7 @@ module CommentDecoderWithOptions exposing (..) import CommentType exposing (..) import Dict import Exts.Json.Decode exposing (..) +import Iso8601 import Json.Decode exposing (..) import Json.Decode.Pipeline exposing (..) diff --git a/test/CommentEncoder.elm b/test/CommentEncoder.elm index dfd5965..5913359 100644 --- a/test/CommentEncoder.elm +++ b/test/CommentEncoder.elm @@ -2,6 +2,7 @@ module CommentEncoder exposing (..) import CommentType exposing (..) import Exts.Json.Encode exposing (..) +import Iso8601 import Json.Encode diff --git a/test/CommentEncoderWithOptions.elm b/test/CommentEncoderWithOptions.elm index e59730f..17544b6 100644 --- a/test/CommentEncoderWithOptions.elm +++ b/test/CommentEncoderWithOptions.elm @@ -2,6 +2,7 @@ module CommentEncoderWithOptions exposing (..) import CommentType exposing (..) import Exts.Json.Encode exposing (..) +import Iso8601 import Json.Encode diff --git a/test/ExportSpec.hs b/test/ExportSpec.hs index 2d9a38b..6671f06 100644 --- a/test/ExportSpec.hs +++ b/test/ExportSpec.hs @@ -212,6 +212,7 @@ toElmDecoderSpec = , "import CommentType exposing (..)" , "import Dict" , "import Exts.Json.Decode exposing (..)" + , "import Iso8601" , "import Json.Decode exposing (..)" , "import Json.Decode.Pipeline exposing (..)" , "" @@ -306,6 +307,7 @@ toElmDecoderSpec = , "import CommentType exposing (..)" , "import Dict" , "import Exts.Json.Decode exposing (..)" + , "import Iso8601" , "import Json.Decode exposing (..)" , "import Json.Decode.Pipeline exposing (..)" , "" @@ -367,6 +369,7 @@ toElmEncoderSpec = , "" , "import CommentType exposing (..)" , "import Exts.Json.Encode exposing (..)" + , "import Iso8601" , "import Json.Encode" , "" , "" @@ -397,6 +400,7 @@ toElmEncoderSpec = , "" , "import CommentType exposing (..)" , "import Exts.Json.Encode exposing (..)" + , "import Iso8601" , "import Json.Encode" , "" , "" From 2131abf9127717460df7c7f5f85e4fdd7cbbd5bc Mon Sep 17 00:00:00 2001 From: Gergo Date: Mon, 10 Dec 2018 09:39:46 +0900 Subject: [PATCH 24/24] Updating extra packages list --- README.md | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/README.md b/README.md index 3a6a6e9..3fd0a24 100644 --- a/README.md +++ b/README.md @@ -59,10 +59,10 @@ under that the Elm source file `Db/Types.elm` will be found. The decoders we produce require these extra Elm packages installed: -``` sh -elm package install NoRedInk/elm-decode-pipeline +```sh +elm package install NoRedInk/elm-json-decode-pipeline elm package install krisajenkins/elm-exts -elm-package install justinmimbs/elm-date-extra +elm package install rtfeldman/elm-iso8601-date-strings ``` ## Development