{-| This module defines how the derived Haskell data types are represented.
- It is useful for writing type conversion rules.
-}
module Elm.TyRep where

import qualified Data.Char        as Char
import           Data.List
import           Data.Proxy
import           Data.Typeable    (TyCon, TypeRep, Typeable, splitTyConApp,
                                   tyConName, typeRep, typeRepTyCon)

import           Data.Aeson.Types (SumEncoding (..))
import           Data.Maybe       (fromMaybe)

-- | Type definition, including constructors.
data ETypeDef
   = ETypeAlias EAlias
   | ETypePrimAlias EPrimAlias
   | ETypeSum ESum
     deriving (Int -> ETypeDef -> ShowS
[ETypeDef] -> ShowS
ETypeDef -> String
(Int -> ETypeDef -> ShowS)
-> (ETypeDef -> String) -> ([ETypeDef] -> ShowS) -> Show ETypeDef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ETypeDef -> ShowS
showsPrec :: Int -> ETypeDef -> ShowS
$cshow :: ETypeDef -> String
show :: ETypeDef -> String
$cshowList :: [ETypeDef] -> ShowS
showList :: [ETypeDef] -> ShowS
Show, ETypeDef -> ETypeDef -> Bool
(ETypeDef -> ETypeDef -> Bool)
-> (ETypeDef -> ETypeDef -> Bool) -> Eq ETypeDef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ETypeDef -> ETypeDef -> Bool
== :: ETypeDef -> ETypeDef -> Bool
$c/= :: ETypeDef -> ETypeDef -> Bool
/= :: ETypeDef -> ETypeDef -> Bool
Eq)

-- | Type construction : type variables, type constructors, tuples and type
-- application.
data EType
   = ETyVar ETVar
   | ETyCon ETCon
   | ETyApp EType EType
   | ETyTuple Int
   deriving (Int -> EType -> ShowS
[EType] -> ShowS
EType -> String
(Int -> EType -> ShowS)
-> (EType -> String) -> ([EType] -> ShowS) -> Show EType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EType -> ShowS
showsPrec :: Int -> EType -> ShowS
$cshow :: EType -> String
show :: EType -> String
$cshowList :: [EType] -> ShowS
showList :: [EType] -> ShowS
Show, EType -> EType -> Bool
(EType -> EType -> Bool) -> (EType -> EType -> Bool) -> Eq EType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EType -> EType -> Bool
== :: EType -> EType -> Bool
$c/= :: EType -> EType -> Bool
/= :: EType -> EType -> Bool
Eq, Eq EType
Eq EType =>
(EType -> EType -> Ordering)
-> (EType -> EType -> Bool)
-> (EType -> EType -> Bool)
-> (EType -> EType -> Bool)
-> (EType -> EType -> Bool)
-> (EType -> EType -> EType)
-> (EType -> EType -> EType)
-> Ord EType
EType -> EType -> Bool
EType -> EType -> Ordering
EType -> EType -> EType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EType -> EType -> Ordering
compare :: EType -> EType -> Ordering
$c< :: EType -> EType -> Bool
< :: EType -> EType -> Bool
$c<= :: EType -> EType -> Bool
<= :: EType -> EType -> Bool
$c> :: EType -> EType -> Bool
> :: EType -> EType -> Bool
$c>= :: EType -> EType -> Bool
>= :: EType -> EType -> Bool
$cmax :: EType -> EType -> EType
max :: EType -> EType -> EType
$cmin :: EType -> EType -> EType
min :: EType -> EType -> EType
Ord)

