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

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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ETypeDef] -> ShowS
$cshowList :: [ETypeDef] -> ShowS
show :: ETypeDef -> String
$cshow :: ETypeDef -> String
showsPrec :: Int -> ETypeDef -> ShowS
$cshowsPrec :: Int -> ETypeDef -> ShowS
Show, ETypeDef -> ETypeDef -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ETypeDef -> ETypeDef -> Bool
$c/= :: ETypeDef -> ETypeDef -> Bool
== :: ETypeDef -> ETypeDef -> Bool
$c== :: 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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EType] -> ShowS
$cshowList :: [EType] -> ShowS
show :: EType -> String
$cshow :: EType -> String
showsPrec :: Int -> EType -> ShowS
$cshowsPrec :: Int -> EType -> ShowS
Show, EType -> EType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EType -> EType -> Bool
$c/= :: EType -> EType -> Bool
== :: EType -> EType -> Bool
$c== :: EType -> EType -> Bool
Eq, Eq 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
min :: EType -> EType -> EType
$cmin :: EType -> EType -> EType
max :: EType -> EType -> EType
$cmax :: EType -> EType -> EType
>= :: EType -> EType -> Bool
$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
compare :: EType -> EType -> Ordering
$ccompare :: EType -> EType -> Ordering
Ord)

{-| Type constructor:

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

{-| Type variable:

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

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

data SumTypeFields
    = Anonymous [EType]
    | Named [(String, EType)]
    deriving (Int -> SumTypeFields -> ShowS
[SumTypeFields] -> ShowS
SumTypeFields -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumTypeFields] -> ShowS
$cshowList :: [SumTypeFields] -> ShowS
show :: SumTypeFields -> String
$cshow :: SumTypeFields -> String
showsPrec :: Int -> SumTypeFields -> ShowS
$cshowsPrec :: Int -> SumTypeFields -> ShowS
Show, SumTypeFields -> SumTypeFields -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumTypeFields -> SumTypeFields -> Bool
$c/= :: SumTypeFields -> SumTypeFields -> Bool
== :: SumTypeFields -> SumTypeFields -> Bool
$c== :: SumTypeFields -> SumTypeFields -> Bool
Eq, Eq 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
min :: SumTypeFields -> SumTypeFields -> SumTypeFields
$cmin :: SumTypeFields -> SumTypeFields -> SumTypeFields
max :: SumTypeFields -> SumTypeFields -> SumTypeFields
$cmax :: SumTypeFields -> SumTypeFields -> SumTypeFields
>= :: SumTypeFields -> SumTypeFields -> Bool
$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
compare :: SumTypeFields -> SumTypeFields -> Ordering
$ccompare :: SumTypeFields -> SumTypeFields -> Ordering
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SumTypeConstructor] -> ShowS
$cshowList :: [SumTypeConstructor] -> ShowS
show :: SumTypeConstructor -> String
$cshow :: SumTypeConstructor -> String
showsPrec :: Int -> SumTypeConstructor -> ShowS
$cshowsPrec :: Int -> SumTypeConstructor -> ShowS
Show, SumTypeConstructor -> SumTypeConstructor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SumTypeConstructor -> SumTypeConstructor -> Bool
$c/= :: SumTypeConstructor -> SumTypeConstructor -> Bool
== :: SumTypeConstructor -> SumTypeConstructor -> Bool
$c== :: SumTypeConstructor -> SumTypeConstructor -> Bool
Eq, Eq 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
min :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
$cmin :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
max :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
$cmax :: SumTypeConstructor -> SumTypeConstructor -> SumTypeConstructor
>= :: SumTypeConstructor -> SumTypeConstructor -> Bool
$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
compare :: SumTypeConstructor -> SumTypeConstructor -> Ordering
$ccompare :: SumTypeConstructor -> SumTypeConstructor -> Ordering
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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ESum] -> ShowS
$cshowList :: [ESum] -> ShowS
show :: ESum -> String
$cshow :: ESum -> String
showsPrec :: Int -> ESum -> ShowS
$cshowsPrec :: Int -> ESum -> ShowS
Show, ESum -> ESum -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ESum -> ESum -> Bool
$c/= :: ESum -> ESum -> Bool
== :: ESum -> ESum -> Bool
$c== :: ESum -> ESum -> Bool
Eq, Eq 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
min :: ESum -> ESum -> ESum
$cmin :: ESum -> ESum -> ESum
max :: ESum -> ESum -> ESum
$cmax :: ESum -> ESum -> ESum
>= :: ESum -> ESum -> Bool
$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
compare :: ESum -> ESum -> Ordering
$ccompare :: ESum -> ESum -> Ordering
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 = 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 -> forall (m :: * -> *) a. Monad m => a -> m a
return []
                         ETyApp (ETyTuple Int
_) EType
t -> forall (m :: * -> *) a. Monad m => a -> m a
return [EType
t]
                         ETyApp app :: EType
