[#18] Support primitive elm types (#22)

Resolves #18

src/Elm/Ast.hs

@@ -4,14 +4,19 @@ converted to this AST which later is going to be pretty-printed.
 
 module Elm.Ast
        ( ElmDefinition (..)
+
        , ElmAlias (..)
-       , ElmRecordField (..)
-       , TypeName (..)
        , ElmType (..)
-       , ElmConstructor (..)
+       , ElmPrim (..)
 
+       , ElmRecordField (..)
+       , ElmConstructor (..)
        , isEnum
        , getConstructorNames
+
+       , TypeName (..)
+       , TypeRef (..)
+       , definitionToRef
        ) where
 
 import Data.List.NonEmpty (NonEmpty, toList)
@@ -21,6 +26,7 @@ import Data.Text (Text)
 data ElmDefinition
     = DefAlias ElmAlias
     | DefType  ElmType
+    | DefPrim  ElmPrim
     deriving (Show)
 
 data ElmAlias = ElmAlias
@@ -29,7 +35,7 @@ data ElmAlias = ElmAlias
     } deriving (Show)
 
 data ElmRecordField = ElmRecordField
-    { elmRecordFieldType :: TypeName
+    { elmRecordFieldType :: TypeRef
     , elmRecordFieldName :: Text
     } deriving (Show)
 
@@ -45,7 +51,7 @@ data ElmType = ElmType
 
 data ElmConstructor = ElmConstructor
     { elmConstructorName   :: Text  -- ^ Name of the constructor
-    , elmConstructorFields :: [TypeName]  -- ^ Fields of the constructor
+    , elmConstructorFields :: [TypeRef]  -- ^ Fields of the constructor
     } deriving (Show)
 
 -- | Checks i the given 'ElmType' is Enum.
@@ -55,3 +61,31 @@ isEnum ElmType{..} = null elmTypeVars && null (foldMap elmConstructorFields elmT
 -- | Gets the list of the constructor names.
 getConstructorNames :: ElmType -> [Text]
 getConstructorNames ElmType{..} = map elmConstructorName $ toList elmTypeConstructors
+
+-- | Primitive elm types; hardcoded by the language
+data ElmPrim
+    = ElmUnit                    -- ^ @()@ type in elm
+    | ElmNever                   -- ^ @Never@ type in elm, analogous to Void in Haskell
+    | ElmBool                    -- ^ @Bool@
+    | ElmChar                    -- ^ @Char@
+    | ElmInt                     -- ^ @Int@
+    | ElmFloat                   -- ^ @Float@
+    | ElmString                  -- ^ @String@
+    | ElmMaybe TypeRef           -- ^ @Maybe T@
+    | ElmResult TypeRef TypeRef  -- ^ @Result A B@ in elm
+    | ElmPair TypeRef TypeRef    -- ^ @(A, B)@ in elm
+    | ElmList TypeRef            -- ^ @List A@ in elm
+    deriving (Show)
+
+-- | Reference to another existing type.
+data TypeRef
+    = RefPrim ElmPrim
+    | RefCustom TypeName
+    deriving (Show)
+
+-- | Extracts reference to the existing data type type from some other type elm defintion.
+definitionToRef :: ElmDefinition -> TypeRef
+definitionToRef = \case
+    DefAlias ElmAlias{..} -> RefCustom $ TypeName elmAliasName
+    DefType ElmType{..} -> RefCustom $ TypeName elmTypeName
+    DefPrim elmPrim -> RefPrim elmPrim

src/Elm/Generic.hs

@@ -12,6 +12,7 @@
 module Elm.Generic
        ( -- * Main data type for the user
          Elm (..)
+       , elmRef
 
          -- * Generic utilities
        , GenericElmDefinition (..)
@@ -26,18 +27,21 @@ module Elm.Generic
        ) where
 
 import Data.Char (isLower, toLower)
+import Data.Int (Int16, Int32, Int8)
 import Data.Kind (Type)
 import Data.List.NonEmpty (NonEmpty (..))
 import Data.Proxy (Proxy (..))
 import Data.Text (Text)
+import Data.Void (Void)
+import Data.Word (Word16, Word32, Word8)
 import GHC.Generics ((:*:), (:+:), C1, Constructor (..), D1, Datatype (..), Generic (..), M1 (..),
                      Rec0, S1, Selector (..), U1)
-import Type.Reflection (Typeable, typeRep)
 
-import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmRecordField (..),
-                ElmType (..), TypeName (..))
+import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..),
+                ElmRecordField (..), ElmType (..), TypeName (..), TypeRef, definitionToRef)
 
 import qualified Data.Text as T
