elm-street 0.1.0.1 → 0.1.0.2
raw patch · 7 files changed
+66/−35 lines, 7 filesnew-uploaderPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
Files
- CHANGELOG.md +6/−0
- elm-street.cabal +1/−1
- src/Elm/Print/Common.hs +5/−8
- src/Elm/Print/Decoder.hs +22/−12
- src/Elm/Print/Encoder.hs +19/−11
- src/Elm/Print/Types.hs +1/−1
- types/Types.hs +12/−2
CHANGELOG.md view
@@ -3,6 +3,12 @@ `elm-street` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.1.0.2 — Sep 13, 2019++* [#89](https://github.com/holmusk/elm-street/issues/89):+ Regulate parenthesis on complicated types in encoder, decoder and type+ generation.+ ## 0.1.0.1 — Sep 6, 2019 * Fix newtype qualified import bug in `Types.elm` generated module.
elm-street.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.4 name: elm-street-version: 0.1.0.1+version: 0.1.0.2 synopsis: Crossing the road between Haskell and Elm description: `Elm-street` allows you to generate automatically derived from Haskell types
src/Elm/Print/Common.hs view
@@ -12,7 +12,7 @@ ) where import Data.Text (Text)-import Data.Text.Prettyprint.Doc (Doc, concatWith, lparen, pretty, rparen, surround, (<+>))+import Data.Text.Prettyprint.Doc (Doc, concatWith, parens, pretty, surround, (<+>)) import qualified Data.Text as T @@ -24,13 +24,10 @@ {- | Wraps given document in parens if it contains more than single word. -} wrapParens :: Doc ann -> Doc ann-wrapParens = wordsDoc . T.words . showDoc- where- wordsDoc :: [Text] -> Doc ann- wordsDoc = \case- [] -> ""- [x] -> pretty x- xs -> lparen <> pretty (T.unwords xs) <> rparen+wrapParens doc = case T.words $ showDoc doc of+ [] -> doc+ [_] -> doc+ _ -> parens doc -- | Pretty printed arrow (@->@). arrow :: Doc ann
src/Elm/Print/Decoder.hs view
@@ -83,7 +83,7 @@ where newtypeDecoder :: Doc ann newtypeDecoder = name <+> "D.map" <+> qualifiedAliasName- <+> typeRefDecoder (elmRecordFieldType $ NE.head elmAliasFields)+ <+> wrapParens (typeRefDecoder $ elmRecordFieldType $ NE.head elmAliasFields) recordDecoder :: Doc ann recordDecoder = nest 4@@ -102,7 +102,7 @@ RefPrim ElmUnit -> "|> D.hardcoded ()" t -> "|> required" <+> dquotes (pretty elmRecordFieldName)- <+> typeRefDecoder t+ <+> wrapParens (typeRefDecoder t) typeDecoderDoc :: ElmType -> Doc ann typeDecoderDoc t@ElmType{..} =@@ -136,7 +136,7 @@ fieldDecoderDoc :: Doc ann fieldDecoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of [] -> "(D.fail \"Unknown field type of the newtype constructor\")"- f : _ -> typeRefDecoder f+ f : _ -> wrapParens $ typeRefDecoder f sumDecoder :: Doc ann sumDecoder = nest 4 $ vsep@@ -155,7 +155,7 @@ cases ElmConstructor{..} = dquotes cName <+> arrow <+> case elmConstructorFields of [] -> "D.succeed" <+> qualifiedConName- [f] -> "D.field \"contents\" <| D.map" <+> qualifiedConName <+> typeRefDecoder f+ [f] -> "D.field \"contents\" <| D.map" <+> qualifiedConName <+> wrapParens (typeRefDecoder f) l -> "D.field \"contents\" <| D.map" <> mapNum (length l) <+> qualifiedConName <+> createIndexes where cName :: Doc ann@@ -174,25 +174,35 @@ -- create @(D.index 0 D.string)@ etc. oneField :: Int -> TypeRef -> Doc ann- oneField i typeRef = parens $ "D.index" <+> pretty i <+> typeRefDecoder typeRef+ oneField i typeRef = parens $ "D.index"+ <+> pretty i+ <+> wrapParens (typeRefDecoder typeRef) -- | Converts the reference to the existing type to the corresponding decoder. typeRefDecoder :: TypeRef -> Doc ann typeRefDecoder (RefCustom TypeName{..}) = "decode" <> pretty (T.takeWhile (/= ' ') unTypeName) typeRefDecoder (RefPrim elmPrim) = case elmPrim of- ElmUnit -> "(D.map (always ()) (D.list D.string))"- ElmNever -> "(D.fail \"Never is not possible\")"+ ElmUnit -> "D.map (always ()) (D.list D.string)"+ ElmNever -> "D.fail \"Never is not possible\"" ElmBool -> "D.bool" ElmChar -> "elmStreetDecodeChar" ElmInt -> "D.int" ElmFloat -> "D.float" ElmString -> "D.string" ElmTime -> "Iso.decoder"- ElmMaybe t -> parens $ "nullable" <+> typeRefDecoder t- ElmResult l r -> parens $ "elmStreetDecodeEither" <+> typeRefDecoder l <+> typeRefDecoder r- ElmPair a b -> parens $ "elmStreetDecodePair" <+> typeRefDecoder a <+> typeRefDecoder b- ElmTriple a b c -> parens $ "elmStreetDecodeTriple" <+> typeRefDecoder a <+> typeRefDecoder b <+> typeRefDecoder c- ElmList l -> parens $ "D.list" <+> typeRefDecoder l+ ElmMaybe t -> "nullable"+ <+> wrapParens (typeRefDecoder t)+ ElmResult l r -> "elmStreetDecodeEither"+ <+> wrapParens (typeRefDecoder l)+ <+> wrapParens (typeRefDecoder r)+ ElmPair a b -> "elmStreetDecodePair"+ <+> wrapParens (typeRefDecoder a)+ <+> wrapParens (typeRefDecoder b)+ ElmTriple a b c -> "elmStreetDecodeTriple"+ <+> wrapParens (typeRefDecoder a)+ <+> wrapParens (typeRefDecoder b)+ <+> wrapParens (typeRefDecoder c)+ ElmList l -> "D.list" <+> wrapParens (typeRefDecoder l) -- | The definition of the @decodeTYPENAME@ function. decoderDef
src/Elm/Print/Encoder.hs view
@@ -20,7 +20,7 @@ import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), isEnum)-import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc)+import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T@@ -69,7 +69,7 @@ fieldEncoderDoc :: Doc ann fieldEncoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of [] -> "ERROR"- f : _ -> typeRefEncoder f+ f : _ -> wrapParens (typeRefEncoder f) sumEncoder :: Doc ann sumEncoder = nest 4@@ -105,7 +105,7 @@ -- | @encoderA x1@ fieldEncs :: Doc ann fieldEncs = concatWith (surround ", ") $- zipWith (<+>) (map typeRefEncoder elmConstructorFields) fields+ zipWith (<+>) (map (wrapParens . typeRefEncoder) elmConstructorFields) fields -- | Makes variable like: @x11@ etc. mkText :: Text -> Int -> Text@@ -149,7 +149,7 @@ fieldEncoderDoc :: ElmRecordField -> Doc ann fieldEncoderDoc ElmRecordField{..} =- typeRefEncoder elmRecordFieldType <+> "x." <> pretty elmRecordFieldName+ wrapParens (typeRefEncoder elmRecordFieldType) <+> "x." <> pretty elmRecordFieldName -- | Create pair of view: @("tag", E.string "SomeName")@. mkTag :: Text -> Doc ann@@ -175,19 +175,27 @@ typeRefEncoder :: TypeRef -> Doc ann typeRefEncoder (RefCustom TypeName{..}) = "encode" <> pretty (T.takeWhile (/= ' ') unTypeName) typeRefEncoder (RefPrim elmPrim) = case elmPrim of- ElmUnit -> "(always <| E.list identity [])"+ ElmUnit -> "always <| E.list identity []" ElmNever -> "never" ElmBool -> "E.bool"- ElmChar -> parens "E.string << String.fromChar"+ ElmChar -> "E.string << String.fromChar" ElmInt -> "E.int" ElmFloat -> "E.float" ElmString -> "E.string" ElmTime -> "Iso.encode"- ElmMaybe t -> parens $ "elmStreetEncodeMaybe" <+> typeRefEncoder t- ElmResult l r -> parens $ "elmStreetEncodeEither" <+> typeRefEncoder l <+> typeRefEncoder r- ElmPair a b -> parens $ "elmStreetEncodePair" <+> typeRefEncoder a <+> typeRefEncoder b- ElmTriple a b c -> parens $ "elmStreetEncodeTriple" <+> typeRefEncoder a <+> typeRefEncoder b <+> typeRefEncoder c- ElmList l -> "E.list" <+> typeRefEncoder l+ ElmMaybe t -> "elmStreetEncodeMaybe"+ <+> wrapParens (typeRefEncoder t)+ ElmResult l r -> "elmStreetEncodeEither"+ <+> wrapParens (typeRefEncoder l)+ <+> wrapParens (typeRefEncoder r)+ ElmPair a b -> "elmStreetEncodePair"+ <+> wrapParens (typeRefEncoder a)+ <+> wrapParens (typeRefEncoder b)+ ElmTriple a b c -> "elmStreetEncodeTriple"+ <+> wrapParens (typeRefEncoder a)+ <+> wrapParens (typeRefEncoder b)+ <+> wrapParens (typeRefEncoder c)+ ElmList l -> "E.list" <+> wrapParens (typeRefEncoder l) -- | @JSON@ encoder Elm help function for 'Maybe's. encodeMaybe :: Text
src/Elm/Print/Types.hs view
@@ -207,7 +207,7 @@ constructorDoc :: ElmConstructor -> Doc ann constructorDoc ElmConstructor{..} = sep $- pretty elmConstructorName : map elmTypeRefDoc elmConstructorFields+ pretty elmConstructorName : map (wrapParens . elmTypeRefDoc) elmConstructorFields -- Generates 'unTYPENAME' function for newtype unFunc :: Doc ann
types/Types.hs view
@@ -19,6 +19,7 @@ , Id (..) , Age (..) , Newtype (..)+ , NewtypeList (..) , OneConstructor (..) , RequestStatus (..) , User (..)@@ -46,7 +47,7 @@ , primsMaybe :: !(Maybe Word) , primsResult :: !(Either Int Text) , primsPair :: !(Char, Bool)- , primsTriple :: !(Char, Bool, Int)+ , primsTriple :: !(Char, Bool, [Int]) , primsList :: ![Int] } deriving (Generic, Eq, Show) #if ( __GLASGOW_HASKELL__ >= 806 )@@ -77,6 +78,11 @@ deriving newtype (FromJSON, ToJSON) deriving anyclass (Elm) +newtype NewtypeList = NewtypeList [Int]+ deriving stock (Generic, Eq, Show)+ deriving newtype (FromJSON, ToJSON)+ deriving anyclass (Elm)+ data OneConstructor = OneConstructor deriving stock (Generic, Eq, Show) deriving anyclass (Elm)@@ -108,6 +114,7 @@ data Guest = Regular Text Int | Visitor Text+ | Special (Maybe [Int]) | Blocked deriving (Generic, Eq, Show) deriving anyclass (Elm)@@ -154,6 +161,7 @@ , oneTypeId :: !(Id OneType) , oneTypeAge :: !Age , oneTypeNewtype :: !Newtype+ , oneTypeNewtypeList :: !NewtypeList , oneTypeOneConstructor :: !OneConstructor , oneTypeRequestStatus :: !RequestStatus , oneTypeUser :: !User@@ -173,6 +181,7 @@ , Id () , Age , Newtype+ , NewtypeList , OneConstructor , RequestStatus , User@@ -190,6 +199,7 @@ , oneTypeId = Id "myId" , oneTypeAge = Age 18 , oneTypeNewtype = Newtype 666+ , oneTypeNewtypeList = NewtypeList [123] , oneTypeOneConstructor = OneConstructor , oneTypeRequestStatus = Reviewing , oneTypeUser = User (Id "1") "not-me" (Age 100) Approved@@ -209,7 +219,7 @@ , primsMaybe = Just 12 , primsResult = Left 666 , primsPair = ('o', False)- , primsTriple = ('o', False, 0)+ , primsTriple = ('o', False, [0]) , primsList = [1..5] }