{-| Type constructor:

> ETCon "Int"
-}
newtype ETCon
   = ETCon
   { ETCon -> String
tc_name :: String
   } deriving (Int -> ETCon -> ShowS
[ETCon] -> ShowS
ETCon -> String
(Int -> ETCon -> ShowS)
-> (ETCon -> String) -> ([ETCon] -> ShowS) -> Show ETCon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ETCon -> ShowS
showsPrec :: Int -> ETCon -> ShowS
$cshow :: ETCon -> String
show :: ETCon -> String
$cshowList :: [ETCon] -> ShowS
showList :: [ETCon] -> ShowS
Show, ETCon -> ETCon -> Bool
(ETCon -> ETCon -> Bool) -> (ETCon -> ETCon -> Bool) -> Eq ETCon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ETCon -> ETCon -> Bool
== :: ETCon -> ETCon -> Bool
$c/= :: ETCon -> ETCon -> Bool
/= :: ETCon -> ETCon -> Bool
Eq, Eq ETCon
Eq ETCon =>
(ETCon -> ETCon -> Ordering)
-> (ETCon -> ETCon -> Bool)
-> (ETCon -> ETCon -> Bool)
-> (ETCon -> ETCon -> Bool)
-> (ETCon -> ETCon -> Bool)
-> (ETCon -> ETCon -> ETCon)
-> (ETCon -> ETCon -> ETCon)
-> Ord ETCon
ETCon -> ETCon -> Bool
ETCon -> ETCon -> Ordering
ETCon -> ETCon -> ETCon
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ETCon -> ETCon -> Ordering
compare :: ETCon -> ETCon -> Ordering
$c< :: ETCon -> ETCon -> Bool
< :: ETCon -> ETCon -> Bool
$c<= :: ETCon -> ETCon -> Bool
<= :: ETCon -> ETCon -> Bool
$c> :: ETCon -> ETCon -> Bool
> :: ETCon -> ETCon -> Bool
$c>= :: ETCon -> ETCon -> Bool
>= :: ETCon -> ETCon -> Bool
$cmax :: ETCon -> ETCon -> ETCon
max :: ETCon -> ETCon -> ETCon
$cmin :: ETCon -> ETCon -> ETCon
min :: ETCon -> ETCon -> ETCon
Ord)

{-| Type variable:

> ETVar "a"
-}
newtype ETVar
   = ETVar
   { ETVar -> String
tv_name :: String
   } deriving (Int -> ETVar -> ShowS
[ETVar] -> ShowS
ETVar -> String
(Int -> ETVar -> ShowS)
-> (ETVar -> String) -> ([ETVar] -> ShowS) -> Show ETVar
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ETVar -> ShowS
showsPrec :: Int -> ETVar -> ShowS
$cshow :: ETVar -> String
show :: ETVar -> String
$cshowList :: [ETVar] -> ShowS
showList :: [ETVar] -> ShowS
Show, ETVar -> ETVar -> Bool
(ETVar -> ETVar -> Bool) -> (ETVar -> ETVar -> Bool) -> Eq ETVar
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ETVar -> ETVar -> Bool
== :: ETVar -> ETVar -> Bool
$c/= :: ETVar -> ETVar -> Bool
/= :: ETVar -> ETVar -> Bool
Eq, Eq ETVar
Eq ETVar =>
(ETVar -> ETVar -> Ordering)
-> (ETVar -> ETVar -> Bool)
-> (ETVar -> ETVar -> Bool)
-> (ETVar -> ETVar -> Bool)
-> (ETVar -> ETVar -> Bool)
-> (ETVar -> ETVar -> ETVar)
-> (ETVar -> ETVar -> ETVar)
-> Ord ETVar
ETVar -> ETVar -> Bool
ETVar -> ETVar -> Ordering
ETVar -> ETVar -> ETVar
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ETVar -> ETVar -> Ordering
compare :: ETVar -> ETVar -> Ordering
$c< :: ETVar -> ETVar -> Bool
< :: ETVar -> ETVar -> Bool
$c<= :: ETVar -> ETVar -> Bool
<= :: ETVar -> ETVar -> Bool
$c> :: ETVar -> ETVar -> Bool
> :: ETVar -> ETVar -> Bool
$c>= :: ETVar -> ETVar -> Bool
>= :: ETVar -> ETVar -> Bool
$cmax :: ETVar -> ETVar -> ETVar
max :: ETVar -> ETVar -> ETVar
$cmin :: ETVar -> ETVar -> ETVar
min :: ETVar -> ETVar -> ETVar
Ord)