app@(ETyApp EType
_ EType
_) EType
t -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. [a] -> [a] -> [a]
++ [EType
t]) (EType -> Maybe [EType]
extract EType
app)
                         EType
_ -> forall a. Maybe a
Nothing

unpackToplevelConstr :: EType -> [EType]
unpackToplevelConstr :: EType -> [EType]
unpackToplevelConstr EType
t =
    forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$
    forall a b c. (a -> b -> c) -> b -> a -> c
flip forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr (forall a. a -> Maybe a
Just EType
t) forall a b. (a -> b) -> a -> b
$ \Maybe EType
mT ->
        case Maybe EType
mT of
          Maybe EType
Nothing -> forall a. Maybe a
Nothing
          Just EType
t' ->
              case EType
t' of
                ETyApp EType
l EType
r ->
                    forall a. a -> Maybe a
Just (EType
r, forall a. a -> Maybe a
Just EType
l)
                EType
_ ->
                    forall a. a -> Maybe a
Just (EType
t', 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 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
n forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ 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 forall a. Eq a => a -> a -> Bool
== String
a2 Bool -> Bool -> Bool
&& String
b1 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) -> forall a. Ord a => a -> a -> Ordering
compare String
a1 String
a2 forall a. Semigroup a => a -> a -> a
<> 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' forall a b. (a -> b) -> a -> b
$ 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 forall a. Eq a => a -> a -> Bool
== TypeRep -> TyCon
typeRepTyCon (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy [])) Bool -> Bool -> Bool
&&
            [TypeRep]
args forall a. Eq a => a -> a -> Bool
== [forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (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 forall a. Eq a => a -> a -> Bool
== TypeRep -> TyCon
typeRepTyCon (forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (forall {k} (t :: k). Proxy t
Proxy :: Proxy [])) = EType -> EType -> EType
ETyApp (ETCon -> EType
ETyCon forall a b. (a -> b) -> a -> b
$ String -> ETCon
ETCon String
"List") (TypeRep -> EType
toElmType' (forall a. [a] -> a
head [TypeRep]
args))
            -- The unit type '()' is a 0-ary tuple.
          | String -> Bool
isTuple forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConName TyCon
con = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl EType -> EType -> EType
ETyApp (Int -> EType
ETyTuple forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length [TypeRep]
args) forall a b. (a -> b) -> a -> b
$ 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 (Char
'(':String
xs) = String -> Bool
isTuple' forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse String
xs
          where
            isTuple' :: String -> Bool
            isTuple' :: String -> Bool
isTuple' (Char
')':String
xs') = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (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' (forall a. [a] -> [a]
reverse [TypeRep]
args)
          where
            typeApplication' :: [TypeRep] -> EType
typeApplication' [] = ETCon -> EType
ETyCon (String -> ETCon
ETCon forall a b. (a -> b) -> a -> b
$ TyCon -> String
tyConName TyCon
con)
            typeApplication' [TypeRep
x] =
              EType -> EType -> EType
ETyApp
                (ETCon -> EType
ETyCon forall a b. (a -> b) -> a -> b
$ String -> ETCon
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)