+import qualified Data.Text.Lazy as LT (Text)
 import qualified GHC.Generics as Generic (from)
 
 
@@ -53,6 +57,55 @@ class Elm a where
     toElmDefinition _ = genericToElmDefinition
         $ Generic.from (error "Proxy for generic elm was evaluated" :: a)
 
+-- | 'TypeRef' for the existing type.
+elmRef :: forall a . Elm a => TypeRef
+elmRef = definitionToRef $ toElmDefinition (Proxy @a)
+
+----------------------------------------------------------------------------
+-- Primitive instances
+----------------------------------------------------------------------------
+
+instance Elm ()   where toElmDefinition _ = DefPrim ElmUnit
+instance Elm Void where toElmDefinition _ = DefPrim ElmNever
+instance Elm Bool where toElmDefinition _ = DefPrim ElmBool
+instance Elm Char where toElmDefinition _ = DefPrim ElmChar
+
+instance Elm Int    where toElmDefinition _ = DefPrim ElmInt
+instance Elm Int8   where toElmDefinition _ = DefPrim ElmInt
+instance Elm Int16  where toElmDefinition _ = DefPrim ElmInt
+instance Elm Int32  where toElmDefinition _ = DefPrim ElmInt
+instance Elm Word   where toElmDefinition _ = DefPrim ElmInt
+instance Elm Word8  where toElmDefinition _ = DefPrim ElmInt
+instance Elm Word16 where toElmDefinition _ = DefPrim ElmInt
+instance Elm Word32 where toElmDefinition _ = DefPrim ElmInt
+
+instance Elm Float  where toElmDefinition _ = DefPrim ElmFloat
+instance Elm Double where toElmDefinition _ = DefPrim ElmFloat
+
+instance Elm String  where toElmDefinition _ = DefPrim ElmString
+instance Elm Text    where toElmDefinition _ = DefPrim ElmString
+instance Elm LT.Text where toElmDefinition _ = DefPrim ElmString
+
+-- 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 a => Elm (Maybe a) where
+    toElmDefinition _ = DefPrim $ ElmMaybe $ 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 [a] where
+    toElmDefinition _ = DefPrim $ ElmList (elmRef @a)
+
+instance Elm a => Elm (NonEmpty a) where
+    toElmDefinition _ = DefPrim $ ElmList (elmRef @a)
+
 ----------------------------------------------------------------------------
 -- Generic instances
 ----------------------------------------------------------------------------
