Split off NCited into its own file
This commit is contained in:
parent
3cb9834792
commit
28a1410013
|
@ -439,6 +439,7 @@ library
|
||||||
Nix.Atoms
|
Nix.Atoms
|
||||||
Nix.Builtins
|
Nix.Builtins
|
||||||
Nix.Cache
|
Nix.Cache
|
||||||
|
Nix.Cited
|
||||||
Nix.Context
|
Nix.Context
|
||||||
Nix.Convert
|
Nix.Convert
|
||||||
Nix.Effects
|
Nix.Effects
|
||||||
|
|
53
src/Nix/Cited.hs
Normal file
53
src/Nix/Cited.hs
Normal file
|
@ -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)
|
|
@ -70,6 +70,9 @@ import qualified Type.Reflection as Reflection
|
||||||
|
|
||||||
type VarName = Text
|
type VarName = Text
|
||||||
|
|
||||||
|
hashAt :: VarName -> Lens' (AttrSet v) (Maybe v)
|
||||||
|
hashAt = flip alterF
|
||||||
|
|
||||||
-- unfortunate orphans
|
-- unfortunate orphans
|
||||||
#if MIN_VERSION_hashable(1, 2, 5)
|
#if MIN_VERSION_hashable(1, 2, 5)
|
||||||
instance Hashable1 NonEmpty
|
instance Hashable1 NonEmpty
|
||||||
|
|
|
@ -30,7 +30,7 @@ import Nix.Var
|
||||||
newtype NormalLoop m = NormalLoop (NValue m)
|
newtype NormalLoop m = NormalLoop (NValue m)
|
||||||
deriving Show
|
deriving Show
|
||||||
|
|
||||||
instance Typeable m => Exception (NormalLoop m)
|
instance (MonadDataContext m, Typeable m) => Exception (NormalLoop m)
|
||||||
|
|
||||||
normalFormBy
|
normalFormBy
|
||||||
:: forall e m. (Framed e m, MonadVar m, Typeable m)
|
:: forall e m. (Framed e m, MonadVar m, Typeable m)
|
||||||
|
|
|
@ -5,8 +5,11 @@
|
||||||
{-# LANGUAGE OverloadedStrings #-}
|
{-# LANGUAGE OverloadedStrings #-}
|
||||||
{-# LANGUAGE RankNTypes #-}
|
{-# LANGUAGE RankNTypes #-}
|
||||||
{-# LANGUAGE ScopedTypeVariables #-}
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TemplateHaskell #-}
|
||||||
{-# LANGUAGE TupleSections #-}
|
{-# LANGUAGE TupleSections #-}
|
||||||
|
|
||||||
|
{-# OPTIONS_GHC -Wno-missing-signatures #-}
|
||||||
|
|
||||||
module Nix.Utils (module Nix.Utils, module X) where
|
module Nix.Utils (module Nix.Utils, module X) where
|
||||||
|
|
||||||
import Control.Arrow ((&&&))
|
import Control.Arrow ((&&&))
|
||||||
|
@ -15,6 +18,8 @@ import Control.Monad.Fix
|
||||||
import qualified Data.Aeson as A
|
import qualified Data.Aeson as A
|
||||||
import qualified Data.Aeson.Encoding as A
|
import qualified Data.Aeson.Encoding as A
|
||||||
import Data.Fix
|
import Data.Fix
|
||||||
|
import Data.Functor.Compose
|
||||||
|
import Data.Hashable
|
||||||
import Data.HashMap.Lazy (HashMap)
|
import Data.HashMap.Lazy (HashMap)
|
||||||
import qualified Data.HashMap.Lazy as M
|
import qualified Data.HashMap.Lazy as M
|
||||||
import Data.List (sortOn)
|
import Data.List (sortOn)
|
||||||
|
@ -24,6 +29,7 @@ import qualified Data.Text as Text
|
||||||
import qualified Data.Vector as V
|
import qualified Data.Vector as V
|
||||||
import Lens.Family2 as X
|
import Lens.Family2 as X
|
||||||
import Lens.Family2.Stock (_1, _2)
|
import Lens.Family2.Stock (_1, _2)
|
||||||
|
import Lens.Family2.TH
|
||||||
|
|
||||||
#if ENABLE_TRACING
|
#if ENABLE_TRACING
|
||||||
import Debug.Trace as X
|
import Debug.Trace as X
|
||||||
|
@ -35,6 +41,9 @@ traceM :: Monad m => String -> m ()
|
||||||
traceM = const (return ())
|
traceM = const (return ())
|
||||||
#endif
|
#endif
|
||||||
|
|
||||||
|
$(makeLensesBy (\n -> Just ("_" ++ n)) ''Fix)
|
||||||
|
$(makeLensesBy (\n -> Just ("_" ++ n)) ''Compose)
|
||||||
|
|
||||||
type DList a = Endo [a]
|
type DList a = Endo [a]
|
||||||
|
|
||||||
type AttrSet = HashMap Text
|
type AttrSet = HashMap Text
|
||||||
|
@ -124,3 +133,9 @@ uriAwareSplit = go where
|
||||||
let ((suffix, _):path) = go (Text.drop 3 e2)
|
let ((suffix, _):path) = go (Text.drop 3 e2)
|
||||||
in (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path
|
in (e1 <> Text.pack "://" <> suffix, PathEntryURI) : path
|
||||||
| otherwise -> (e1, PathEntryPath) : go (Text.drop 1 e2)
|
| 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
|
||||||
|
|
|
@ -30,7 +30,6 @@
|
||||||
module Nix.Value where
|
module Nix.Value where
|
||||||
|
|
||||||
import Control.Comonad
|
import Control.Comonad
|
||||||
import Control.Comonad.Env
|
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
-- import Control.Monad.Catch
|
-- import Control.Monad.Catch
|
||||||
import Control.Monad.Free
|
import Control.Monad.Free
|
||||||
|
@ -40,9 +39,7 @@ import qualified Data.Aeson as A
|
||||||
import Data.Align
|
import Data.Align
|
||||||
import Data.Fix
|
import Data.Fix
|
||||||
import Data.Functor.Classes
|
import Data.Functor.Classes
|
||||||
import Data.HashMap.Lazy (HashMap)
|
|
||||||
import qualified Data.HashMap.Lazy as M
|
import qualified Data.HashMap.Lazy as M
|
||||||
import Data.Hashable
|
|
||||||
import Data.These
|
import Data.These
|
||||||
import Data.Typeable (Typeable)
|
import Data.Typeable (Typeable)
|
||||||
import GHC.Generics
|
import GHC.Generics
|
||||||
|
@ -53,39 +50,10 @@ import Nix.Atoms
|
||||||
import Nix.Expr.Types
|
import Nix.Expr.Types
|
||||||
import Nix.Expr.Types.Annotated
|
import Nix.Expr.Types.Annotated
|
||||||
-- import Nix.Frames
|
-- import Nix.Frames
|
||||||
import Nix.Scope
|
|
||||||
import Nix.String
|
import Nix.String
|
||||||
import Nix.Thunk
|
import Nix.Thunk
|
||||||
import Nix.Utils
|
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
|
-- | 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
|
-- completed. 's' is related to the type of errors that might occur during
|
||||||
-- construction or use of a value.
|
-- construction or use of a value.
|
||||||
|
@ -419,8 +387,18 @@ describeValue = \case
|
||||||
TPath -> "a path"
|
TPath -> "a path"
|
||||||
TBuiltin -> "a builtin function"
|
TBuiltin -> "a builtin function"
|
||||||
|
|
||||||
-- instance Show (NValueF (NValue m) m (NThunk m)) where
|
instance MonadDataContext m => Show (NValue m) where
|
||||||
-- show = describeValue . valueType
|
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
|
instance Show (NValueF (NValueNF m) m r) where
|
||||||
show = describeValue . valueType
|
show = describeValue . valueType
|
||||||
|
@ -467,20 +445,7 @@ data ValueFrame m
|
||||||
-- instance Typeable m => Exception (ValueFrame m)
|
-- instance Typeable m => Exception (ValueFrame m)
|
||||||
|
|
||||||
$(makeTraversals ''NValueF)
|
$(makeTraversals ''NValueF)
|
||||||
$(makeLenses ''Provenance)
|
|
||||||
$(makeLenses ''NCited)
|
|
||||||
$(makeLenses ''NValue)
|
$(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)
|
key :: (Applicative f, MonadDataContext m)
|
||||||
=> VarName -> LensLike' f (NValue m) (Maybe (NThunk m))
|
=> VarName -> LensLike' f (NValue m) (Maybe (NThunk m))
|
||||||
|
|
Loading…
Reference in a new issue