{-| Type name:

> ETypeName "Map" [ETVar "k", ETVar "v"]
-}
data ETypeName
   = ETypeName
   { ETypeName -> String
et_name :: String
   , ETypeName -> [ETVar]
et_args :: [ETVar]
   } deriving (Int -> ETypeName -> ShowS
[ETypeName] -> ShowS
ETypeName -> String
(Int -> ETypeName -> ShowS)
-> (ETypeName -> String)
-> ([ETypeName] -> ShowS)
-> Show ETypeName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ETypeName -> ShowS
showsPrec :: Int -> ETypeName -> ShowS
$cshow :: ETypeName -> String
show :: ETypeName -> String
$cshowList :: [ETypeName] -> ShowS
showList :: [ETypeName] -> ShowS
Show, ETypeName -> ETypeName -> Bool
(ETypeName -> ETypeName -> Bool)
-> (ETypeName -> ETypeName -> Bool) -> Eq ETypeName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ETypeName -> ETypeName -> Bool
== :: ETypeName -> ETypeName -> Bool
$c/= :: ETypeName -> ETypeName -> Bool
/= :: ETypeName -> ETypeName -> Bool
Eq, Eq ETypeName
Eq ETypeName =>
(ETypeName -> ETypeName -> Ordering)
-> (ETypeName -> ETypeName -> Bool)
-> (ETypeName -> ETypeName -> Bool)
-> (ETypeName -> ETypeName -> Bool)
-> (ETypeName -> ETypeName -> Bool)
-> (ETypeName -> ETypeName -> ETypeName)
-> (ETypeName -> ETypeName -> ETypeName)
-> Ord ETypeName
ETypeName -> ETypeName -> Bool
ETypeName -> ETypeName -> Ordering
ETypeName -> ETypeName -> ETypeName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ETypeName -> ETypeName -> Ordering
compare :: ETypeName -> ETypeName -> Ordering
$c< :: ETypeName -> ETypeName -> Bool
< :: ETypeName -> ETypeName -> Bool
$c<= :: ETypeName -> ETypeName -> Bool
<= :: ETypeName -> ETypeName -> Bool
$c> :: ETypeName -> ETypeName -> Bool
> :: ETypeName -> ETypeName -> Bool
$c>= :: ETypeName -> ETypeName -> Bool
>= :: ETypeName -> ETypeName -> Bool
$cmax :: ETypeName -> ETypeName -> ETypeName
max :: ETypeName -> ETypeName -> ETypeName
$cmin :: ETypeName -> ETypeName -> ETypeName
min :: ETypeName -> ETypeName -> ETypeName
Ord)

data EPrimAlias
   = EPrimAlias
   { EPrimAlias -> ETypeName
epa_name :: ETypeName
   , EPrimAlias -> EType
epa_type :: EType
   } deriving (Int -> EPrimAlias -> ShowS
[EPrimAlias] -> ShowS
EPrimAlias -> String
(Int -> EPrimAlias -> ShowS)
-> (EPrimAlias -> String)
-> ([EPrimAlias] -> ShowS)
-> Show EPrimAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EPrimAlias -> ShowS
showsPrec :: Int -> EPrimAlias -> ShowS
$cshow :: EPrimAlias -> String
show :: EPrimAlias -> String
$cshowList :: [EPrimAlias] -> ShowS
showList :: [EPrimAlias] -> ShowS
Show, EPrimAlias -> EPrimAlias -> Bool
(EPrimAlias -> EPrimAlias -> Bool)
-> (EPrimAlias -> EPrimAlias -> Bool) -> Eq EPrimAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EPrimAlias -> EPrimAlias -> Bool
== :: EPrimAlias -> EPrimAlias -> Bool
$c/= :: EPrimAlias -> EPrimAlias -> Bool
/= :: EPrimAlias -> EPrimAlias -> Bool
Eq, Eq EPrimAlias
Eq EPrimAlias =>
(EPrimAlias -> EPrimAlias -> Ordering)
-> (EPrimAlias -> EPrimAlias -> Bool)
-> (EPrimAlias -> EPrimAlias -> Bool)
-> (EPrimAlias -> EPrimAlias -> Bool)
-> (EPrimAlias -> EPrimAlias -> Bool)
-> (EPrimAlias -> EPrimAlias -> EPrimAlias)
-> (EPrimAlias -> EPrimAlias -> EPrimAlias)
-> Ord EPrimAlias
EPrimAlias -> EPrimAlias -> Bool
EPrimAlias -> EPrimAlias -> Ordering
EPrimAlias -> EPrimAlias -> EPrimAlias
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EPrimAlias -> EPrimAlias -> Ordering
compare :: EPrimAlias -> EPrimAlias -> Ordering
$c< :: EPrimAlias -> EPrimAlias -> Bool
< :: EPrimAlias -> EPrimAlias -> Bool
$c<= :: EPrimAlias -> EPrimAlias -> Bool
<= :: EPrimAlias -> EPrimAlias -> Bool
$c> :: EPrimAlias -> EPrimAlias -> Bool
> :: EPrimAlias -> EPrimAlias -> Bool
$c>= :: EPrimAlias -> EPrimAlias -> Bool
>= :: EPrimAlias -> EPrimAlias -> Bool
$cmax :: EPrimAlias -> EPrimAlias -> EPrimAlias
max :: EPrimAlias -> EPrimAlias -> EPrimAlias
$cmin :: EPrimAlias -> EPrimAlias -> EPrimAlias
min :: EPrimAlias -> EPrimAlias -> EPrimAlias
Ord)

