elm-street 0.0.0 → 0.0.1
raw patch · 6 files changed
+72/−46 lines, 6 filesdep ~servantdep ~servant-serverPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: servant, servant-server
API changes (from Hackage documentation)
Files
- CHANGELOG.md +8/−2
- README.md +10/−6
- elm-street.cabal +5/−5
- src/Elm/Aeson.hs +2/−0
- src/Elm/Print.hs +16/−7
- types/Types.hs +31/−26
CHANGELOG.md view
@@ -3,8 +3,14 @@ `elm-street` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. -0.0.0-=====+## 0.0.1 — Mar 29, 2019++* [#64](https://github.com/holmusk/elm-street/issues/64):+ Fix indentation for the generated enums.+* [#66](https://github.com/holmusk/elm-street/issues/66):+ Patch JSON encoders and decoders for sum types with a single field.++## 0.0.0 * Initially created.
README.md view
@@ -182,7 +182,7 @@ { userName :: Text , userAge :: Int } deriving (Generic)- deriving anyclass (Elm)+ deriving (Elm, ToJSON, FromJSON) via ElmStreet User ``` **Elm**@@ -215,7 +215,7 @@ | Rejected | Reviewing deriving (Generic)- deriving anyclass (Elm)+ deriving (Elm, ToJSON, FromJSON) via ElmStreet RequestStatus ``` **Elm**@@ -257,6 +257,7 @@ newtype Age = Age { unAge :: Int } deriving (Generic)+ deriving newtype (FromJSON, ToJSON) deriving anyclass (Elm) ``` @@ -279,7 +280,10 @@ **Haskell** ```haskell-newtype Id a = Id { unId :: Text }+newtype Id a = Id+ { unId :: Text+ } deriving (Generic)+ deriving newtype (FromJSON, ToJSON) instance Elm (Id a) where toElmDefinition _ = elmNewtype @Text "Id" "unId"@@ -309,7 +313,7 @@ | Visitor Text | Blocked deriving (Generic)- deriving anyclass (Elm)+ deriving (Elm, ToJSON, FromJSON) via ElmStreet Guest ``` **Elm**@@ -323,7 +327,7 @@ encodeGuest : Guest -> Value encodeGuest x = E.object <| case x of Regular x1 x2 -> [("tag", E.string "Regular"), ("contents", E.list identity [E.string x1, E.int x2])]- Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.list identity [E.string x1])]+ Visitor x1 -> [("tag", E.string "Visitor"), ("contents", E.string x1)] Blocked -> [("tag", E.string "Blocked"), ("contents", E.list identity [])] decodeGuest : Decoder Guest@@ -331,7 +335,7 @@ let decide : String -> Decoder Guest decide x = case x of "Regular" -> D.field "contents" <| D.map2 Regular (D.index 0 D.string) (D.index 1 D.int)- "Visitor" -> D.field "contents" <| D.map Visitor (D.index 0 D.string)+ "Visitor" -> D.field "contents" <| D.map Visitor D.string "Blocked" -> D.succeed Blocked c -> D.fail <| "Guest doesn't have such constructor: " ++ c in D.andThen decide (D.field "tag" D.string)
elm-street.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: elm-street-version: 0.0.0+version: 0.0.1 synopsis: Crossing the road between Haskell and Elm description: `Elm-street` allows you to generate automatically derived from Haskell types@@ -34,7 +34,7 @@ Elm.Print build-depends: base >= 4.11.1.0 && < 4.13- , aeson >= 1.4+ , aeson >= 1.3 , directory ^>= 1.3 , filepath ^>= 1.4 , prettyprinter ^>= 1.2.1@@ -128,10 +128,10 @@ other-modules: Api build-depends: base- , servant ^>= 0.15- , servant-server ^>= 0.15+ , servant >= 0.14 && < 0.17+ , servant-server >= 0.14 && < 0.17 , types- , wai ^>= 3.2.2+ , wai ^>= 3.2 , warp ^>= 3.2 ghc-options: -Wall
src/Elm/Aeson.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+ {-# LANGUAGE AllowAmbiguousTypes #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE UndecidableInstances #-}
src/Elm/Print.hs view
@@ -25,7 +25,7 @@ import Data.List.NonEmpty (NonEmpty ((:|)), toList) import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, brackets, colon, comma, concatWith, dquotes, emptyDoc,+import Data.Text.Prettyprint.Doc (Doc, align, brackets, colon, comma, concatWith, dquotes, emptyDoc, equals, lbrace, lbracket, line, lparen, nest, parens, pipe, pretty, prettyList, rbrace, rbracket, rparen, sep, space, surround, vsep, (<+>))@@ -263,7 +263,7 @@ elmEnumUniverse t@ElmType{..} = vsep -- function type [ universeName <+> colon <+> "List" <+> pretty elmTypeName- , universeName <+> equals <+> prettyList (getConstructorNames t)+ , universeName <+> equals <+> align (prettyList $ getConstructorNames t) ] where universeName :: Doc ann@@ -346,8 +346,14 @@ map (pretty . mkText "x") [1..] contents :: Doc ann- contents = "," <+> parens (dquotes "contents" <> comma <+> "E.list identity" <+> brackets fieldEncs)+ contents = "," <+> parens (dquotes "contents" <> comma <+> contentsEnc) + -- JSON encoder for the "contents" key+ contentsEnc :: Doc ann+ contentsEnc = case elmConstructorFields of+ [_] -> fieldEncs+ _ -> "E.list identity" <+> brackets fieldEncs+ -- | @encoderA x1@ fieldEncs :: Doc ann fieldEncs = concatWith (surround ", ") $@@ -581,10 +587,10 @@ cases :: ElmConstructor -> Doc ann cases ElmConstructor{..} = dquotes cName <+> arrow <+>- case length elmConstructorFields of- 0 -> "D.succeed" <+> cName- n -> "D.field \"contents\" <| D.map" <> mapNum n <+> cName <+> createIndexes-+ case elmConstructorFields of+ [] -> "D.succeed" <+> cName+ [f] -> "D.field \"contents\" <| D.map" <+> cName <+> typeRefDecoder f+ l -> "D.field \"contents\" <| D.map" <> mapNum (length l) <+> cName <+> createIndexes where cName :: Doc ann cName = pretty elmConstructorName@@ -672,4 +678,7 @@ putStrLn $ T.unpack $ prettyShowDefinition $ DefType $ ElmType "Status" [] $ (ElmConstructor "Approved" [TypeName "String", TypeName "Int"]) :| [ElmConstructor "Yoyoyo" [], ElmConstructor "Wow" [TypeName "a"]] putStrLn $ T.unpack $ prettyShowDefinition $ DefType $ ElmType "Status" ["a"] $ (ElmConstructor "Approved" [TypeName "String", TypeName "Int"]) :| [ElmConstructor "Yoyoyo" [], ElmConstructor "Wow" [TypeName "a"]]++putStrLn $ T.unpack $ prettyShowDefinition $ DefType $ ElmType "Status" [] ((ElmConstructor "Approved" []) :| [ElmConstructor "Yoyoyo" [], ElmConstructor "Wow" [], ElmConstructor "OneMore" [], ElmConstructor "AndAnother" []])+ -}
types/Types.hs view
@@ -34,17 +34,17 @@ data Prims = Prims- { primsUnit :: ()- , primsBool :: Bool- , primsChar :: Char- , primsInt :: Int- , primsFloat :: Double- , primsString :: String- , primsTime :: UTCTime- , primsMaybe :: Maybe Word- , primsResult :: Either Int String- , primsPair :: (Char, Bool)- , primsList :: [Int]+ { primsUnit :: !()+ , primsBool :: !Bool+ , primsChar :: !Char+ , primsInt :: !Int+ , primsFloat :: !Double+ , primsString :: !String+ , primsTime :: !UTCTime+ , primsMaybe :: !(Maybe Word)+ , primsResult :: !(Either Int String)+ , primsPair :: !(Char, Bool)+ , primsList :: ![Int] } deriving (Generic, Eq, Show) #if ( __GLASGOW_HASKELL__ >= 806 ) deriving (Elm, ToJSON, FromJSON) via ElmStreet Prims@@ -77,10 +77,10 @@ deriving anyclass (Elm, FromJSON, ToJSON) data User = User- { userId :: Id User- , userName :: Text- , userAge :: Age- , userStatus :: RequestStatus+ { userId :: !(Id User)+ , userName :: !Text+ , userAge :: !Age+ , userStatus :: !RequestStatus } deriving (Generic, Eq, Show) deriving anyclass (Elm) @@ -95,9 +95,9 @@ deriving anyclass (Elm, FromJSON, ToJSON) data UserRequest = UserRequest- { userRequestIds :: [Id User]- , userRequestLimit :: Word32- , userRequestExample :: Maybe (Either User Guest)+ { userRequestIds :: ![Id User]+ , userRequestLimit :: !Word32+ , userRequestExample :: !(Maybe (Either User Guest)) } deriving (Generic, Eq, Show) deriving anyclass (Elm) @@ -106,13 +106,13 @@ -- | All test types together in one type to play with. data OneType = OneType- { oneTypePrims :: Prims- , oneTypeId :: Id OneType- , oneTypeAge :: Age- , oneTypeRequestStatus :: RequestStatus- , oneTypeUser :: User- , oneTypeGuest :: Guest- , oneTypeUserRequest :: UserRequest+ { oneTypePrims :: !Prims+ , oneTypeId :: !(Id OneType)+ , oneTypeAge :: !Age+ , oneTypeRequestStatus :: !RequestStatus+ , oneTypeUser :: !User+ , oneTypeGuests :: ![Guest]+ , oneTypeUserRequest :: !UserRequest } deriving (Generic, Eq, Show) deriving anyclass (Elm) @@ -139,7 +139,7 @@ , oneTypeAge = Age 18 , oneTypeRequestStatus = Reviewing , oneTypeUser = User (Id "1") "not-me" (Age 100) Approved- , oneTypeGuest = Regular "nice" 7+ , oneTypeGuests = [guestRegular, guestVisitor, guestBlocked] , oneTypeUserRequest = defaultUserRequest } where@@ -157,6 +157,11 @@ , primsPair = ('o', False) , primsList = [1..5] }++ guestRegular, guestVisitor, guestBlocked :: Guest+ guestRegular = Regular "nice" 7+ guestVisitor = Visitor "new-guest"+ guestBlocked = Blocked defaultUserRequest :: UserRequest defaultUserRequest = UserRequest