-- | Extraction and unification of AutoType's @Type@ from Aeson @Value@.
module JsonToType.Extract(valueSize, valueTypeSize,
                                   valueDepth, Dict(..),
                                   Type(..), emptyType,
                                   extractType, unifyTypes,
                                   typeCheck) where

import           Control.Arrow ((&&&))
import           Control.Exception               (assert)
import           Data.Aeson.Key                  (toText)
import           Data.Aeson.KeyMap               (toHashMap)
import           JsonToType.Type
import qualified Data.Graph          as Graph
import qualified Data.HashMap.Strict      as Map
import           Data.HashMap.Strict             (HashMap, mapKeys)
import qualified Data.Set                 as Set
import qualified Data.Vector              as V
import           Data.Aeson
import           Data.Text                       (Text)
import           Data.Set                        (Set )
import           Data.List                       (foldl1')
import           Data.Scientific                 (isInteger)

--import           Debug.Trace

-- Convert from Aeson's @KeyMap v@ type to Autotype's @HashMap Text v@ type.
toHashMapTxt :: KeyMap v -> HashMap Text v
toHashMapTxt = (Key -> Text) -> HashMap Key v -> HashMap Text v
forall k2 k1 v.
(Eq k2, Hashable k2) =>
(k1 -> k2) -> HashMap k1 v -> HashMap k2 v
mapKeys Key -> Text
toText (HashMap Key v -> HashMap Text v)
-> (KeyMap v -> HashMap Key v) -> KeyMap v -> HashMap Text v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap v -> HashMap Key v
forall v. KeyMap v -> HashMap Key v
toHashMap

-- | Compute total number of nodes (and leaves) within the value tree.
-- Each simple JavaScript type (including String) is counted as of size 1,
-- whereas both Array or object types are counted as 1+sum of the sizes
-- of their member values.
valueSize :: Value -> Int
valueSize :: Value -> Int
valueSize  Value
Null      = Int
1
valueSize (Bool   Bool
_) = Int
1
valueSize (Number Scientific
_) = Int
1
valueSize (String Text
_) = Int
1
valueSize (Array  Array
a) = (Int -> Int -> Int) -> Int -> Vector Int -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
1 (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (Value -> Int) -> Array -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Int
valueSize Array
a
valueSize (Object Object
o) = (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int)
-> (HashMap Text Value -> Int) -> HashMap Text Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> (HashMap Text Value -> [Int]) -> HashMap Text Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Int) -> [Value] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Int
valueSize ([Value] -> [Int])
-> (HashMap Text Value -> [Value]) -> HashMap Text Value -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> [Value]
forall k v. HashMap k v -> [v]
Map.elems (HashMap Text Value -> Int) -> HashMap Text Value -> Int
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Text Value
forall {v}. KeyMap v -> HashMap Text v
toHashMapTxt Object
o

-- | Compute total size of the type of the @Value@.
-- For:
-- * simple types it is always 1,
-- * for arrays it is just 1+_maximum_ size of the (single) element type,
-- * for objects it is _sum_ of the sizes of fields (since each field type
--   is assumed to be different.)
valueTypeSize :: Value -> Int
valueTypeSize :: Value -> Int
valueTypeSize  Value
Null      = Int
1
valueTypeSize (Bool   Bool
_) = Int
1
valueTypeSize (Number Scientific
_) = Int
1
valueTypeSize (String Text
_) = Int
1
valueTypeSize (Array  Array
a) = (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Vector Int -> Int) -> Vector Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> Vector Int -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (Value -> Int) -> Array -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Int
valueTypeSize Array
a
valueTypeSize (Object Object
o) = (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int)
-> (HashMap Text Value -> Int) -> HashMap Text Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int)
-> (HashMap Text Value -> [Int]) -> HashMap Text Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Int) -> [Value] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Int
valueTypeSize ([Value] -> [Int])
-> (HashMap Text Value -> [Value]) -> HashMap Text Value -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> [Value]
forall k v. HashMap k v -> [v]
Map.elems (HashMap Text Value -> Int) -> HashMap Text Value -> Int
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Text Value
forall {v}. KeyMap v -> HashMap Text v
toHashMapTxt Object
o