data EAlias
   = EAlias
   { EAlias -> ETypeName
ea_name         :: ETypeName
   , EAlias -> [(String, EType)]
ea_fields       :: [(String, EType)]
   , EAlias -> Bool
ea_omit_null    :: Bool
   , EAlias -> Bool
ea_newtype      :: Bool
   , EAlias -> Bool
ea_unwrap_unary :: Bool
   } deriving (Int -> EAlias -> ShowS
[EAlias] -> ShowS
EAlias -> String
(Int -> EAlias -> ShowS)
-> (EAlias -> String) -> ([EAlias] -> ShowS) -> Show EAlias
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EAlias -> ShowS
showsPrec :: Int -> EAlias -> ShowS
$cshow :: EAlias -> String
show :: EAlias -> String
$cshowList :: [EAlias] -> ShowS
showList :: [EAlias] -> ShowS
Show, EAlias -> EAlias -> Bool
(EAlias -> EAlias -> Bool)
-> (EAlias -> EAlias -> Bool) -> Eq EAlias
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EAlias -> EAlias -> Bool
== :: EAlias -> EAlias -> Bool
$c/= :: EAlias -> EAlias -> Bool
/= :: EAlias -> EAlias -> Bool
Eq, Eq EAlias
Eq EAlias =>
(EAlias -> EAlias -> Ordering)
-> (EAlias -> EAlias -> Bool)
-> (EAlias -> EAlias -> Bool)
-> (EAlias -> EAlias -> Bool)
-> (EAlias -> EAlias -> Bool)
-> (EAlias -> EAlias -> EAlias)
-> (EAlias -> EAlias -> EAlias)
-> Ord EAlias
EAlias -> EAlias -> Bool
EAlias -> EAlias -> Ordering
EAlias -> EAlias -> EAlias
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EAlias -> EAlias -> Ordering
compare :: EAlias -> EAlias -> Ordering
$c< :: EAlias -> EAlias -> Bool
< :: EAlias -> EAlias -> Bool
$c<= :: EAlias -> EAlias -> Bool
<= :: EAlias -> EAlias -> Bool
$c> :: EAlias -> EAlias -> Bool
> :: EAlias -> EAlias -> Bool
$c>= :: EAlias -> EAlias -> Bool
>= :: EAlias -> EAlias -> Bool
$cmax :: EAlias -> EAlias -> EAlias
max :: EAlias -> EAlias -> EAlias
$cmin :: EAlias -> EAlias -> EAlias
min :: EAlias -> EAlias -> EAlias
Ord)

data SumTypeFields
    = Anonymous [EType]
    | Named [(String, EType)]
    deriving (Int -> SumTypeFields -> ShowS
[SumTypeFields] -> ShowS
SumTypeFields -> String
(Int -> SumTypeFields -> ShowS)
-> (SumTypeFields -> String)
-> ([SumTypeFields] -> ShowS)
-> Show SumTypeFields
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SumTypeFields -> ShowS
showsPrec :: Int -> SumTypeFields -> ShowS
$cshow :: SumTypeFields -> String
show :: SumTypeFields -> String
$cshowList :: [SumTypeFields] -> ShowS
showList :: [SumTypeFields] -> ShowS
Show, SumTypeFields -> SumTypeFields -> Bool
(SumTypeFields -> SumTypeFields -> Bool)
-> (SumTypeFields -> SumTypeFields -> Bool) -> Eq SumTypeFields
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SumTypeFields -> SumTypeFields -> Bool
== :: SumTypeFields -> SumTypeFields -> Bool
$c/= :: SumTypeFields -> SumTypeFields -> Bool
/= :: SumTypeFields -> SumTypeFields -> Bool
Eq, Eq SumTypeFields
Eq SumTypeFields =>
(SumTypeFields -> SumTypeFields -> Ordering)
-> (SumTypeFields -> SumTypeFields -> Bool)
-> (SumTypeFields -> SumTypeFields -> Bool)
-> (SumTypeFields -> SumTypeFields -> Bool)
-> (SumTypeFields -> SumTypeFields -> Bool)
-> (SumTypeFields -> SumTypeFields -> SumTypeFields)
-> (SumTypeFields -> SumTypeFields -> SumTypeFields)
-> Ord SumTypeFields
SumTypeFields -> SumTypeFields -> Bool
SumTypeFields -> SumTypeFields -> Ordering
SumTypeFields -> SumTypeFields -> SumTypeFields
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SumTypeFields -> SumTypeFields -> Ordering
compare :: SumTypeFields -> SumTypeFields -> Ordering
$c< :: SumTypeFields -> SumTypeFields -> Bool
< :: SumTypeFields -> SumTypeFields -> Bool
$c<= :: SumTypeFields -> SumTypeFields -> Bool
<= :: SumTypeFields -> SumTypeFields -> Bool
$c> :: SumTypeFields -> SumTypeFields -> Bool
> :: SumTypeFields -> SumTypeFields -> Bool
$c>= :: SumTypeFields -> SumTypeFields -> Bool
>= :: SumTypeFields -> SumTypeFields -> Bool
$cmax :: SumTypeFields -> SumTypeFields -> SumTypeFields
max :: SumTypeFields -> SumTypeFields -> SumTypeFields
$cmin :: SumTypeFields -> SumTypeFields -> SumTypeFields
min :: SumTypeFields -> SumTypeFields -> SumTypeFields
Ord)

