module Nix.Type.Type where

import qualified Data.HashMap.Lazy             as M
import           Data.Text                      ( Text )
import           Nix.Utils

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

data Type
  = TVar TVar                -- type variable
  | TCon String              -- known type
  | TSet Bool (AttrSet Type) -- heterogeneous map, bool if variadic
  | TList [Type]             -- heterogeneous list
  | (:~>) Type Type          -- type -> type
  | TMany [Type]             -- variant type
  deriving (Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Type] -> ShowS
$cshowList :: [Type] -> ShowS
show :: Type -> String
$cshow :: Type -> String
showsPrec :: Int -> Type -> ShowS
$cshowsPrec :: Int -> Type -> ShowS
Show, Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c== :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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 :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmax :: Type -> Type -> Type
>= :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c< :: Type -> Type -> Bool
compare :: Type -> Type -> Ordering
$ccompare :: Type -> Type -> Ordering
$cp1Ord :: Eq Type
Ord)

data Scheme = Forall [TVar] Type -- forall a b. a -> b
  deriving (Int -> Scheme -> ShowS
[Scheme] -> ShowS
Scheme -> String
(Int -> Scheme -> ShowS)
-> (Scheme -> String) -> ([Scheme] -> ShowS) -> Show Scheme
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Scheme] -> ShowS
$cshowList :: [Scheme] -> ShowS
show :: Scheme -> String
$cshow :: Scheme -> String
showsPrec :: Int -> Scheme -> ShowS
$cshowsPrec :: Int -> Scheme -> ShowS
Show, Scheme -> Scheme -> Bool
(Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool) -> Eq Scheme
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scheme -> Scheme -> Bool
$c/= :: Scheme -> Scheme -> Bool
== :: Scheme -> Scheme -> Bool
$c== :: Scheme -> Scheme -> Bool
Eq, Eq Scheme
Eq Scheme =>
(Scheme -> Scheme -> Ordering)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Bool)
-> (Scheme -> Scheme -> Scheme)
-> (Scheme -> Scheme -> Scheme)
-> Ord Scheme
Scheme -> Scheme -> Bool
Scheme -> Scheme -> Ordering
Scheme -> Scheme -> Scheme
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 :: Scheme -> Scheme -> Scheme
$cmin :: Scheme -> Scheme -> Scheme
max :: Scheme -> Scheme -> Scheme
$cmax :: Scheme -> Scheme -> Scheme
>= :: Scheme -> Scheme -> Bool
$c>= :: Scheme -> Scheme -> Bool
> :: Scheme -> Scheme -> Bool
$c> :: Scheme -> Scheme -> Bool
<= :: Scheme -> Scheme -> Bool
$c<= :: Scheme -> Scheme -> Bool
< :: Scheme -> Scheme -> Bool
$c< :: Scheme -> Scheme -> Bool
compare :: Scheme -> Scheme -> Ordering
$ccompare :: Scheme -> Scheme -> Ordering
$cp1Ord :: Eq Scheme
Ord)

-- This models a set that unifies with any other set.
typeSet :: Type
typeSet :: Type
typeSet = Bool -> AttrSet Type -> Type
TSet Bool
True AttrSet Type
forall k v. HashMap k v
M.empty

typeList :: Type
typeList :: Type
typeList = [Type] -> Type
TList []

infixr 1 :~>

typeFun :: [Type] -> Type
typeFun :: [Type] -> Type
typeFun = (Type -> Type -> Type) -> [Type] -> Type
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 Type -> Type -> Type
(:~>)

typeInt, typeFloat, typeBool, typeString, typePath, typeNull :: Type
typeInt :: Type
typeInt = String -> Type
TCon "integer"
typeFloat :: Type
typeFloat = String -> Type
TCon "float"
typeBool :: Type
typeBool = String -> Type
TCon "boolean"
typeString :: Type
typeString = String -> Type
TCon "string"
typePath :: Type
typePath = String -> Type
TCon "path"
typeNull :: Type
typeNull = String -> Type
TCon "null"

type Name = Text