@@ -87,7 +140,7 @@ not have.
 -}
 data GenericConstructor = GenericConstructor
     { genericConstructorName   :: Text
-    , genericConstructorFields :: [(TypeName, Maybe Text)]
+    , genericConstructorFields :: [(TypeRef, Maybe Text)]
     }
 
 {- | Generic constructor can be in one of the three states:
@@ -103,8 +156,8 @@ toElmConstructor GenericConstructor{..} = case genericConstructorFields of
         Nothing     -> Right $ ElmConstructor genericConstructorName $ map fst genericConstructorFields
         Just fields -> Left fields
   where
-    toRecordField :: (TypeName, Maybe Text) -> Maybe ElmRecordField
-    toRecordField (typeName, maybeFieldName) = ElmRecordField typeName <$> maybeFieldName
+    toRecordField :: (TypeRef, Maybe Text) -> Maybe ElmRecordField
+    toRecordField (typeRef, maybeFieldName) = ElmRecordField typeRef <$> maybeFieldName
 
 
 {- | Typeclass to collect all constructors of the Haskell data type generically. -}
@@ -131,7 +184,7 @@ class GenericElmFields (f :: k -> Type) where
     genericToElmFields
         :: TypeName  -- ^ Name of the data type; to be stripped
         -> f a  -- ^ Generic value
-        -> [(TypeName, Maybe Text)]
+        -> [(TypeRef, Maybe Text)]
 
 -- | If multiple fields then just combine all results.
 instance (GenericElmFields f, GenericElmFields g) => GenericElmFields (f :*: g) where
@@ -144,13 +197,10 @@ instance GenericElmFields U1 where
     genericToElmFields _ _ = []
 
 -- | Single constructor field.
-instance (Selector s, Typeable a) => GenericElmFields (S1 s (Rec0 a)) where
+instance (Selector s, Elm a) => GenericElmFields (S1 s (Rec0 a)) where
     genericToElmFields typeName selector = case selName selector of
-        ""   -> [(fieldTypeName, Nothing)]
-        name -> [(fieldTypeName, Just $ stripTypeNamePrefix typeName $ T.pack name)]
-      where
-        fieldTypeName :: TypeName
-        fieldTypeName = TypeName $ T.pack $ show (typeRep @a)
+        ""   -> [(elmRef @a, Nothing)]
+        name -> [(elmRef @a, Just $ stripTypeNamePrefix typeName $ T.pack name)]
 
 {- | Strips name of the type name from field name prefix.
 

src/Elm/Print.hs

@@ -8,11 +8,13 @@ module Elm.Print
 
 import Data.List.NonEmpty (NonEmpty ((:|)))
 import Data.Text (Text)
-import Data.Text.Prettyprint.Doc (Doc, colon, comma, dquotes, emptyDoc, equals, lbrace, line, nest,
-                                  pipe, pretty, prettyList, rbrace, sep, space, vsep, (<+>))
+import Data.Text.Prettyprint.Doc (Doc, colon, comma, dquotes, emptyDoc, equals, lbrace, line,
+                                  lparen, nest, pipe, pretty, prettyList, rbrace, rparen, sep,
+                                  space, vsep, (<+>))
 
-import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmRecordField (..),
-                ElmType (..), TypeName (..), getConstructorNames, isEnum)
+import Elm.Ast (ElmAlias (..), ElmConstructor (..), ElmDefinition (..), ElmPrim (..),
+                ElmRecordField (..), ElmType (..), TypeName (..), TypeRef (..), getConstructorNames,
+                isEnum)
 
 import qualified Data.Text as T
 
@@ -28,6 +30,30 @@ elmDoc :: ElmDefinition -> Doc ann
 elmDoc = \case
     DefAlias elmAlias -> elmAliasDoc elmAlias
     DefType elmType -> elmTypeDoc elmType
+    DefPrim _ -> emptyDoc
+
+-- | Pretty printer for type reference.
+elmTypeRefDoc :: TypeRef -> Doc ann
+elmTypeRefDoc = \case
+    RefPrim elmPrim -> elmPrimDoc elmPrim
+    RefCustom (TypeName typeName) -> pretty typeName
+
+{- | Pretty printer for primitive Elm types. This pretty printer is used only to
+display types of fields.
+-}
+elmPrimDoc :: ElmPrim -> Doc ann
+elmPrimDoc = \case
+    ElmUnit -> "()"
+    ElmNever -> "Never"
+    ElmBool -> "Bool"
+    ElmChar -> "Char"
+    ElmInt -> "Int"
+    ElmFloat -> "Float"
+    ElmString -> "String"
+    ElmMaybe ref -> "Maybe" <+> elmTypeRefDoc ref
+    ElmResult refA refB -> "Result" <+> elmTypeRefDoc refA <+> elmTypeRefDoc refB
+    ElmPair refA refB -> lparen <> elmTypeRefDoc refA  <> comma <+> elmTypeRefDoc refB <> rparen
+    ElmList ref -> "List" <+> elmTypeRefDoc ref
 
 {- | Pretty printer for Elm aliases:
 
@@ -53,7 +79,7 @@ elmAliasDoc ElmAlias{..} = nest 4 $
     recordFieldDoc ElmRecordField{..} =
             pretty elmRecordFieldName
         <+> colon
-        <+> pretty (unTypeName elmRecordFieldType)
+        <+> elmTypeRefDoc elmRecordFieldType
 
 {- | Pretty printer for Elm types with one or more constructors:
 
@@ -105,8 +131,8 @@ elmTypeDoc t@ElmType{..} =
         : map ((pipe <+>) . constructorDoc) rest
 
     constructorDoc :: ElmConstructor -> Doc ann
-    constructorDoc ElmConstructor{..} = sep $ map pretty $
-        elmConstructorName : map unTypeName elmConstructorFields
+    constructorDoc ElmConstructor{..} = sep $
+        pretty elmConstructorName : map elmTypeRefDoc elmConstructorFields
 
     enumFuncs :: Doc ann
     enumFuncs =