isNamed :: SumTypeFields -> Bool
isNamed :: SumTypeFields -> Bool
isNamed SumTypeFields
s =
    case SumTypeFields
s of
      Named [(String, EType)]
_ -> Bool
True
      SumTypeFields
_       -> Bool
False

isEmpty :: SumTypeFields -> Bool
isEmpty :: SumTypeFields -> Bool
isEmpty (Anonymous []) = Bool
True
isEmpty (Named [])     = Bool
True
isEmpty SumTypeFields
_              = Bool
False

data SumTypeConstructor
    = STC
    { SumTypeConstructor -> String
_stcName    :: String
    , SumTypeConstructor -> String
_stcEncoded :: String
    , SumTypeConstructor -> SumTypeFields
_stcFields  :: SumTypeFields
    } deriving (Int -> SumTypeConstructor -> ShowS
[SumTypeConstructor] -> ShowS
SumTypeConstructor -> String
(Int -> SumTypeConstructor -> ShowS)
-> (SumTypeConstructor -> String)
-> ([SumTypeConstructor] -> ShowS)
-> Show SumTypeConstructor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SumTypeConstructor -> ShowS
showsPrec :: Int -> SumTypeConstructor -> ShowS
$cshow :: SumTypeConstructor -> String
show :: SumTypeConstructor -> String
$cshowList :: [SumTypeConstructor] -> ShowS
showList :: [SumTypeConstructor] -> ShowS
Show, SumTypeConstructor -> SumTypeConstructor -> Bool
(SumTypeConstructor -> SumTypeConstructor -> Bool)
-> (SumTypeConstructor -> SumTypeConstructor -> Bool)
-> Eq SumTypeConstructor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SumTypeConstructor -> SumTypeConstructor -> Bool
== :: SumTypeConstructor -> SumTypeConstructor -> Bool
$c/= :: SumTypeConstructor -> SumTypeConstructor -> Bool
/= :: SumTypeConstructor -> SumTypeConstructor -> Bool
Eq, Eq SumTypeConstructor
Eq SumTypeConstructor =>
(SumTypeConstructor -> SumTypeConstructor -> Ordering)
-> (SumTypeConstructor -> SumTypeConstructor -> Bool)
-> (SumTypeConstructor -> SumTypeConstructor -> Bool)
-> (SumTypeConstructor -> SumTypeConstructor -> Bool)
-> (SumTypeConstructor -> SumTypeConstructor -> Bool)
-> (SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor)
-> (SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor)
-> Ord SumTypeConstructor
SumTypeConstructor -> SumTypeConstructor -> Bool
SumTypeConstructor -> SumTypeConstructor -> Ordering
SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SumTypeConstructor -> SumTypeConstructor -> Ordering
compare :: SumTypeConstructor -> SumTypeConstructor -> Ordering
$c< :: SumTypeConstructor -> SumTypeConstructor -> Bool
< :: SumTypeConstructor -> SumTypeConstructor -> Bool
$c<= :: SumTypeConstructor -> SumTypeConstructor -> Bool
<= :: SumTypeConstructor -> SumTypeConstructor -> Bool
$c> :: SumTypeConstructor -> SumTypeConstructor -> Bool
> :: SumTypeConstructor -> SumTypeConstructor -> Bool
$c>= :: SumTypeConstructor -> SumTypeConstructor -> Bool
>= :: SumTypeConstructor -> SumTypeConstructor -> Bool
$cmax :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
max :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
$cmin :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
min :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
Ord)

