Split off NCited into its own file

hnix.cabal

@@ -439,6 +439,7 @@ library
       Nix.Atoms
       Nix.Builtins
       Nix.Cache
+      Nix.Cited
       Nix.Context
       Nix.Convert
       Nix.Effects

src/Nix/Cited.hs

@@ -0,0 +1,53 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+
+module Nix.Cited where
+
+import Control.Comonad
+import Control.Comonad.Env
+import Lens.Family2.TH
+
+import Data.Typeable (Typeable)
+import GHC.Generics
+
+import Nix.Expr.Types.Annotated
+import Nix.Scope
+
+data Provenance t v m = Provenance
+    { _lexicalScope :: Scopes m t
+    , _originExpr   :: NExprLocF (Maybe v)
+      -- ^ When calling the function x: x + 2 with argument x = 3, the
+      --   'originExpr' for the resulting value will be 3 + 2, while the
+      --   'contextExpr' will be @(x: x + 2) 3@, preserving not only the
+      --   result of the call, but what was called and with what arguments.
+    }
+    deriving (Generic, Typeable)
+
+data NCited t v m a = NCited
+    { _provenance :: [Provenance t v m]
+    , _cited      :: a
+    }
+    deriving (Generic, Typeable, Functor, Foldable, Traversable)
+
+instance Applicative (NCited t v m) where
+  pure = NCited []
+  -- jww (2019-03-11): ??
+  NCited xs f <*> NCited ys x = NCited (xs <> ys) (f x)
+
+instance Comonad (NCited t v m) where
+  duplicate p = NCited (_provenance p) p
+  extract = _cited
+
+instance ComonadEnv [Provenance t v m] (NCited t v m) where
+  ask = _provenance
+
+$(makeLenses ''Provenance)
+$(makeLenses ''NCited)

src/Nix/Expr/Types.hs

@@ -70,6 +70,9 @@ import qualified Type.Reflection as Reflection
 
 type VarName = Text
 
+hashAt :: VarName -> Lens' (AttrSet v) (Maybe v)
+hashAt = flip alterF
+
 -- unfortunate orphans
 #if MIN_VERSION_hashable(1, 2, 5)
 instance Hashable1 NonEmpty

src/Nix/Normal.hs

@@ -30,7 +30,7 @@ import           Nix.Var
 newtype NormalLoop m = NormalLoop (NValue m)
     deriving Show
 
-instance Typeable m => Exception (NormalLoop m)
+instance (MonadDataContext m, Typeable m) => Exception (NormalLoop m)
 
 normalFormBy
     :: forall e m. (Framed e m, MonadVar m, Typeable m)

src/Nix/Utils.hs

