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)
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)
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)
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)
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)
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)
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
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
| 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")
| 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))
| 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)