data ESum
    = ESum
    { ESum -> ETypeName
es_name          :: ETypeName
    , ESum -> [SumTypeConstructor]
es_constructors  :: [SumTypeConstructor]
    , ESum -> SumEncoding'
es_type          :: SumEncoding'
    , ESum -> Bool
es_omit_null     :: Bool
    , ESum -> Bool
es_unary_strings :: Bool
    } deriving (Int -> ESum -> ShowS
[ESum] -> ShowS
ESum -> String
(Int -> ESum -> ShowS)
-> (ESum -> String) -> ([ESum] -> ShowS) -> Show ESum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ESum -> ShowS
showsPrec :: Int -> ESum -> ShowS
$cshow :: ESum -> String
show :: ESum -> String
$cshowList :: [ESum] -> ShowS
showList :: [ESum] -> ShowS
Show, ESum -> ESum -> Bool
(ESum -> ESum -> Bool) -> (ESum -> ESum -> Bool) -> Eq ESum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ESum -> ESum -> Bool
== :: ESum -> ESum -> Bool
$c/= :: ESum -> ESum -> Bool
/= :: ESum -> ESum -> Bool
Eq, Eq ESum
Eq ESum =>
(ESum -> ESum -> Ordering)
-> (ESum -> ESum -> Bool)
-> (ESum -> ESum -> Bool)
-> (ESum -> ESum -> Bool)
-> (ESum -> ESum -> Bool)
-> (ESum -> ESum -> ESum)
-> (ESum -> ESum -> ESum)
-> Ord ESum
ESum -> ESum -> Bool
ESum -> ESum -> Ordering
ESum -> ESum -> ESum
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ESum -> ESum -> Ordering
compare :: ESum -> ESum -> Ordering
$c< :: ESum -> ESum -> Bool
< :: ESum -> ESum -> Bool
$c<= :: ESum -> ESum -> Bool
<= :: ESum -> ESum -> Bool
$c> :: ESum -> ESum -> Bool
> :: ESum -> ESum -> Bool
$c>= :: ESum -> ESum -> Bool
>= :: ESum -> ESum -> Bool
$cmax :: ESum -> ESum -> ESum
max :: ESum -> ESum -> ESum
$cmin :: ESum -> ESum -> ESum
min :: ESum -> ESum -> ESum
Ord)

-- | Transforms tuple types in a list of types. Otherwise returns
-- a singleton list with the original type.
unpackTupleType :: EType -> [EType]
unpackTupleType :: EType -> [EType]
unpackTupleType EType
et = [EType] -> Maybe [EType] -> [EType]
forall a. a -> Maybe a -> a
fromMaybe [EType
et] (EType -> Maybe [EType]
extract EType
et)
    where
        extract :: EType -> Maybe [EType]
        extract :: EType -> Maybe [EType]
extract EType
ty = case EType
ty of
                         ETyTuple Int
0 -> [EType] -> Maybe [EType]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return []
                         ETyApp (ETyTuple Int
_) EType
t -> [EType] -> Maybe [EType]
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return [EType
t]
                         ETyApp app :: EType
app@(ETyApp EType
_ EType
_) EType
t -> ([EType] -> [EType]) -> Maybe [EType] -> Maybe [EType]
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([EType] -> [EType] -> [EType]
forall a. [a] -> [a] -> [a]
++ [EType
t]) (EType -> Maybe [EType]
extract EType
app)
                         EType
_ -> Maybe [EType]
forall a. Maybe a
Nothing

unpackToplevelConstr :: EType -> [EType]
unpackToplevelConstr :: EType -> [EType]
unpackToplevelConstr EType
t =
    [EType] -> [EType]
forall a. [a] -> [a]
reverse ([EType] -> [EType]) -> [EType] -> [EType]
forall a b. (a -> b) -> a -> b
$
    ((Maybe EType -> Maybe (EType, Maybe EType))
 -> Maybe EType -> [EType])
