{-# language UndecidableInstances #-}
{-# language AllowAmbiguousTypes #-}
{-# language ConstraintKinds #-}
{-# language FunctionalDependencies #-}
{-# language GeneralizedNewtypeDeriving #-}

module Nix.Scope where

import           Nix.Prelude
import qualified Data.HashMap.Lazy             as M
import qualified Text.Show
import           Lens.Family2
import           Nix.Expr.Types

--  2021-07-19: NOTE: Scopes can gain from sequentiality, HashMap (aka AttrSet) may not be proper to it.
newtype Scope a = Scope (AttrSet a)
  deriving
    ( Scope a -> Scope a -> Bool
forall a. Eq a => Scope a -> Scope a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Scope a -> Scope a -> Bool
$c/= :: forall a. Eq a => Scope a -> Scope a -> Bool
== :: Scope a -> Scope a -> Bool
$c== :: forall a. Eq a => Scope a -> Scope a -> Bool
Eq, Scope a -> Scope a -> Bool
Scope a -> Scope a -> Ordering
Scope a -> Scope a -> Scope a
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
forall {a}. Ord a => Eq (Scope a)
forall a. Ord a => Scope a -> Scope a -> Bool
forall a. Ord a => Scope a -> Scope a -> Ordering
forall a. Ord a => Scope a -> Scope a -> Scope a
min :: Scope a -> Scope a -> Scope a
$cmin :: forall a. Ord a => Scope a -> Scope a -> Scope a
max :: Scope a -> Scope a -> Scope a
$cmax :: forall a. Ord a => Scope a -> Scope a -> Scope a
>= :: Scope a -> Scope a -> Bool
$c>= :: forall a. Ord a => Scope a -> Scope a -> Bool
> :: Scope a -> Scope a -> Bool
$c> :: forall a. Ord a => Scope a -> Scope a -> Bool
<= :: Scope a -> Scope a -> Bool
$c<= :: forall a. Ord a => Scope a -> Scope a -> Bool
< :: Scope a -> Scope a -> Bool
$c< :: forall a. Ord a => Scope a -> Scope a -> Bool
compare :: Scope a -> Scope a -> Ordering
$ccompare :: forall a. Ord a => Scope a -> Scope a -> Ordering
Ord, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Scope a) x -> Scope a
forall a x. Scope a -> Rep (Scope a) x
$cto :: forall a x. Rep (Scope a) x -> Scope a
$cfrom :: forall a x. Scope a -> Rep (Scope a) x
Generic
    , Typeable, Scope a -> ()
forall a. NFData a => Scope a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Scope a -> ()
$crnf :: forall a. NFData a => Scope a -> ()
NFData
    , ReadPrec [Scope a]
ReadPrec (Scope a)
ReadS [Scope a]
forall a. Read a => ReadPrec [Scope a]
forall a. Read a => ReadPrec (Scope a)
forall a. Read a => Int -> ReadS (Scope a)
forall a. Read a => ReadS [Scope a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Scope a]
$creadListPrec :: forall a. Read a => ReadPrec [Scope a]
readPrec :: ReadPrec (Scope a)
$creadPrec :: forall a. Read a => ReadPrec (Scope a)
readList :: ReadS [Scope a]
$creadList :: forall a. Read a => ReadS [Scope a]
readsPrec :: Int -> ReadS (Scope a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Scope a)
Read, Int -> Scope a -> Int
Scope a -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
forall {a}. Hashable a => Eq (Scope a)
forall a. Hashable a => Int -> Scope a -> Int
forall a. Hashable a => Scope a -> Int
hash :: Scope a -> Int
$chash :: forall a. Hashable a => Scope a -> Int
hashWithSalt :: Int -> Scope a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Scope a -> Int
Hashable
    , NonEmpty (Scope a) -> Scope a
Scope a -> Scope a -> Scope a
forall b. Integral b => b -> Scope a -> Scope a
forall a. NonEmpty (Scope a) -> Scope a
forall a. Scope a -> Scope a -> Scope a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
forall a b. Integral b => b -> Scope a -> Scope a
stimes :: forall b. Integral b => b -> Scope a -> Scope a
$cstimes :: forall a b. Integral b => b -> Scope a -> Scope a
sconcat :: NonEmpty (Scope a) -> Scope a
$csconcat :: forall a. NonEmpty (Scope a) -> Scope a
<> :: Scope a -> Scope a -> Scope a
$c<> :: forall a. Scope a -> Scope a -> Scope a
Semigroup, Scope a
[Scope a] -> Scope a
Scope a -> Scope a -> Scope a
forall a. Semigroup (Scope a)
forall a. Scope a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. [Scope a] -> Scope a
forall a. Scope a -> Scope a -> Scope a
mconcat :: [Scope a] -> Scope a
$cmconcat :: forall a. [Scope a] -> Scope a
mappend :: Scope a -> Scope a -> Scope a
$cmappend :: forall a. Scope a -> Scope a -> Scope a
mempty :: Scope a
$cmempty :: forall a. Scope a
Monoid
    , forall a b. a -> Scope b -> Scope a
forall a b. (a -> b) -> Scope a -> Scope b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Scope b -> Scope a
$c<$ :: forall a b. a -> Scope b -> Scope a
fmap :: forall a b. (a -> b) -> Scope a -> Scope b
$cfmap :: forall a b. (a -> b) -> Scope a -> Scope b
Functor, forall a. Eq a => a -> Scope a -> Bool
forall a. Num a => Scope a -> a
forall a. Ord a => Scope a -> a
forall m. Monoid m => Scope m -> m
forall a. Scope a -> Bool
forall a. Scope a -> Int
forall a. Scope a -> [a]
forall a. (a -> a -> a) -> Scope a -> a
forall m a. Monoid m => (a -> m) -> Scope a -> m
forall b a. (b -> a -> b) -> b -> Scope a -> b
forall a b. (a -> b -> b) -> b -> Scope a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => Scope a -> a
$cproduct :: forall a. Num a => Scope a -> a
sum :: forall a. Num a => Scope a -> a
$csum :: forall a. Num a => Scope a -> a
minimum :: forall a. Ord a => Scope a -> a
$cminimum :: forall a. Ord a => Scope a -> a
maximum :: forall a. Ord a => Scope a -> a
$cmaximum :: forall a. Ord a => Scope a -> a
elem :: forall a. Eq a => a -> Scope a -> Bool
$celem :: forall a. Eq a => a -> Scope a -> Bool
length :: forall a. Scope a -> Int
$clength :: forall a. Scope a -> Int
null :: forall a. Scope a -> Bool
$cnull :: forall a. Scope a -> Bool
toList :: forall a. Scope a -> [a]
$ctoList :: forall a. Scope a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Scope a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Scope a -> a
foldr1 :: forall a. (a -> a -> a) -> Scope a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Scope a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> Scope a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Scope a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Scope a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Scope a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Scope a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Scope a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Scope a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Scope a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> Scope a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Scope a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Scope a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Scope a -> m
fold :: forall m. Monoid m => Scope m -> m
$cfold :: forall m. Monoid m => Scope m -> m
Foldable, Functor Scope
Foldable Scope
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Scope (m a) -> m (Scope a)
forall (f :: * -> *) a. Applicative f => Scope (f a) -> f (Scope a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scope a -> m (Scope b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scope a -> f (Scope b)
sequence :: forall (m :: * -> *) a. Monad m => Scope (m a) -> m (Scope a)
$csequence :: forall (m :: * -> *) a. Monad m => Scope (m a) -> m (Scope a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scope a -> m (Scope b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scope a -> m (Scope b)
sequenceA :: forall (f :: * -> *) a. Applicative f => Scope (f a) -> f (Scope a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Scope (f a) -> f (Scope a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scope a -> f (Scope b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scope a -> f (Scope b)
Traversable
    , OneItem (Scope a) -> Scope a
forall a. OneItem (Scope a) -> Scope a
forall x. (OneItem x -> x) -> One x
one :: OneItem (Scope a) -> Scope a
$cone :: forall a. OneItem (Scope a) -> Scope a
One
    )

instance Show (Scope a) where
  show :: Scope a -> String
show (Scope AttrSet a
m) = forall b a. (Show a, IsString b) => a -> b
show forall a b. (a -> b) -> a -> b
$ forall k v. HashMap k v -> [k]
M.keys AttrSet a
m

scopeLookup :: VarName -> [Scope a] -> Maybe a
scopeLookup :: forall a. VarName -> [Scope a] -> Maybe a
scopeLookup VarName
key = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a. Scope a -> Maybe a -> Maybe a
fun forall a. Maybe a
Nothing
 where
  fun
    :: Scope a
    -> Maybe a
    -> Maybe a
  fun :: forall a. Scope a -> Maybe a -> Maybe a
fun (Scope AttrSet a
m) Maybe a
rest = forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
key AttrSet a
m forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe a
rest

data Scopes m a =
  Scopes
    { forall (m :: * -> *) a. Scopes m a -> [Scope a]
lexicalScopes :: [Scope a]
    , forall (m :: * -> *) a. Scopes m a -> [m (Scope a)]
dynamicScopes :: [m (Scope a)]
    }

instance Show (Scopes m a) where
  show :: Scopes m a -> String
show (Scopes [Scope a]
m [m (Scope a)]
a) =
    String
"Scopes: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show [Scope a]
m forall a. Semigroup a => a -> a -> a
<> String
", and " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [m (Scope a)]
a) forall a. Semigroup a => a -> a -> a
<> String
" with-scopes"

instance Semigroup (Scopes m a) where
  Scopes [Scope a]
ls [m (Scope a)]
lw <> :: Scopes m a -> Scopes m a -> Scopes m a
<> Scopes [Scope a]
rs [m (Scope a)]
rw = forall (m :: * -> *) a. [Scope a] -> [m (Scope a)] -> Scopes m a
Scopes ([Scope a]
ls forall a. Semigroup a => a -> a -> a
<> [Scope a]
rs) ([m (Scope a)]
lw forall a. Semigroup a => a -> a -> a
<> [m (Scope a)]
rw)

instance Monoid (Scopes m a) where
  mempty :: Scopes m a
mempty = forall (m :: * -> *) a. Scopes m a
emptyScopes

emptyScopes :: Scopes m a
emptyScopes :: forall (m :: * -> *) a. Scopes m a
emptyScopes = forall (m :: * -> *) a. [Scope a] -> [m (Scope a)] -> Scopes m a
Scopes forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty

class Scoped a m | m -> a where
  askScopes :: m (Scopes m a)
  clearScopes   :: m r -> m r
  pushScopes    :: Scopes m a -> m r -> m r
  lookupVar     :: VarName -> m (Maybe a)

askScopesReader
  :: forall m a e
  . ( MonadReader e m
    , Has e (Scopes m a)
    )
  => m (Scopes m a)
askScopesReader :: forall (m :: * -> *) a e.
(MonadReader e m, Has e (Scopes m a)) =>
m (Scopes m a)
askScopesReader = forall t (m :: * -> *) a. (MonadReader t m, Has t a) => m a
askLocal

clearScopesReader
  :: forall m a e r
  . ( MonadReader e m
    , Has e (Scopes m a)
    )
  => m r
  -> m r
clearScopesReader :: forall (m :: * -> *) a e r.
(MonadReader e m, Has e (Scopes m a)) =>
m r -> m r
clearScopesReader = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall s t a b. Setter s t a b -> b -> s -> t
set forall a b. Has a b => Lens' a b
hasLens forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Scopes m a
emptyScopes @m @a

pushScope
  :: Scoped a m
  => Scope a
  -> m r
  -> m r
pushScope :: forall a (m :: * -> *) r. Scoped a m => Scope a -> m r -> m r
pushScope Scope a
scope = forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
pushScopes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. [Scope a] -> [m (Scope a)] -> Scopes m a
Scopes (forall x. One x => OneItem x -> x
one Scope a
scope) forall a. Monoid a => a
mempty

pushWeakScope
  :: ( Functor m
     , Scoped a m
     )
  => m (Scope a)
  -> m r
  -> m r
pushWeakScope :: forall (m :: * -> *) a r.
(Functor m, Scoped a m) =>
m (Scope a) -> m r -> m r
pushWeakScope m (Scope a)
scope = forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
pushScopes forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. [Scope a] -> [m (Scope a)] -> Scopes m a
Scopes forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one m (Scope a)
scope

pushScopesReader
  :: ( MonadReader e m
     , Has e (Scopes m a)
     )
  => Scopes m a
  -> m r
  -> m r
pushScopesReader :: forall e (m :: * -> *) a r.
(MonadReader e m, Has e (Scopes m a)) =>
Scopes m a -> m r -> m r
pushScopesReader Scopes m a
s = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local forall a b. (a -> b) -> a -> b
$ forall s t a b. Setter s t a b -> (a -> b) -> s -> t
over forall a b. Has a b => Lens' a b
hasLens (Scopes m a
s forall a. Semigroup a => a -> a -> a
<>)

lookupVarReader
  :: forall m a e
  . ( MonadReader e m
    , Has e (Scopes m a)
    )
  => VarName
  -> m (Maybe a)
lookupVarReader :: forall (m :: * -> *) a e.
(MonadReader e m, Has e (Scopes m a)) =>
VarName -> m (Maybe a)
lookupVarReader VarName
k =
  do
    Maybe a
mres <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall a. VarName -> [Scope a] -> Maybe a
scopeLookup VarName
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) a. Scopes m a -> [Scope a]
lexicalScopes @m forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s t b. FoldLike a s t a b -> s -> a
view forall a b. Has a b => Lens' a b
hasLens

    forall b a. b -> (a -> b) -> Maybe a -> b
maybe
      (do
        [m (Scope a)]
ws <- forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Scopes m a -> [m (Scope a)]
dynamicScopes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s t b. FoldLike a s t a b -> s -> a
view forall a b. Has a b => Lens' a b
hasLens

        forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
          (\ m (Scope a)
weakscope m (Maybe a)
rest ->
            do
              Maybe a
mres' <- forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup VarName
k forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce @(Scope a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Scope a)
weakscope

              forall b a. b -> (a -> b) -> Maybe a -> b
maybe
                m (Maybe a)
rest
                (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure)
                Maybe a
mres'
          )
          (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a. Maybe a
Nothing)
          [m (Scope a)]
ws
      )
      (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure)
      Maybe a
mres

withScopes
  :: Scoped a m
  => Scopes m a
  -> m r
  -> m r
withScopes :: forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
withScopes Scopes m a
scopes = forall a (m :: * -> *) r. Scoped a m => m r -> m r
clearScopes forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
pushScopes Scopes m a
scopes