-- | Compute total depth of the value.
-- For:
-- * simple types it is 1
-- * for either Array or Object, it is 1 + maximum of depths of their members
valueDepth :: Value -> Int
valueDepth :: Value -> Int
valueDepth  Value
Null      = Int
1
valueDepth (Bool   Bool
_) = Int
1
valueDepth (Number Scientific
_) = Int
1
valueDepth (String Text
_) = Int
1
valueDepth (Array  Array
a) = (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Vector Int -> Int) -> Vector Int -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Int -> Int) -> Int -> Vector Int -> Int
forall a b. (a -> b -> a) -> a -> Vector b -> a
V.foldl' Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Vector Int -> Int) -> Vector Int -> Int
forall a b. (a -> b) -> a -> b
$ (Value -> Int) -> Array -> Vector Int
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Int
valueDepth Array
a
valueDepth (Object Object
o) = (Int
1Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int)
-> (HashMap Text Value -> Int) -> HashMap Text Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Int] -> Int
forall a. Ord a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum ([Int] -> Int)
-> (HashMap Text Value -> [Int]) -> HashMap Text Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
0Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:) ([Int] -> [Int])
-> (HashMap Text Value -> [Int]) -> HashMap Text Value -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Int) -> [Value] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map Value -> Int
valueDepth ([Value] -> [Int])
-> (HashMap Text Value -> [Value]) -> HashMap Text Value -> [Int]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text Value -> [Value]
forall k v. HashMap k v -> [v]
Map.elems (HashMap Text Value -> Int) -> HashMap Text Value -> Int
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Text Value
forall {v}. KeyMap v -> HashMap Text v
toHashMapTxt Object
o