-> Maybe EType
-> (Maybe EType -> Maybe (EType, Maybe EType))
-> [EType]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Maybe EType -> Maybe (EType, Maybe EType))
-> Maybe EType -> [EType]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (EType -> Maybe EType
forall a. a -> Maybe a
Just EType
t) ((Maybe EType -> Maybe (EType, Maybe EType)) -> [EType])
-> (Maybe EType -> Maybe (EType, Maybe EType)) -> [EType]
forall a b. (a -> b) -> a -> b
$ \Maybe EType
mT ->
        case Maybe EType
mT of
          Maybe EType
Nothing -> Maybe (EType, Maybe EType)
forall a. Maybe a
Nothing
          Just EType
t' ->
              case EType
t' of
                ETyApp EType
l EType
r ->
                    (EType, Maybe EType) -> Maybe (EType, Maybe EType)
forall a. a -> Maybe a
Just (EType
r, EType -> Maybe EType
forall a. a -> Maybe a
Just EType
l)
                EType
_ ->
                    (EType, Maybe EType) -> Maybe (EType, Maybe EType)
forall a. a -> Maybe a
Just (EType
t', Maybe EType
forall a. Maybe a
Nothing)

class IsElmDefinition a where
    compileElmDef :: Proxy a -> ETypeDef

newtype SumEncoding' = SumEncoding' SumEncoding

instance Show SumEncoding' where
    show :: SumEncoding' -> String
show (SumEncoding' SumEncoding
se) = case SumEncoding
se of
                                 TaggedObject String
n String
f -> String
"TaggedObject " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
n String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
f
                                 SumEncoding
ObjectWithSingleField -> String
"ObjectWithSingleField"
                                 SumEncoding
TwoElemArray -> String
"TwoElemArray"
                                 SumEncoding
UntaggedValue -> String
"UntaggedValue"

instance Eq SumEncoding' where
    SumEncoding' SumEncoding
a == :: SumEncoding' -> SumEncoding' -> Bool
== SumEncoding' SumEncoding
b = case (SumEncoding
a,SumEncoding
b) of
                                           (TaggedObject String
a1 String
b1, TaggedObject String
a2 String
b2) -> String
a1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
a2 Bool -> Bool -> Bool
&& String
b1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
b2
                                           (SumEncoding
ObjectWithSingleField, SumEncoding
ObjectWithSingleField) -> Bool
True
                                           (SumEncoding
TwoElemArray, SumEncoding
TwoElemArray) -> Bool
True
                                           (SumEncoding
UntaggedValue, SumEncoding
UntaggedValue) -> Bool
True
                                           (SumEncoding, SumEncoding)
_ -> Bool
False

instance Ord SumEncoding' where
    compare :: SumEncoding' -> SumEncoding' -> Ordering
compare (SumEncoding' SumEncoding
a) (SumEncoding' SumEncoding
b) =
       case (SumEncoding
a,SumEncoding
b) of
          (TaggedObject String
a1 String
b1, TaggedObject String
a2 String
b2) -> String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
a1 String
a2 Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> String -> String -> Ordering
forall a. Ord a => a -> a -> Ordering
compare String
b1 String
b2
          (SumEncoding
ObjectWithSingleField, SumEncoding
ObjectWithSingleField) -> Ordering
EQ
          (SumEncoding
TwoElemArray, SumEncoding
TwoElemArray) -> Ordering
EQ
          (SumEncoding
UntaggedValue, SumEncoding
UntaggedValue) -> Ordering
EQ
          (TaggedObject String
_ String
_, SumEncoding
_) -> Ordering
LT
          (SumEncoding
_, TaggedObject String
_ String
_) -> Ordering
GT
          (SumEncoding
ObjectWithSingleField, SumEncoding
_) -> Ordering
LT
          (SumEncoding
_, SumEncoding
ObjectWithSingleField) -> Ordering
GT
          (SumEncoding
UntaggedValue, SumEncoding
_) -> Ordering
LT
          (SumEncoding
_, SumEncoding
UntaggedValue) -> Ordering
GT

defSumEncoding :: SumEncoding'
defSumEncoding :: SumEncoding'
defSumEncoding = SumEncoding -> SumEncoding'
SumEncoding' SumEncoding
ObjectWithSingleField

-- | Get an @elm-bridge@ type representation for a Haskell type.
-- This can be used to render the type declaration via
-- 'Elm.TyRender.ElmRenderable' or the the JSON serializer/parser names via
-- 'Elm.Json.jsonSerForType' and 'Elm.Json.jsonParserForType'.
toElmType :: (Typeable a) => Proxy a -> EType
toElmType :: forall a. Typeable a => Proxy a -> EType
toElmType Proxy a
ty = TypeRep -> EType
toElmType' (TypeRep -> EType) -> TypeRep -> EType
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep Proxy a
ty
    where
        toElmType' :: TypeRep -> EType
        toElmType' :: TypeRep -> EType
