{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Nix.Scope where

import           Control.Applicative
import           Control.Monad.Reader
import qualified Data.HashMap.Lazy             as M
import           Data.Text                      ( Text )
import           Lens.Family2
import           Nix.Utils

newtype Scope a = Scope { Scope a -> AttrSet a
getScope :: AttrSet a }
    deriving (a -> Scope b -> Scope a
(a -> b) -> Scope a -> Scope b
(forall a b. (a -> b) -> Scope a -> Scope b)
-> (forall a b. a -> Scope b -> Scope a) -> Functor Scope
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
<$ :: a -> Scope b -> Scope a
$c<$ :: forall a b. a -> Scope b -> Scope a
fmap :: (a -> b) -> Scope a -> Scope b
$cfmap :: forall a b. (a -> b) -> Scope a -> Scope b
Functor, a -> Scope a -> Bool
Scope m -> m
Scope a -> [a]
Scope a -> Bool
Scope a -> Int
Scope a -> a
Scope a -> a
Scope a -> a
Scope a -> a
(a -> m) -> Scope a -> m
(a -> m) -> Scope a -> m
(a -> b -> b) -> b -> Scope a -> b
(a -> b -> b) -> b -> Scope a -> b
(b -> a -> b) -> b -> Scope a -> b
(b -> a -> b) -> b -> Scope a -> b
(a -> a -> a) -> Scope a -> a
(a -> a -> a) -> Scope a -> a
(forall m. Monoid m => Scope m -> m)
-> (forall m a. Monoid m => (a -> m) -> Scope a -> m)
-> (forall m a. Monoid m => (a -> m) -> Scope a -> m)
-> (forall a b. (a -> b -> b) -> b -> Scope a -> b)
-> (forall a b. (a -> b -> b) -> b -> Scope a -> b)
-> (forall b a. (b -> a -> b) -> b -> Scope a -> b)
-> (forall b a. (b -> a -> b) -> b -> Scope a -> b)
-> (forall a. (a -> a -> a) -> Scope a -> a)
-> (forall a. (a -> a -> a) -> Scope a -> a)
-> (forall a. Scope a -> [a])
-> (forall a. Scope a -> Bool)
-> (forall a. Scope a -> Int)
-> (forall a. Eq a => a -> Scope a -> Bool)
-> (forall a. Ord a => Scope a -> a)
-> (forall a. Ord a => Scope a -> a)
-> (forall a. Num a => Scope a -> a)
-> (forall a. Num a => Scope a -> a)
-> Foldable Scope
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 :: Scope a -> a
$cproduct :: forall a. Num a => Scope a -> a
sum :: Scope a -> a
$csum :: forall a. Num a => Scope a -> a
minimum :: Scope a -> a
$cminimum :: forall a. Ord a => Scope a -> a
maximum :: Scope a -> a
$cmaximum :: forall a. Ord a => Scope a -> a
elem :: a -> Scope a -> Bool
$celem :: forall a. Eq a => a -> Scope a -> Bool
length :: Scope a -> Int
$clength :: forall a. Scope a -> Int
null :: Scope a -> Bool
$cnull :: forall a. Scope a -> Bool
toList :: Scope a -> [a]
$ctoList :: forall a. Scope a -> [a]
foldl1 :: (a -> a -> a) -> Scope a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Scope a -> a
foldr1 :: (a -> a -> a) -> Scope a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Scope a -> a
foldl' :: (b -> a -> b) -> b -> Scope a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Scope a -> b
foldl :: (b -> a -> b) -> b -> Scope a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Scope a -> b
foldr' :: (a -> b -> b) -> b -> Scope a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Scope a -> b
foldr :: (a -> b -> b) -> b -> Scope a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Scope a -> b
foldMap' :: (a -> m) -> Scope a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Scope a -> m
foldMap :: (a -> m) -> Scope a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Scope a -> m
fold :: Scope m -> m
$cfold :: forall m. Monoid m => Scope m -> m
Foldable, Functor Scope
Foldable Scope
(Functor Scope, Foldable Scope) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> Scope a -> f (Scope b))
-> (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 (m :: * -> *) a. Monad m => Scope (m a) -> m (Scope a))
-> Traversable Scope
(a -> f b) -> Scope a -> f (Scope b)
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 :: Scope (m a) -> m (Scope a)
$csequence :: forall (m :: * -> *) a. Monad m => Scope (m a) -> m (Scope a)
mapM :: (a -> m b) -> Scope a -> m (Scope b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Scope a -> m (Scope b)
sequenceA :: Scope (f a) -> f (Scope a)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Scope (f a) -> f (Scope a)
traverse :: (a -> f b) -> Scope a -> f (Scope b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Scope a -> f (Scope b)
$cp2Traversable :: Foldable Scope
$cp1Traversable :: Functor Scope
Traversable, Scope a -> Scope a -> Bool
(Scope a -> Scope a -> Bool)
-> (Scope a -> Scope a -> Bool) -> Eq (Scope a)
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)

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

newScope :: AttrSet a -> Scope a
newScope :: AttrSet a -> Scope a
newScope = AttrSet a -> Scope a
forall a. AttrSet a -> Scope a
Scope

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

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

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

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

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

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

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

currentScopesReader
  :: forall m a e . (MonadReader e m, Has e (Scopes m a)) => m (Scopes m a)
currentScopesReader :: m (Scopes m a)
currentScopesReader = (e -> Scopes m a) -> m (Scopes m a)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (FoldLike (Scopes m a) e e (Scopes m a) (Scopes m a)
-> e -> Scopes m a
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike (Scopes m a) e e (Scopes m a) (Scopes m a)
forall a b. Has a b => Lens' a b
hasLens)

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

pushScope :: Scoped a m => AttrSet a -> m r -> m r
pushScope :: AttrSet a -> m r -> m r
pushScope s :: AttrSet a
s = Scopes m a -> m r -> m r
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
pushScopes ([Scope a] -> [m (Scope a)] -> Scopes m a
forall (m :: * -> *) a. [Scope a] -> [m (Scope a)] -> Scopes m a
Scopes [AttrSet a -> Scope a
forall a. AttrSet a -> Scope a
Scope AttrSet a
s] [])

pushWeakScope :: (Functor m, Scoped a m) => m (AttrSet a) -> m r -> m r
pushWeakScope :: m (AttrSet a) -> m r -> m r
pushWeakScope s :: m (AttrSet a)
s = Scopes m a -> m r -> m r
forall a (m :: * -> *) r. Scoped a m => Scopes m a -> m r -> m r
pushScopes ([Scope a] -> [m (Scope a)] -> Scopes m a
forall (m :: * -> *) a. [Scope a] -> [m (Scope a)] -> Scopes m a
Scopes [] [AttrSet a -> Scope a
forall a. AttrSet a -> Scope a
Scope (AttrSet a -> Scope a) -> m (AttrSet a) -> m (Scope a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (AttrSet a)
s])

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

lookupVarReader
  :: forall m a e . (MonadReader e m, Has e (Scopes m a)) => Text -> m (Maybe a)
lookupVarReader :: Text -> m (Maybe a)
lookupVarReader k :: Text
k = do
  Maybe a
mres <- (e -> Maybe a) -> m (Maybe a)
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Text -> [Scope a] -> Maybe a
forall a. Text -> [Scope a] -> Maybe a
scopeLookup Text
k ([Scope a] -> Maybe a) -> (e -> [Scope a]) -> e -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Scopes m a -> [Scope a]
forall (m :: * -> *) a. Scopes m a -> [Scope a]
lexicalScopes @m (Scopes m a -> [Scope a]) -> (e -> Scopes m a) -> e -> [Scope a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldLike (Scopes m a) e e (Scopes m a) (Scopes m a)
-> e -> Scopes m a
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike (Scopes m a) e e (Scopes m a) (Scopes m a)
forall a b. Has a b => Lens' a b
hasLens)
  case Maybe a
mres of
    Just sym :: a
sym -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
sym
    Nothing  -> do
      [m (Scope a)]
ws <- (e -> [m (Scope a)]) -> m [m (Scope a)]
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks (Scopes m a -> [m (Scope a)]
forall (m :: * -> *) a. Scopes m a -> [m (Scope a)]
dynamicScopes (Scopes m a -> [m (Scope a)])
-> (e -> Scopes m a) -> e -> [m (Scope a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FoldLike (Scopes m a) e e (Scopes m a) (Scopes m a)
-> e -> Scopes m a
forall a s t b. FoldLike a s t a b -> s -> a
view FoldLike (Scopes m a) e e (Scopes m a) (Scopes m a)
forall a b. Has a b => Lens' a b
hasLens)
      (m (Scope a) -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> [m (Scope a)] -> m (Maybe a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr
        (\x :: m (Scope a)
x rest :: m (Maybe a)
rest -> do
          Maybe a
mres' <- Text -> HashMap Text a -> Maybe a
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup Text
k (HashMap Text a -> Maybe a)
-> (Scope a -> HashMap Text a) -> Scope a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scope a -> HashMap Text a
forall a. Scope a -> AttrSet a
getScope (Scope a -> Maybe a) -> m (Scope a) -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (Scope a)
x
          case Maybe a
mres' of
            Just sym :: a
sym -> Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
sym
            Nothing  -> m (Maybe a)
rest
        )
        (Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing)
        [m (Scope a)]
ws

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