-- | Check if a number is integral, or floating point
-- | Extract @Type@ from the JSON @Value@.
-- Unifying types of array elements, if necessary.
extractType                            :: Value -> Type
extractType :: Value -> Type
extractType (Object Object
o)                  = Dict -> Type
TObj (Dict -> Type) -> Dict -> Type
forall a b. (a -> b) -> a -> b
$ Map Text Type -> Dict
Dict (Map Text Type -> Dict) -> Map Text Type -> Dict
forall a b. (a -> b) -> a -> b
$ (Value -> Type) -> HashMap Text Value -> Map Text Type
forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
Map.map Value -> Type
extractType (HashMap Text Value -> Map Text Type)
-> HashMap Text Value -> Map Text Type
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Text Value
forall {v}. KeyMap v -> HashMap Text v
toHashMapTxt Object
o
extractType  Value
Null                       = Type
TNull
extractType (Bool   Bool
_)                  = Type
TBool
extractType (Number Scientific
n) | Scientific -> Bool
isInteger Scientific
n    = Type
TInt
extractType (Number Scientific
_)                  = Type
TDouble
extractType (String Text
_)                  = Type
TString
extractType (Array  Array
a) | Array -> Bool
forall a. Vector a -> Bool
V.null Array
a       = Type -> Type
TArray   Type
emptyType
extractType (Array  Array
a)                  = Type -> Type
TArray (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ (Type -> Type -> Type) -> Vector Type -> Type
forall a. (a -> a -> a) -> Vector a -> a
V.foldl1' Type -> Type -> Type
unifyTypes (Vector Type -> Type) -> Vector Type -> Type
forall a b. (a -> b) -> a -> b
$ Vector Type -> Vector Type
forall {a}. a -> a
traceShow (Vector Type -> Vector Type) -> Vector Type -> Vector Type
forall a b. (a -> b) -> a -> b
$ (Value -> Type) -> Array -> Vector Type
forall a b. (a -> b) -> Vector a -> Vector b
V.map Value -> Type
extractType Array
a
  where
    --traceShow a = trace (show a) a
    traceShow :: a -> a
traceShow = a -> a
forall {a}. a -> a
id

-- | Type check the value with the derived type.
typeCheck :: Value -> Type -> Bool
typeCheck :: Value -> Type -> Bool
typeCheck  Value
Null          Type
TNull            = Bool
True
typeCheck  Value
v            (TUnion  Set Type
u)       = Value -> Type -> Bool
typeCheck Value
v (Type -> Bool) -> [Type] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`any` Set Type -> [Type]
forall a. Set a -> [a]
Set.toList Set Type
u
typeCheck (Bool   Bool
_)     Type
TBool            = Bool
True
typeCheck (String Text
_)     Type
TString          = Bool
True
typeCheck (Number Scientific
n)     Type
TInt             = Scientific -> Bool
isInteger Scientific
n
typeCheck (Number Scientific
_)     Type
TDouble          = Bool
True
typeCheck (Array  Array
elts) (TArray  Type
eltType) = (Value -> Type -> Bool
`typeCheck` Type
eltType) (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`all` Array -> [Value]
forall a. Vector a -> [a]
V.toList Array
elts
typeCheck (Object Object
d)    (TObj    Dict
e      ) = Text -> Bool
typeCheckKey (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
`all` [Text]
keysOfBoth
  where
    typeCheckKey :: Text -> Bool
typeCheckKey Text
k = Text -> HashMap Text Value -> Value
getValue Text
k (Object -> HashMap Text Value
forall {v}. KeyMap v -> HashMap Text v
toHashMapTxt Object
d) Value -> Type -> Bool
`typeCheck` Text -> Dict -> Type
get Text
k Dict
e
    getValue   :: Text -> HashMap Text Value -> Value
    getValue :: Text -> HashMap Text Value -> Value
getValue    = Value -> Text -> HashMap Text Value -> Value
forall k v. (Eq k, Hashable k) => v -> k -> HashMap k v -> v
Map.lookupDefault Value
Null
    keysOfBoth :: [Text]
    keysOfBoth :: [Text]
keysOfBoth  =  Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Set Text -> [Text]) -> Set Text -> [Text]
forall a b. (a -> b) -> a -> b
$ [Text] -> Set Text
forall a. Ord a => [a] -> Set a
Set.fromList (HashMap Text Value -> [Text]
forall k v. HashMap k v -> [k]
Map.keys (HashMap Text Value -> [Text]) -> HashMap Text Value -> [Text]
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Text Value
forall {v}. KeyMap v -> HashMap Text v
toHashMapTxt Object
d) Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Dict -> Set Text
keys Dict
e
typeCheck         Value
_     (TLabel  Text
_      ) = [Char] -> Bool
forall a. HasCallStack => [Char] -> a
error [Char]
"Cannot typecheck labels without environment!"
typeCheck   {-a-} Value
_      Type
_ {-b-}          = {-trace msg $-} Bool
False
  where
    -- msg = "Mismatch: " ++ show a ++ " :: " ++ show b

allKeys :: Dict -> Dict -> [Text]
Dict
d allKeys :: Dict -> Dict -> [Text]
`allKeys` Dict
e = Set Text -> [Text]
forall a. Set a -> [a]
Set.toList (Dict -> Set Text
keys Dict
d Set Text -> Set Text -> Set Text
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Dict -> Set Text
keys Dict
e)

-- | Standard unification procedure on @Type@s,
-- with inclusion of @Type@ unions.
unifyTypes :: Type -> Type -> Type
unifyTypes :: Type -> Type -> Type
unifyTypes  Type
TBool      Type
TBool     = Type
TBool
unifyTypes  Type
TInt       Type
TInt      = Type
TInt
unifyTypes  Type
TDouble    Type
TInt      = Type
TDouble
unifyTypes  Type
TInt       Type
TDouble   = Type
TDouble
unifyTypes  Type
TDouble    Type
TDouble   = Type
TDouble
unifyTypes  Type
TString    Type
TString   = Type
TString
unifyTypes  Type
TNull      Type
TNull     = Type
TNull
unifyTypes (TObj   Dict
d) (TObj   Dict
e) = Dict -> Type
TObj Dict
newDict
  where
    newDict :: Dict
    newDict :: Dict
newDict = Map Text Type -> Dict
Dict (Map Text Type -> Dict) -> Map Text Type -> Dict
forall a b. (a -> b) -> a -> b
$ [(Text, Type)] -> Map Text Type
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
Map.fromList [(Text
k, Text -> Dict -> Type
get Text
k Dict
d Type -> Type -> Type
`unifyTypes`
                                        Text -> Dict -> Type
get Text
k Dict
e) | Text
k <- Dict -> Dict -> [Text]
allKeys Dict
d Dict
e ]
unifyTypes (TArray Type
u) (TArray Type
v) = Type -> Type
TArray (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ Type
u Type -> Type -> Type
`unifyTypes` Type
v
unifyTypes Type
t           Type
s         = Type -> Set Type
typeAsSet Type
t Set Type -> Set Type -> Type
`unifyUnion` Type -> Set Type
typeAsSet Type
s

-- | Unify sets of types (sets are union types of alternatives).
unifyUnion :: Set Type -> Set Type -> Type
unifyUnion :: Set Type -> Set Type -> Type
unifyUnion Set Type
u Set Type
v = Type -> Type
forall {a}. a -> a
assertions (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$
                   Set Type -> Type
union (Set Type -> Type) -> Set Type -> Type
forall a b. (a -> b) -> a -> b
$ Set Type
uSimple        Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
                           Set Type
vSimple        Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
                           Set Type
unifiedObjects Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
`Set.union`
                           Type -> Set Type
forall a. a -> Set a
Set.singleton Type
unifiedArray
  where
    -- We partition our types for easier unification into simple and compound
    (Set Type
uSimple, Set Type
uCompound) = (Type -> Bool) -> Set Type -> (Set Type, Set Type)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition Type -> Bool
isSimple Set Type
u
    (Set Type
vSimple, Set Type
vCompound) = (Type -> Bool) -> Set Type -> (Set Type, Set Type)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition Type -> Bool
isSimple Set Type
v
    assertions :: c -> c
assertions = Bool -> c -> c
forall a. HasCallStack => Bool -> a -> a
assert (Set Type -> Bool
forall a. Set a -> Bool
Set.null (Set Type -> Bool) -> Set Type -> Bool
forall a b. (a -> b) -> a -> b
$ (Type -> Bool) -> Set Type -> Set Type
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
isArray) Set Type
uArr) (c -> c) -> (c -> c) -> c -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
                 Bool -> c -> c
forall a. HasCallStack => Bool -> a -> a
assert (Set Type -> Bool
forall a. Set a -> Bool
Set.null (Set Type -> Bool) -> Set Type -> Bool
forall a b. (a -> b) -> a -> b
$ (Type -> Bool) -> Set Type -> Set Type
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Bool -> Bool
not (Bool -> Bool) -> (Type -> Bool) -> Type -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Bool
isArray) Set Type
vArr)
    -- then we partition compound typs into objects and arrays.
    -- Note that there should be no TUnion here, since we are inside a TUnion already.
    -- (That is reduced by @union@ smart costructor as superfluous.)
    (Set Type
uObj, Set Type
uArr)   = (Type -> Bool) -> Set Type -> (Set Type, Set Type)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition Type -> Bool
isObject Set Type
uCompound
    (Set Type
vObj, Set Type
vArr)   = (Type -> Bool) -> Set Type -> (Set Type, Set Type)
forall a. (a -> Bool) -> Set a -> (Set a, Set a)
Set.partition Type -> Bool
isObject Set Type
vCompound
    unifiedObjects :: Set Type
unifiedObjects = [Type] -> Set Type
forall a. Ord a => [a] -> Set a
Set.fromList ([Type] -> Set Type) -> [Type] -> Set Type
forall a b. (a -> b) -> a -> b
$ if [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
objects
                                       then []
                                       else [(Type -> Type -> Type) -> [Type] -> Type
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Type -> Type -> Type
unifyTypes [Type]
objects]
    objects :: [Type]
objects = Set Type -> [Type]
forall a. Set a -> [a]
Set.toList (Set Type -> [Type]) -> Set Type -> [Type]
forall a b. (a -> b) -> a -> b
$ Set Type
uObj Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Type
vObj
    arrayElts :: [Type]
    arrayElts :: [Type]
arrayElts  = (Type -> Type) -> [Type] -> [Type]
forall a b. (a -> b) -> [a] -> [b]
map (\(TArray Type
ty) -> Type
ty) ([Type] -> [Type]) -> [Type] -> [Type]
forall a b. (a -> b) -> a -> b
$
                   Set Type -> [Type]
forall a. Set a -> [a]
Set.toList (Set Type -> [Type]) -> Set Type -> [Type]
forall a b. (a -> b) -> a -> b
$
                     Set Type
uArr Set Type -> Set Type -> Set Type
forall a. Ord a => Set a -> Set a -> Set a
`Set.union` Set Type
vArr
    unifiedArray :: Type
unifiedArray = Type -> Type
TArray (Type -> Type) -> Type -> Type
forall a b. (a -> b) -> a -> b
$ if [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
arrayElts
                               then Type
emptyType
                               else (Type -> Type -> Type) -> [Type] -> Type
forall a. HasCallStack => (a -> a -> a) -> [a] -> a
foldl1' Type -> Type -> Type
unifyTypes [Type]
arrayElts

-- | Smart constructor for union types.
union ::  Set Type -> Type
union :: Set Type -> Type
union = Type -> Type
simplifyUnion (Type -> Type) -> (Set Type -> Type) -> Set Type -> Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set Type -> Type
TUnion

-- | Simplify TUnion's so there is no TUnion directly inside TUnion.
-- If there is only one element of the set, then return this single
-- element as a type.
simplifyUnion :: Type -> Type
simplifyUnion :: Type -> Type
simplifyUnion (TUnion Set Type
s) | Set Type -> Int
forall a. Set a -> Int
Set.size Set Type
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = [Type] -> Type
forall a. HasCallStack => [a] -> a
head ([Type] -> Type) -> [Type] -> Type
forall a b. (a -> b) -> a -> b
$ Set Type -> [Type]
forall a. Set a -> [a]
Set.toList Set Type
s
simplifyUnion (TUnion Set Type
s)                   = Set Type -> Type
TUnion (Set Type -> Type) -> Set Type -> Type
forall a b. (a -> b) -> a -> b
$ [Set Type] -> Set Type
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
Set.unions ([Set Type] -> Set Type) -> [Set Type] -> Set Type
forall a b. (a -> b) -> a -> b
$ (Type -> Set Type) -> [Type] -> [Set Type]
forall a b. (a -> b) -> [a] -> [b]
map Type -> Set Type
elements ([Type] -> [Set Type]) -> [Type] -> [Set Type]
forall a b. (a -> b) -> a -> b
$ Set Type -> [Type]
forall a. Set a -> [a]
Set.toList Set Type
s
  where
    elements :: Type -> Set Type
elements (TUnion Set Type
elems) = Set Type
elems
    elements Type
sing           = Type -> Set Type
forall a. a -> Set a
Set.singleton Type
sing
simplifyUnion Type
unexpected                   = [Char] -> Type
forall a. HasCallStack => [Char] -> a
error ([Char]
"simplifyUnion: unexpected argument " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Type -> [Char]
forall a. Show a => a -> [Char]
show Type
unexpected)