@@ -5,8 +5,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
 {-# LANGUAGE TupleSections #-}
 
+{-# OPTIONS_GHC -Wno-missing-signatures #-}
+
 module Nix.Utils (module Nix.Utils, module X) where
 
 import           Control.Arrow ((&&&))
@@ -15,6 +18,8 @@ import           Control.Monad.Fix
 import qualified Data.Aeson as A
 import qualified Data.Aeson.Encoding as A
 import           Data.Fix
+import           Data.Functor.Compose
+import           Data.Hashable
 import           Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as M
 import           Data.List (sortOn)
@@ -24,6 +29,7 @@ import qualified Data.Text as Text
 import qualified Data.Vector as V
 import           Lens.Family2 as X
 import           Lens.Family2.Stock (_1, _2)
+import           Lens.Family2.TH
 
 #if ENABLE_TRACING
 import           Debug.Trace as X
@@ -35,6 +41,9 @@ traceM :: Monad m => String -> m ()
 traceM = const (return ())
 #endif
 
+$(makeLensesBy (\n -> Just ("_" ++ n)) ''Fix)
+$(makeLensesBy (\n -> Just ("_" ++ n)) ''Compose)
+
 type DList a = Endo [a]
 
 type AttrSet = HashMap Text
@@ -124,3 +133,9 @@ uriAwareSplit = go where
                 let ((suffix, _):path) = go (Text.drop 3 e2)
                  in (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path
             | otherwise -> (e1, PathEntryPath) : go (Text.drop 1 e2)
+
+alterF :: (Eq k, Hashable k, Functor f)
+       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
+alterF f k m = f (M.lookup k m) <&> \case
+    Nothing -> M.delete k m
+    Just v  -> M.insert k v m

src/Nix/Value.hs

@@ -30,7 +30,6 @@
 module Nix.Value where
 
 import           Control.Comonad
-import           Control.Comonad.Env
 import           Control.Monad
 -- import           Control.Monad.Catch
 import           Control.Monad.Free
@@ -40,9 +39,7 @@ import qualified Data.Aeson as A
 import           Data.Align
 import           Data.Fix
 import           Data.Functor.Classes
-import           Data.HashMap.Lazy (HashMap)
 import qualified Data.HashMap.Lazy as M
-import           Data.Hashable
 import           Data.These
 import           Data.Typeable (Typeable)
 import           GHC.Generics
@@ -53,39 +50,10 @@ import           Nix.Atoms
 import           Nix.Expr.Types
 import           Nix.Expr.Types.Annotated
 -- import           Nix.Frames
-import           Nix.Scope
 import           Nix.String
 import           Nix.Thunk
 import           Nix.Utils
 
-data Provenance t v m = Provenance
-    { _lexicalScope :: Scopes m t
-    , _originExpr   :: NExprLocF (Maybe v)
-      -- ^ When calling the function x: x + 2 with argument x = 3, the
-      --   'originExpr' for the resulting value will be 3 + 2, while the
-      --   'contextExpr' will be @(x: x + 2) 3@, preserving not only the
-      --   result of the call, but what was called and with what arguments.
-    }
-    deriving (Generic, Typeable)
-
-data NCited t v m a = NCited
-    { _provenance :: [Provenance t v m]
-    , _cited      :: a
-    }
-    deriving (Generic, Typeable, Functor, Foldable, Traversable)
-
-instance Applicative (NCited t v m) where
-  pure = NCited []
-  -- jww (2019-03-11): ??
-  NCited xs f <*> NCited ys x = NCited (xs <> ys) (f x)
-
-instance Comonad (NCited t v m) where
-  duplicate p = NCited (_provenance p) p
-  extract = _cited
-
-instance ComonadEnv [Provenance t v m] (NCited t v m) where
-  ask = _provenance
-
 -- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation is
 --   completed. 's' is related to the type of errors that might occur during
 --   construction or use of a value.
@@ -419,8 +387,18 @@ describeValue = \case
     TPath              -> "a path"
     TBuiltin           -> "a builtin function"
 
--- instance Show (NValueF (NValue m) m (NThunk m)) where
---     show = describeValue . valueType
+instance MonadDataContext m => Show (NValue m) where
+    show = describeValue
+        . valueType
+        . getCompose
+        . extract
+        . getCompose
+        . unFix
+        . _nValue
+
+instance Show (NValueF (NValue m) m
+               (f (Fix (Compose g (Compose (NValueF (NValue m) m) f))))) where
+    show = describeValue . valueType
 
 instance Show (NValueF (NValueNF m) m r) where
     show = describeValue . valueType
@@ -467,20 +445,7 @@ data ValueFrame m
 -- instance Typeable m => Exception (ValueFrame m)
 
 $(makeTraversals ''NValueF)
-$(makeLenses ''Provenance)
-$(makeLenses ''NCited)
 $(makeLenses ''NValue)
-$(makeLensesBy (\n -> Just ("_" ++ n)) ''Fix)
-$(makeLensesBy (\n -> Just ("_" ++ n)) ''Compose)
-
-alterF :: (Eq k, Hashable k, Functor f)
-       => (Maybe v -> f (Maybe v)) -> k -> HashMap k v -> f (HashMap k v)
-alterF f k m = f (M.lookup k m) <&> \case
-    Nothing -> M.delete k m
-    Just v  -> M.insert k v m
-
-hashAt :: VarName -> Lens' (AttrSet v) (Maybe v)
-hashAt = flip alterF
 
 key :: (Applicative f, MonadDataContext m)
     => VarName -> LensLike' f (NValue m) (Maybe (NThunk m))