diff --git a/frontend/src/Core/Decoder.elm b/frontend/src/Core/Decoder.elm index 828db7d..eca6619 100644 --- a/frontend/src/Core/Decoder.elm +++ b/frontend/src/Core/Decoder.elm @@ -16,8 +16,8 @@ decodePrims = D.succeed T.Prims |> required "int" D.int |> required "float" D.float |> required "text" D.string - |> required "time" Iso.decoder - |> required "value" D.value + |> required "time" Iso.decoder + |> required "value" D.value |> required "maybe" (nullable D.int) |> required "result" (elmStreetDecodeEither D.int D.string) |> required "pair" (elmStreetDecodePair elmStreetDecodeChar D.bool) diff --git a/frontend/src/Core/Encoder.elm b/frontend/src/Core/Encoder.elm index 78a161f..57c5181 100644 --- a/frontend/src/Core/Encoder.elm +++ b/frontend/src/Core/Encoder.elm @@ -16,8 +16,8 @@ encodePrims x = E.object , ("int", E.int x.int) , ("float", E.float x.float) , ("text", E.string x.text) - , ("time", Iso.encode x.time) - , ("value", Basics.identity x.value) + , ("time", Iso.encode x.time) + , ("value", Basics.identity x.value) , ("maybe", (elmStreetEncodeMaybe E.int) x.maybe) , ("result", (elmStreetEncodeEither E.int E.string) x.result) , ("pair", (elmStreetEncodePair (E.string << String.fromChar) E.bool) x.pair) diff --git a/frontend/src/Core/Types.elm b/frontend/src/Core/Types.elm index 322805d..f10f494 100644 --- a/frontend/src/Core/Types.elm +++ b/frontend/src/Core/Types.elm @@ -3,6 +3,8 @@ module Core.Types exposing (..) import Time exposing (Posix) import Json.Decode exposing (Value) +type alias ElmStreetNonEmptyList a = (a, List a) + type alias Prims = { unit : () @@ -11,14 +13,14 @@ type alias Prims = , int : Int , float : Float , text : String - , time : Posix - , value : Value + , time : Posix + , value : Value , maybe : Maybe Int , result : Result Int String , pair : (Char, Bool) , triple : (Char, Bool, List Int) , list : List Int - , nonEmpty : (Int, List Int) + , nonEmpty : ElmStreetNonEmptyList Int } type MyUnit @@ -116,5 +118,5 @@ type alias OneType = , user : User , guests : List Guest , userRequest : UserRequest - , nonEmpty : (MyUnit, List MyUnit) + , nonEmpty : ElmStreetNonEmptyList MyUnit } diff --git a/src/Elm/Ast.hs b/src/Elm/Ast.hs index 451c43d..1421e33 100644 --- a/src/Elm/Ast.hs +++ b/src/Elm/Ast.hs @@ -5,9 +5,10 @@ converted to this AST which later is going to be pretty-printed. module Elm.Ast ( ElmDefinition (..) + , ElmPrim (..) , ElmRecord (..) , ElmType (..) - , ElmPrim (..) + , ElmBuiltin (..) , ElmRecordField (..) , ElmConstructor (..) @@ -25,9 +26,10 @@ import Data.Text (Text) -- | Elm data type definition. data ElmDefinition - = DefRecord !ElmRecord + = DefPrim !ElmPrim + | DefRecord !ElmRecord + | DefBuiltin !ElmBuiltin | DefType !ElmType - | DefPrim !ElmPrim deriving (Show) -- | AST for @record type alias@ in Elm. @@ -70,7 +72,7 @@ isEnum ElmType{..} = null elmTypeVars && null (foldMap elmConstructorFields elmT getConstructorNames :: ElmType -> [Text] getConstructorNames ElmType{..} = map elmConstructorName $ toList elmTypeConstructors --- | Primitive elm types; hardcoded by the language. +-- | Primitive elm types which are parts of a language data ElmPrim = ElmUnit -- ^ @()@ type in elm | ElmNever -- ^ @Never@ type in elm, analogous to Void in Haskell @@ -79,25 +81,35 @@ data ElmPrim | ElmInt -- ^ @Int@ | ElmFloat -- ^ @Float@ | ElmString -- ^ @String@ - | ElmTime -- ^ @Posix@ in elm, @UTCTime@ in Haskell - | ElmValue -- ^ @Json.Encode.Value@ in elm, @Data.Aeson.Value@ in Haskell - | ElmMaybe !TypeRef -- ^ @Maybe T@ - | ElmResult !TypeRef !TypeRef -- ^ @Result A B@ in elm | ElmPair !TypeRef !TypeRef -- ^ @(A, B)@ in elm | ElmTriple !TypeRef !TypeRef !TypeRef -- ^ @(A, B, C)@ in elm - | ElmList !TypeRef -- ^ @List A@ in elm - | ElmNonEmptyPair !TypeRef -- ^ @NonEmpty A@ represented by @(A, List A)@ in elm deriving (Show) +-- | Builtin types defined by core or 3rd party libraries +-- Included definitions: +-- * @Maybe a@ +-- * @Result a b@ +-- * @List a@ +-- * @Time.Posix@ +-- * @Json.Encode.Value@ +data ElmBuiltin = ElmBuiltin + { builtinImplType :: !Text + , builtinImplEncoder :: !Text + , builtinImplDecoder :: !Text + , builtinImplParams :: ![TypeRef] + } deriving (Show) + -- | Reference to another existing type. data TypeRef = RefPrim !ElmPrim | RefCustom !TypeName + | RefBuiltin !ElmBuiltin deriving (Show) -- | Extracts reference to the existing data type type from some other type elm defintion. definitionToRef :: ElmDefinition -> TypeRef definitionToRef = \case DefRecord ElmRecord{..} -> RefCustom $ TypeName elmRecordName - DefType ElmType{..} -> RefCustom $ TypeName elmTypeName - DefPrim elmPrim -> RefPrim elmPrim + DefType ElmType{..} -> RefCustom $ TypeName elmTypeName + DefPrim elmPrim -> RefPrim elmPrim + DefBuiltin elmBuiltIn -> RefBuiltin elmBuiltIn diff --git a/src/Elm/Generate.hs b/src/Elm/Generate.hs index b645967..c644056 100644 --- a/src/Elm/Generate.hs +++ b/src/Elm/Generate.hs @@ -124,6 +124,8 @@ generateElm Settings{..} = do , "" , "import Time exposing (Posix)" , "import Json.Decode exposing (Value)" + , "" + , "type alias ElmStreetNonEmptyList a = (a, List a)" ] encoderHeader :: Text diff --git a/src/Elm/Generic.hs b/src/Elm/Generic.hs index 72e6ffe..6a6bf05 100644 --- a/src/Elm/Generic.hs +++ b/src/Elm/Generic.hs @@ -63,8 +63,9 @@ import GHC.Generics (C1, Constructor (..), D1, Datatype (..), Generic (..), M1 ( import GHC.TypeLits (ErrorMessage (..), Nat, TypeError) import GHC.TypeNats (type (+), type (<=?)) -import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..), - ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), definitionToRef) +import Elm.Ast (ElmBuiltin (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..), + ElmRecord (..), ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), + definitionToRef) import qualified Data.Text as T import qualified Data.Text.Lazy as LT (Text) @@ -118,32 +119,68 @@ instance Elm Double where toElmDefinition _ = DefPrim ElmFloat instance Elm Text where toElmDefinition _ = DefPrim ElmString instance Elm LT.Text where toElmDefinition _ = DefPrim ElmString -instance Elm Value where toElmDefinition _ = DefPrim ElmValue +instance (Elm a, Elm b) => Elm (a, b) where + toElmDefinition _ = DefPrim $ ElmPair (elmRef @a) (elmRef @b) + +instance (Elm a, Elm b, Elm c) => Elm (a, b, c) where + toElmDefinition _ = DefPrim $ ElmTriple (elmRef @a) (elmRef @b) (elmRef @c) -- TODO: should it be 'Bytes' from @bytes@ package? -- https://package.elm-lang.org/packages/elm/bytes/latest/Bytes -- instance Elm B.ByteString where toElmDefinition _ = DefPrim ElmString -- instance Elm LB.ByteString where toElmDefinition _ = DefPrim ElmString -instance Elm UTCTime where toElmDefinition _ = DefPrim ElmTime +---------------------------------------------------------------------------- +-- Builtin instances +---------------------------------------------------------------------------- + +instance Elm Value where + toElmDefinition _ = DefBuiltin $ ElmBuiltin + { builtinImplType = "Value" + , builtinImplEncoder = "Basics.identity" + , builtinImplDecoder = "D.value" + , builtinImplParams = [] + } + +instance Elm UTCTime where + toElmDefinition _ = DefBuiltin $ ElmBuiltin + { builtinImplType = "Posix" + , builtinImplEncoder = "Iso.encode" + , builtinImplDecoder = "Iso.decoder" + , builtinImplParams = [] + } instance Elm a => Elm (Maybe a) where - toElmDefinition _ = DefPrim $ ElmMaybe $ elmRef @a + toElmDefinition _ = DefBuiltin $ ElmBuiltin + { builtinImplType = "Maybe" + , builtinImplEncoder = "elmStreetEncodeMaybe" + , builtinImplDecoder = "nullable" + , builtinImplParams = [elmRef @a] + } instance (Elm a, Elm b) => Elm (Either a b) where - toElmDefinition _ = DefPrim $ ElmResult (elmRef @a) (elmRef @b) - -instance (Elm a, Elm b) => Elm (a, b) where - toElmDefinition _ = DefPrim $ ElmPair (elmRef @a) (elmRef @b) - -instance (Elm a, Elm b, Elm c) => Elm (a, b, c) where - toElmDefinition _ = DefPrim $ ElmTriple (elmRef @a) (elmRef @b) (elmRef @c) + toElmDefinition _ = DefBuiltin $ ElmBuiltin + { builtinImplType = "Result" + , builtinImplEncoder = "elmStreetEncodeEither" + , builtinImplDecoder = "elmStreetDecodeEither" + , builtinImplParams = [elmRef @a, elmRef @b] + } instance Elm a => Elm [a] where - toElmDefinition _ = DefPrim $ ElmList (elmRef @a) + toElmDefinition _ = DefBuiltin $ ElmBuiltin + { builtinImplType = "List" + , builtinImplEncoder = "E.list" + , builtinImplDecoder = "D.list" + , builtinImplParams = [elmRef @a] + } instance Elm a => Elm (NonEmpty a) where - toElmDefinition _ = DefPrim $ ElmNonEmptyPair (elmRef @a) + toElmDefinition _ = DefBuiltin $ ElmBuiltin + { builtinImplType = "ElmStreetNonEmptyList" + , builtinImplEncoder = "elmStreetEncodeNonEmpty" + , builtinImplDecoder = "elmStreetDecodeNonEmpty" + , builtinImplParams = [elmRef @a] + } ---------------------------------------------------------------------------- -- Smart constructors diff --git a/src/Elm/Print/Decoder.hs b/src/Elm/Print/Decoder.hs index e7cb857..e9ca606 100644 --- a/src/Elm/Print/Decoder.hs +++ b/src/Elm/Print/Decoder.hs @@ -14,13 +14,16 @@ module Elm.Print.Decoder , decodeNonEmpty ) where +import Data.List (intersperse) import Data.List.NonEmpty (toList) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, colon, concatWith, dquotes, emptyDoc, equals, line, nest, parens, pretty, surround, vsep, (<+>)) +import Prettyprinter.Util (reflow) -import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..), - ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), isEnum) +import Elm.Ast (ElmBuiltin (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..), + ElmRecord (..), ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), + isEnum) import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens) import qualified Data.List.NonEmpty as NE @@ -73,6 +76,7 @@ prettyShowDecoder def = showDoc $ case def of DefRecord elmRecord -> recordDecoderDoc elmRecord DefType elmType -> typeDecoderDoc elmType DefPrim _ -> emptyDoc + DefBuiltin _ -> emptyDoc recordDecoderDoc :: ElmRecord -> Doc ann recordDecoderDoc ElmRecord{..} = @@ -106,11 +110,11 @@ recordDecoderDoc ElmRecord{..} = <+> wrapParens (typeRefDecoder t) typeDecoderDoc :: ElmType -> Doc ann -typeDecoderDoc t@ElmType{..} = +typeDecoderDoc ElmType{..} = -- function defenition: @encodeTypeName : TypeName -> Value@. decoderDef elmTypeName elmTypeVars <> line - <> if isEnum t + <> if isEnum ElmType{..} -- if this is Enum just using the read instance we wrote. then enumDecoder else if elmTypeIsNewtype @@ -190,13 +194,6 @@ typeRefDecoder (RefPrim elmPrim) = case elmPrim of ElmInt -> "D.int" ElmFloat -> "D.float" ElmString -> "D.string" - ElmTime -> "Iso.decoder" - ElmValue -> "D.value" - 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) @@ -204,8 +201,8 @@ typeRefDecoder (RefPrim elmPrim) = case elmPrim of <+> wrapParens (typeRefDecoder a) <+> wrapParens (typeRefDecoder b) <+> wrapParens (typeRefDecoder c) - ElmList l -> "D.list" <+> wrapParens (typeRefDecoder l) - ElmNonEmptyPair a -> "elmStreetDecodeNonEmpty" <+> wrapParens (typeRefDecoder a) +typeRefDecoder (RefBuiltin ElmBuiltin{..}) = + reflow builtinImplDecoder <+> mconcat (intersperse " " (fmap (wrapParens . typeRefDecoder) builtinImplParams)) -- | The definition of the @decodeTYPENAME@ function. decoderDef diff --git a/src/Elm/Print/Encoder.hs b/src/Elm/Print/Encoder.hs index de38e4d..63422c4 100644 --- a/src/Elm/Print/Encoder.hs +++ b/src/Elm/Print/Encoder.hs @@ -13,14 +13,17 @@ module Elm.Print.Encoder , encodeNonEmpty ) where +import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty, toList) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, brackets, colon, comma, concatWith, dquotes, emptyDoc, equals, lbracket, line, nest, parens, pretty, rbracket, surround, vsep, (<+>)) +import Prettyprinter.Util (reflow) -import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..), - ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), isEnum) +import Elm.Ast (ElmBuiltin (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..), + ElmRecord (..), ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), + isEnum) import Elm.Print.Common (arrow, mkQualified, qualifiedTypeWithVarsDoc, showDoc, wrapParens) import qualified Data.List.NonEmpty as NE @@ -44,14 +47,15 @@ prettyShowEncoder def = showDoc $ case def of DefRecord elmRecord -> recordEncoderDoc elmRecord DefType elmType -> typeEncoderDoc elmType DefPrim _ -> emptyDoc + DefBuiltin _ -> emptyDoc -- | Encoder for 'ElmType' (which is either enum or the Sum type). typeEncoderDoc :: ElmType -> Doc ann -typeEncoderDoc t@ElmType{..} = +typeEncoderDoc ElmType{..} = -- function definition: @encodeTypeName : TypeName -> Value@. encoderDef elmTypeName elmTypeVars <> line - <> if isEnum t + <> if isEnum ElmType{..} -- if this is Enum just using the show instance we wrote. then enumEncoder else if elmTypeIsNewtype @@ -182,13 +186,6 @@ typeRefEncoder (RefPrim elmPrim) = case elmPrim of ElmInt -> "E.int" ElmFloat -> "E.float" ElmString -> "E.string" - ElmTime -> "Iso.encode" - ElmValue -> "Basics.identity" - 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) @@ -196,9 +193,8 @@ typeRefEncoder (RefPrim elmPrim) = case elmPrim of <+> wrapParens (typeRefEncoder a) <+> wrapParens (typeRefEncoder b) <+> wrapParens (typeRefEncoder c) - ElmList l -> "E.list" <+> wrapParens (typeRefEncoder l) - ElmNonEmptyPair a -> "elmStreetEncodeNonEmpty" - <+> wrapParens (typeRefEncoder a) +typeRefEncoder (RefBuiltin ElmBuiltin{..}) = + reflow builtinImplEncoder <+> mconcat (intersperse " " (fmap (wrapParens . typeRefEncoder) builtinImplParams)) -- | @JSON@ encoder Elm help function for 'Maybe's. encodeMaybe :: Text diff --git a/src/Elm/Print/Types.hs b/src/Elm/Print/Types.hs index 6c1d854..a752d6f 100644 --- a/src/Elm/Print/Types.hs +++ b/src/Elm/Print/Types.hs @@ -58,15 +58,17 @@ module Elm.Print.Types , elmTypeDoc ) where +import Data.List (intersperse) import Data.List.NonEmpty (NonEmpty ((:|))) import Data.Text (Text) import Data.Text.Prettyprint.Doc (Doc, align, colon, comma, dquotes, emptyDoc, equals, lbrace, line, lparen, nest, parens, pipe, pretty, prettyList, rbrace, rparen, sep, space, vsep, (<+>)) +import Prettyprinter.Util (reflow) -import Elm.Ast (ElmConstructor (..), ElmDefinition (..), ElmPrim (..), ElmRecord (..), - ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), getConstructorNames, - isEnum) +import Elm.Ast (ElmBuiltin (..), ElmConstructor (..), ElmDefinition (..), + ElmPrim (..), ElmRecord (..), ElmRecordField (..), ElmType (..), TypeName (..), + TypeRef (..), getConstructorNames, isEnum) import Elm.Print.Common (arrow, showDoc, typeWithVarsDoc, wrapParens) import qualified Data.List.NonEmpty as NE @@ -85,12 +87,14 @@ elmDoc = \case DefRecord elmRecord -> elmRecordDoc elmRecord DefType elmType -> elmTypeDoc elmType DefPrim _ -> emptyDoc + DefBuiltin _ -> emptyDoc -- | Pretty printer for type reference. elmTypeRefDoc :: TypeRef -> Doc ann elmTypeRefDoc = \case RefPrim elmPrim -> elmPrimDoc elmPrim RefCustom (TypeName typeName) -> pretty typeName + RefBuiltin elmBuiltIn -> elmBuiltinDoc elmBuiltIn {- | Pretty printer for primitive Elm types. This pretty printer is used only to display types of fields. @@ -104,14 +108,12 @@ elmPrimDoc = \case ElmInt -> "Int" ElmFloat -> "Float" ElmString -> "String" - ElmTime -> "Posix" - ElmValue -> "Value" - ElmMaybe t -> "Maybe" <+> elmTypeParenDoc t - ElmResult l r -> "Result" <+> elmTypeParenDoc l <+> elmTypeParenDoc r ElmPair a b -> lparen <> elmTypeRefDoc a <> comma <+> elmTypeRefDoc b <> rparen ElmTriple a b c -> lparen <> elmTypeRefDoc a <> comma <+> elmTypeRefDoc b <> comma <+> elmTypeRefDoc c <> rparen - ElmList l -> "List" <+> elmTypeParenDoc l - ElmNonEmptyPair a -> lparen <> elmTypeRefDoc a <> comma <+> "List" <+> elmTypeRefDoc a <> rparen + +elmBuiltinDoc :: ElmBuiltin -> Doc ann +elmBuiltinDoc ElmBuiltin{..} = + reflow builtinImplType <+> mconcat (intersperse " " (fmap elmTypeParenDoc builtinImplParams)) {- | Pretty-printer for types. Adds parens for both sides when needed (when type consists of multiple words). diff --git a/types/Types.hs b/types/Types.hs index 2572ac0..2e90e9b 100644 --- a/types/Types.hs +++ b/types/Types.hs @@ -27,8 +27,8 @@ module Types , UserRequest (..) ) where -import Data.Aeson (FromJSON (..), ToJSON (..), Value(..), object, (.=)) -import Data.List.NonEmpty (NonEmpty(..)) +import Data.Aeson (FromJSON (..), ToJSON (..), Value (..), object, (.=)) +import Data.List.NonEmpty (NonEmpty (..)) import Data.Text (Text) import Data.Time.Calendar (fromGregorian) import Data.Time.Clock (UTCTime (..)) @@ -45,7 +45,7 @@ data Prims = Prims , primsFloat :: !Double , primsText :: !Text , primsTime :: !UTCTime - , primsValue :: !Value + , primsValue :: !Value , primsMaybe :: !(Maybe Word) , primsResult :: !(Either Int Text) , primsPair :: !(Char, Bool)