{- | AST representing structure of Elm types. Haskell generic representation is
converted to this AST which later is going to be pretty-printed.
-}

module Elm.Ast
       ( ElmDefinition (..)

       , ElmRecord (..)
       , ElmType (..)
       , ElmPrim (..)

       , ElmRecordField (..)
       , ElmConstructor (..)
       , isEnum
       , getConstructorNames

       , TypeName (..)
       , TypeRef (..)
       , definitionToRef
       ) where

import Data.List.NonEmpty (NonEmpty, toList)
import Data.Text (Text)


-- | Elm data type definition.
data ElmDefinition
    = DefRecord !ElmRecord
    | DefType   !ElmType
    | DefPrim   !ElmPrim
    deriving (Int -> ElmDefinition -> ShowS
[ElmDefinition] -> ShowS
ElmDefinition -> String
(Int -> ElmDefinition -> ShowS)
-> (ElmDefinition -> String)
-> ([ElmDefinition] -> ShowS)
-> Show ElmDefinition
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElmDefinition] -> ShowS
$cshowList :: [ElmDefinition] -> ShowS
show :: ElmDefinition -> String
$cshow :: ElmDefinition -> String
showsPrec :: Int -> ElmDefinition -> ShowS
$cshowsPrec :: Int -> ElmDefinition -> ShowS
Show)

-- | AST for @record type alias@ in Elm.
data ElmRecord = ElmRecord
    { ElmRecord -> Text
elmRecordName      :: !Text  -- ^ Name of the record
    , ElmRecord -> NonEmpty ElmRecordField
elmRecordFields    :: !(NonEmpty ElmRecordField)  -- ^ List of fields
    , ElmRecord -> Bool
elmRecordIsNewtype :: !Bool  -- ^ 'True' if Haskell type is a @newtype@
    } deriving (Int -> ElmRecord -> ShowS
[ElmRecord] -> ShowS
ElmRecord -> String
(Int -> ElmRecord -> ShowS)
-> (ElmRecord -> String)
-> ([ElmRecord] -> ShowS)
-> Show ElmRecord
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElmRecord] -> ShowS
$cshowList :: [ElmRecord] -> ShowS
show :: ElmRecord -> String
$cshow :: ElmRecord -> String
showsPrec :: Int -> ElmRecord -> ShowS
$cshowsPrec :: Int -> ElmRecord -> ShowS
Show)

-- | Single field of @record type alias@.
data ElmRecordField = ElmRecordField
    { ElmRecordField -> TypeRef
elmRecordFieldType :: !TypeRef
    , ElmRecordField -> Text
elmRecordFieldName :: !Text
    } deriving (Int -> ElmRecordField -> ShowS
[ElmRecordField] -> ShowS
ElmRecordField -> String
(Int -> ElmRecordField -> ShowS)
-> (ElmRecordField -> String)
-> ([ElmRecordField] -> ShowS)
-> Show ElmRecordField
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElmRecordField] -> ShowS
$cshowList :: [ElmRecordField] -> ShowS
show :: ElmRecordField -> String
$cshow :: ElmRecordField -> String
showsPrec :: Int -> ElmRecordField -> ShowS
$cshowsPrec :: Int -> ElmRecordField -> ShowS
Show)

-- | Wrapper for name of the type.
newtype TypeName = TypeName
    { TypeName -> Text
unTypeName :: Text
    } deriving (Int -> TypeName -> ShowS
[TypeName] -> ShowS
TypeName -> String
(Int -> TypeName -> ShowS)
-> (TypeName -> String) -> ([TypeName] -> ShowS) -> Show TypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeName] -> ShowS
$cshowList :: [TypeName] -> ShowS
show :: TypeName -> String
$cshow :: TypeName -> String
showsPrec :: Int -> TypeName -> ShowS
$cshowsPrec :: Int -> TypeName -> ShowS
Show)

-- | AST for @type@ in Elm.
data ElmType = ElmType
    { ElmType -> Text
elmTypeName         :: !Text  -- ^ Name of the data type
    , ElmType -> [Text]
elmTypeVars         :: ![Text]  -- ^ List of type variables; currently only phantom variables
    , ElmType -> Bool
elmTypeIsNewtype    :: !Bool  -- ^ 'True' if Haskell type is a @newtype@
    , ElmType -> NonEmpty ElmConstructor
elmTypeConstructors :: !(NonEmpty ElmConstructor)  -- ^ List of constructors
    } deriving (Int -> ElmType -> ShowS
[ElmType] -> ShowS
ElmType -> String
(Int -> ElmType -> ShowS)
-> (ElmType -> String) -> ([ElmType] -> ShowS) -> Show ElmType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElmType] -> ShowS
$cshowList :: [ElmType] -> ShowS
show :: ElmType -> String
$cshow :: ElmType -> String
showsPrec :: Int -> ElmType -> ShowS
$cshowsPrec :: Int -> ElmType -> ShowS
Show)

