{-# 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