toElmType' TypeRep
rep
            -- String (A list of Char)
          | TyCon
con TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep -> TyCon
typeRepTyCon (Proxy [] -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy []
forall {k} (t :: k). Proxy t
Proxy :: Proxy [])) Bool -> Bool -> Bool
&&
            [TypeRep]
args [TypeRep] -> [TypeRep] -> Bool
forall a. Eq a => a -> a -> Bool
== [Proxy Char -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy Char
forall {k} (t :: k). Proxy t
Proxy :: Proxy Char)]  = ETCon -> EType
ETyCon (String -> ETCon
ETCon String
"String")
            -- List is special because the constructor name is [] in Haskell and List in elm
          | TyCon
con TyCon -> TyCon -> Bool
forall a. Eq a => a -> a -> Bool
== TypeRep -> TyCon
typeRepTyCon (Proxy [] -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy []
forall {k} (t :: k). Proxy t
Proxy :: Proxy [])) = EType -> EType -> EType
ETyApp (ETCon -> EType
ETyCon (ETCon -> EType) -> ETCon -> EType
forall a b. (a -> b) -> a -> b
$ String -> ETCon
ETCon String
"List") (TypeRep -> EType
toElmType' ([TypeRep] -> TypeRep
forall a. HasCallStack => [a] -> a
head [TypeRep]
args))
            -- The unit type '()' is a 0-ary tuple.
          | String -> Bool
isTuple (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConName TyCon
con = (EType -> EType -> EType) -> EType -> [EType] -> EType
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl EType -> EType -> EType
ETyApp (Int -> EType
ETyTuple (Int -> EType) -> Int -> EType
forall a b. (a -> b) -> a -> b
$ [TypeRep] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeRep]
args) ([EType] -> EType) -> [EType] -> EType
forall a b. (a -> b) -> a -> b
$ (TypeRep -> EType) -> [TypeRep] -> [EType]
forall a b. (a -> b) -> [a] -> [b]
map TypeRep -> EType
toElmType' [TypeRep]
args
          | Bool
otherwise = TyCon -> [TypeRep] -> EType
typeApplication TyCon
con [TypeRep]
args
            where
                (TyCon
con, [TypeRep]
args) = TypeRep -> (TyCon, [TypeRep])
splitTyConApp TypeRep
rep

        isTuple :: String -> Bool
        isTuple :: String -> Bool
isTuple String
"Unit" = Bool
True
        isTuple (Char
'T': Char
'u' : Char
'p': Char
'l' : Char
'e' : String
ds) = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
Char.isDigit String
ds
        isTuple (Char
'(':String
xs) = String -> Bool
isTuple' (String -> Bool) -> String -> Bool
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
xs -- base <= 4.17
          where
            isTuple' :: String -> Bool
            isTuple' :: String -> Bool
isTuple' (Char
')':String
xs') = (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
',') String
xs'
            isTuple' String
_         = Bool
False
        isTuple String
_ = Bool
False

        typeApplication :: TyCon -> [TypeRep] -> EType
        typeApplication :: TyCon -> [TypeRep] -> EType
typeApplication TyCon
con [TypeRep]
args = [TypeRep] -> EType
typeApplication' ([TypeRep] -> [TypeRep]
forall a. [a] -> [a]
reverse [TypeRep]
args)
          where
            typeApplication' :: [TypeRep] -> EType
typeApplication' [] = ETCon -> EType
ETyCon (String -> ETCon
ETCon (String -> ETCon) -> String -> ETCon
forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConName TyCon
con)
            typeApplication' [TypeRep
x] =
              EType -> EType -> EType
ETyApp
                (ETCon -> EType
ETyCon (ETCon -> EType) -> ETCon -> EType
forall a b. (a -> b) -> a -> b
$ String -> ETCon
ETCon (String -> ETCon) -> String -> ETCon
forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConName TyCon
con)
                (TypeRep -> EType
toElmType' TypeRep
x)
            typeApplication' (TypeRep
x:[TypeRep]
xs) =
              EType -> EType -> EType
ETyApp ([TypeRep] -> EType
typeApplication' [TypeRep]
xs) (TypeRep -> EType
toElmType' TypeRep
x)