diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -3,6 +3,11 @@ `elm-street` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.1.0.1 — Sep 6, 2019 + +* Fix newtype qualified import bug in `Types.elm` generated module. +* Allow `pretty-printer-1.3` version. + ## 0.1.0.0 — Sep 6, 2019 * [#80](https://github.com/holmusk/elm-street/issues/80): diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -161,6 +161,12 @@ * `as` * `port` * `tag` (reserved for constructor name due to `aeson` options) +9. For newtypes `FromJSON` and `ToJSON` instances should be derived using `newtype` strategy. And `Elm` should be derived using `anyclass` strategy: + ```haskell + newtype Newtype = Newtype Int + deriving newtype (FromJSON, ToJSON) + deriving anyclass (Elm) + ``` ## Play with frontend example diff --git a/elm-street.cabal b/elm-street.cabal --- a/elm-street.cabal +++ b/elm-street.cabal @@ -1,6 +1,6 @@ cabal-version: 2.4 name: elm-street -version: 0.1.0.0 +version: 0.1.0.1 synopsis: Crossing the road between Haskell and Elm description: `Elm-street` allows you to generate automatically derived from Haskell types @@ -71,7 +71,7 @@ build-depends: aeson >= 1.3 , directory ^>= 1.3 , filepath ^>= 1.4 - , prettyprinter ^>= 1.2.1 + , prettyprinter >= 1.2.1 && < 1.4 , text ^>= 1.2 , time diff --git a/src/Elm/Print/Common.hs b/src/Elm/Print/Common.hs --- a/src/Elm/Print/Common.hs +++ b/src/Elm/Print/Common.hs @@ -8,6 +8,7 @@ , arrow , mkQualified , typeWithVarsDoc + , qualifiedTypeWithVarsDoc ) where import Data.Text (Text) @@ -49,15 +50,29 @@ mkQualified :: Text -> Doc ann mkQualified = pretty . ("T." <>) -{- | Creates a 'Doc' of the qualified type with its type variables (if any). +{- | Creates a 'Doc' of the type with its type variables (if any). -} typeWithVarsDoc - :: Text -- ^ Type name + :: Bool -- ^ Is qualified + -> Text -- ^ Type name -> [Text] -- ^ List of type variables -> Doc ann -typeWithVarsDoc (mkQualified -> qTypeName) = \case - [] -> qTypeName - vars -> qTypeName <+> typeVarsDoc vars +typeWithVarsDoc isQualified typeName = \case + [] -> tName + vars -> tName <+> typeVarsDoc vars where typeVarsDoc :: [Text] -> Doc ann typeVarsDoc = concatWith (surround " ") . map pretty + tName :: Doc ann + tName = + if isQualified + then mkQualified typeName + else pretty typeName + +{- | Creates a 'Doc' of the qualified type with its type variables (if any). +-} +qualifiedTypeWithVarsDoc + :: Text -- ^ Type name + -> [Text] -- ^ List of type variables + -> Doc ann +qualifiedTypeWithVarsDoc = typeWithVarsDoc True diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -20,7 +20,7 @@ import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), isEnum) -import Elm.Print.Common (arrow, mkQualified, showDoc, typeWithVarsDoc, wrapParens) +import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T @@ -200,7 +200,10 @@ -> [Text] -- ^ List of type variables -> Doc ann decoderDef typeName vars = - decoderName typeName <+> colon <+> "Decoder" <+> wrapParens (typeWithVarsDoc typeName vars) + decoderName typeName + <+> colon + <+> "Decoder" + <+> wrapParens (qualifiedTypeWithVarsDoc typeName vars) -- | Create the name of the decoder function. decoderName :: Text -> Doc ann diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -20,7 +20,7 @@ import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), isEnum) -import Elm.Print.Common (arrow, mkQualified, showDoc, typeWithVarsDoc) +import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc) import qualified Data.List.NonEmpty as NE import qualified Data.Text as T @@ -64,7 +64,7 @@ newtypeEncoder :: Doc ann newtypeEncoder = - name <+> equals <+> fieldEncoderDoc <+> "<< un" <> pretty elmTypeName + name <+> equals <+> fieldEncoderDoc <+> "<< T.un" <> pretty elmTypeName where fieldEncoderDoc :: Doc ann fieldEncoderDoc = case elmConstructorFields $ NE.head elmTypeConstructors of @@ -161,7 +161,11 @@ -> [Text] -- ^ List of type variables -> Doc ann encoderDef typeName vars = - encoderName typeName <+> colon <+> typeWithVarsDoc typeName vars <+> arrow <+> "Value" + encoderName typeName + <+> colon + <+> qualifiedTypeWithVarsDoc typeName vars + <+> arrow + <+> "Value" -- | Create the name of the encoder function. encoderName :: Text -> Doc ann diff --git a/src/Elm/Print/Types.hs b/src/Elm/Print/Types.hs --- a/src/Elm/Print/Types.hs +++ b/src/Elm/Print/Types.hs @@ -224,7 +224,7 @@ elmUnFuncDoc :: ElmType -> Doc ann elmUnFuncDoc ElmType{..} = line <> vsep - [ unName <+> colon <+> typeWithVarsDoc elmTypeName elmTypeVars <+> arrow <+> result + [ unName <+> colon <+> typeWithVarsDoc False elmTypeName elmTypeVars <+> arrow <+> result , unName <+> parens (ctorName <+> "x") <+> equals <+> "x" ] where diff --git a/types/Types.hs b/types/Types.hs --- a/types/Types.hs +++ b/types/Types.hs @@ -18,6 +18,8 @@ , Prims (..) , Id (..) , Age (..) + , Newtype (..) + , OneConstructor (..) , RequestStatus (..) , User (..) , Guest (..) @@ -70,13 +72,28 @@ deriving anyclass (Elm) deriving newtype (FromJSON, ToJSON) +newtype Newtype = Newtype Int + deriving stock (Generic, Eq, Show) + deriving newtype (FromJSON, ToJSON) + deriving anyclass (Elm) + +data OneConstructor = OneConstructor + deriving stock (Generic, Eq, Show) + deriving anyclass (Elm) + +instance ToJSON OneConstructor where toJSON = elmStreetToJson +instance FromJSON OneConstructor where parseJSON = elmStreetParseJson + data RequestStatus = Approved | Rejected | Reviewing deriving (Generic, Eq, Show) - deriving anyclass (Elm, FromJSON, ToJSON) + deriving anyclass (Elm) +instance ToJSON RequestStatus where toJSON = elmStreetToJson +instance FromJSON RequestStatus where parseJSON = elmStreetParseJson + data User = User { userId :: !(Id User) , userName :: !Text @@ -93,8 +110,11 @@ | Visitor Text | Blocked deriving (Generic, Eq, Show) - deriving anyclass (Elm, FromJSON, ToJSON) + deriving anyclass (Elm) +instance ToJSON Guest where toJSON = elmStreetToJson +instance FromJSON Guest where parseJSON = elmStreetParseJson + data UserRequest = UserRequest { userRequestIds :: ![Id User] , userRequestLimit :: !Word32 @@ -121,19 +141,24 @@ = Ok | Err Text deriving (Generic, Eq, Show) - deriving anyclass (Elm, FromJSON, ToJSON) + deriving anyclass (Elm) +instance ToJSON MyResult where toJSON = elmStreetToJson +instance FromJSON MyResult where parseJSON = elmStreetParseJson + -- | All test types together in one type to play with. data OneType = OneType - { oneTypePrims :: !Prims - , oneTypeMyUnit :: !MyUnit - , oneTypeMyResult :: !MyResult - , oneTypeId :: !(Id OneType) - , oneTypeAge :: !Age - , oneTypeRequestStatus :: !RequestStatus - , oneTypeUser :: !User - , oneTypeGuests :: ![Guest] - , oneTypeUserRequest :: !UserRequest + { oneTypePrims :: !Prims + , oneTypeMyUnit :: !MyUnit + , oneTypeMyResult :: !MyResult + , oneTypeId :: !(Id OneType) + , oneTypeAge :: !Age + , oneTypeNewtype :: !Newtype + , oneTypeOneConstructor :: !OneConstructor + , oneTypeRequestStatus :: !RequestStatus + , oneTypeUser :: !User + , oneTypeGuests :: ![Guest] + , oneTypeUserRequest :: !UserRequest } deriving (Generic, Eq, Show) deriving anyclass (Elm) @@ -147,6 +172,8 @@ , MyResult , Id () , Age + , Newtype + , OneConstructor , RequestStatus , User , Guest @@ -162,6 +189,8 @@ , oneTypeMyResult = Err "clashing test" , oneTypeId = Id "myId" , oneTypeAge = Age 18 + , oneTypeNewtype = Newtype 666 + , oneTypeOneConstructor = OneConstructor , oneTypeRequestStatus = Reviewing , oneTypeUser = User (Id "1") "not-me" (Age 100) Approved , oneTypeGuests = [guestRegular, guestVisitor, guestBlocked]