-- | Constructor of @type@.
data ElmConstructor = ElmConstructor
    { ElmConstructor -> Text
elmConstructorName   :: !Text  -- ^ Name of the constructor
    , ElmConstructor -> [TypeRef]
elmConstructorFields :: ![TypeRef]  -- ^ Fields of the constructor
    } deriving (Int -> ElmConstructor -> ShowS
[ElmConstructor] -> ShowS
ElmConstructor -> String
(Int -> ElmConstructor -> ShowS)
-> (ElmConstructor -> String)
-> ([ElmConstructor] -> ShowS)
-> Show ElmConstructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElmConstructor] -> ShowS
$cshowList :: [ElmConstructor] -> ShowS
show :: ElmConstructor -> String
$cshow :: ElmConstructor -> String
showsPrec :: Int -> ElmConstructor -> ShowS
$cshowsPrec :: Int -> ElmConstructor -> ShowS
Show)

-- | Checks if the given 'ElmType' is Enum.
isEnum :: ElmType -> Bool
isEnum :: ElmType -> Bool
isEnum ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} = [Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
elmTypeVars Bool -> Bool -> Bool
&& [TypeRef] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null ((ElmConstructor -> [TypeRef])
-> NonEmpty ElmConstructor -> [TypeRef]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ElmConstructor -> [TypeRef]
elmConstructorFields NonEmpty ElmConstructor
elmTypeConstructors)

-- | Gets the list of the constructor names.
getConstructorNames :: ElmType -> [Text]
getConstructorNames :: ElmType -> [Text]
getConstructorNames ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} = (ElmConstructor -> Text) -> [ElmConstructor] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ElmConstructor -> Text
elmConstructorName ([ElmConstructor] -> [Text]) -> [ElmConstructor] -> [Text]
forall a b. (a -> b) -> a -> b
$ NonEmpty ElmConstructor -> [ElmConstructor]
forall a. NonEmpty a -> [a]
toList NonEmpty ElmConstructor
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@
    | 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 (Int -> ElmPrim -> ShowS
[ElmPrim] -> ShowS
ElmPrim -> String
(Int -> ElmPrim -> ShowS)
-> (ElmPrim -> String) -> ([ElmPrim] -> ShowS) -> Show ElmPrim
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ElmPrim] -> ShowS
$cshowList :: [ElmPrim] -> ShowS
show :: ElmPrim -> String
$cshow :: ElmPrim -> String
showsPrec :: Int -> ElmPrim -> ShowS
$cshowsPrec :: Int -> ElmPrim -> ShowS
Show)

-- | Reference to another existing type.
data TypeRef
    = RefPrim !ElmPrim
    | RefCustom !TypeName
    deriving (Int -> TypeRef -> ShowS
[TypeRef] -> ShowS
TypeRef -> String
(Int -> TypeRef -> ShowS)
-> (TypeRef -> String) -> ([TypeRef] -> ShowS) -> Show TypeRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TypeRef] -> ShowS
$cshowList :: [TypeRef] -> ShowS
show :: TypeRef -> String
$cshow :: TypeRef -> String
showsPrec :: Int -> TypeRef -> ShowS
$cshowsPrec :: Int -> TypeRef -> ShowS
Show)

-- | Extracts reference to the existing data type type from some other type elm defintion.
definitionToRef :: ElmDefinition -> TypeRef
definitionToRef :: ElmDefinition -> TypeRef
definitionToRef = \case
    DefRecord ElmRecord{Bool
Text
NonEmpty ElmRecordField
elmRecordIsNewtype :: Bool
elmRecordFields :: NonEmpty ElmRecordField
elmRecordName :: Text
elmRecordIsNewtype :: ElmRecord -> Bool
elmRecordFields :: ElmRecord -> NonEmpty ElmRecordField
elmRecordName :: ElmRecord -> Text
..} -> TypeName -> TypeRef
RefCustom (TypeName -> TypeRef) -> TypeName -> TypeRef
forall a b. (a -> b) -> a -> b
$ Text -> TypeName
TypeName Text
elmRecordName
    DefType ElmType{Bool
[Text]
Text
NonEmpty ElmConstructor
elmTypeConstructors :: NonEmpty ElmConstructor
elmTypeIsNewtype :: Bool
elmTypeVars :: [Text]
elmTypeName :: Text
elmTypeConstructors :: ElmType -> NonEmpty ElmConstructor
elmTypeIsNewtype :: ElmType -> Bool
elmTypeVars :: ElmType -> [Text]
elmTypeName :: ElmType -> Text
..} -> TypeName -> TypeRef
RefCustom (TypeName -> TypeRef) -> TypeName -> TypeRef
forall a b. (a -> b) -> a -> b
$ Text -> TypeName
TypeName Text
elmTypeName
    DefPrim ElmPrim
elmPrim -> ElmPrim -> TypeRef
RefPrim ElmPrim
elmPrim