module Nix.Type.Env
  ( Env(..)
  , empty
  , lookup
  , remove
  , extend
  , extends
  , merge
  , mergeEnvs
  , singleton
  , keys
  , fromList
  , toList
  )
where

import           Prelude                 hiding ( lookup )

import           Nix.Type.Type

import           Data.Foldable           hiding ( toList )
import qualified Data.Map                      as Map

-------------------------------------------------------------------------------
-- Typing Environment
-------------------------------------------------------------------------------

newtype Env = TypeEnv { Env -> Map Name [Scheme]
types :: Map.Map Name [Scheme] }
  deriving (Env -> Env -> Bool
(Env -> Env -> Bool) -> (Env -> Env -> Bool) -> Eq Env
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Env -> Env -> Bool
$c/= :: Env -> Env -> Bool
== :: Env -> Env -> Bool
$c== :: Env -> Env -> Bool
Eq, Int -> Env -> ShowS
[Env] -> ShowS
Env -> String
(Int -> Env -> ShowS)
-> (Env -> String) -> ([Env] -> ShowS) -> Show Env
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Env] -> ShowS
$cshowList :: [Env] -> ShowS
show :: Env -> String
$cshow :: Env -> String
showsPrec :: Int -> Env -> ShowS
$cshowsPrec :: Int -> Env -> ShowS
Show)

empty :: Env
empty :: Env
empty = Map Name [Scheme] -> Env
TypeEnv Map Name [Scheme]
forall k a. Map k a
Map.empty

extend :: Env -> (Name, [Scheme]) -> Env
extend :: Env -> (Name, [Scheme]) -> Env
extend env :: Env
env (x :: Name
x, s :: [Scheme]
s) = Env
env { types :: Map Name [Scheme]
types = Name -> [Scheme] -> Map Name [Scheme] -> Map Name [Scheme]
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert Name
x [Scheme]
s (Env -> Map Name [Scheme]
types Env
env) }

remove :: Env -> Name -> Env
remove :: Env -> Name -> Env
remove (TypeEnv env :: Map Name [Scheme]
env) var :: Name
var = Map Name [Scheme] -> Env
TypeEnv (Name -> Map Name [Scheme] -> Map Name [Scheme]
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Name
var Map Name [Scheme]
env)

extends :: Env -> [(Name, [Scheme])] -> Env
extends :: Env -> [(Name, [Scheme])] -> Env
extends env :: Env
env xs :: [(Name, [Scheme])]
xs = Env
env { types :: Map Name [Scheme]
types = Map Name [Scheme] -> Map Name [Scheme] -> Map Name [Scheme]
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union ([(Name, [Scheme])] -> Map Name [Scheme]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, [Scheme])]
xs) (Env -> Map Name [Scheme]
types Env
env) }

lookup :: Name -> Env -> Maybe [Scheme]
lookup :: Name -> Env -> Maybe [Scheme]
lookup key :: Name
key (TypeEnv tys :: Map Name [Scheme]
tys) = Name -> Map Name [Scheme] -> Maybe [Scheme]
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Name
key Map Name [Scheme]
tys

merge :: Env -> Env -> Env
merge :: Env -> Env -> Env
merge (TypeEnv a :: Map Name [Scheme]
a) (TypeEnv b :: Map Name [Scheme]
b) = Map Name [Scheme] -> Env
TypeEnv (Map Name [Scheme] -> Map Name [Scheme] -> Map Name [Scheme]
forall k a. Ord k => Map k a -> Map k a -> Map k a
Map.union Map Name [Scheme]
a Map Name [Scheme]
b)

mergeEnvs :: [Env] -> Env
mergeEnvs :: [Env] -> Env
mergeEnvs = (Env -> Env -> Env) -> Env -> [Env] -> Env
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Env -> Env -> Env
merge Env
empty

singleton :: Name -> Scheme -> Env
singleton :: Name -> Scheme -> Env
singleton x :: Name
x y :: Scheme
y = Map Name [Scheme] -> Env
TypeEnv (Name -> [Scheme] -> Map Name [Scheme]
forall k a. k -> a -> Map k a
Map.singleton Name
x [Scheme
y])

keys :: Env -> [Name]
keys :: Env -> [Name]
keys (TypeEnv env :: Map Name [Scheme]
env) = Map Name [Scheme] -> [Name]
forall k a. Map k a -> [k]
Map.keys Map Name [Scheme]
env

fromList :: [(Name, [Scheme])] -> Env
fromList :: [(Name, [Scheme])] -> Env
fromList xs :: [(Name, [Scheme])]
xs = Map Name [Scheme] -> Env
TypeEnv ([(Name, [Scheme])] -> Map Name [Scheme]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Name, [Scheme])]
xs)

toList :: Env -> [(Name, [Scheme])]
toList :: Env -> [(Name, [Scheme])]
toList (TypeEnv env :: Map Name [Scheme]
env) = Map Name [Scheme] -> [(Name, [Scheme])]
forall k a. Map k a -> [(k, a)]
Map.toList Map Name [Scheme]
env

instance Semigroup Env where
  <> :: Env -> Env -> Env
(<>) = Env -> Env -> Env
merge

instance Monoid Env where
  mempty :: Env
mempty  = Env
empty
  mappend :: Env -> Env -> Env
mappend = Env -> Env -> Env
merge