109 lines
4.1 KiB
Haskell
109 lines
4.1 KiB
Haskell
{-# LANGUAGE DeriveDataTypeable #-}
|
|
{-# LANGUAGE DeriveFunctor #-}
|
|
{-# LANGUAGE DeriveGeneric #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE ScopedTypeVariables #-}
|
|
{-# LANGUAGE TypeApplications #-}
|
|
{-# LANGUAGE TypeFamilies #-}
|
|
|
|
module Nix.Value where
|
|
|
|
import Data.Coerce
|
|
import Data.Fix
|
|
import Data.HashMap.Lazy (HashMap)
|
|
import Data.Monoid (appEndo)
|
|
import Data.Text (Text)
|
|
import Data.Typeable (Typeable)
|
|
import GHC.Generics
|
|
import Nix.Atoms
|
|
import Nix.Expr.Types
|
|
import Nix.Parser.Library (Delta(..))
|
|
import Nix.Scope
|
|
import {-# SOURCE #-} Nix.Stack
|
|
import Nix.Thunk
|
|
import Nix.Utils
|
|
|
|
newtype NThunk m = NThunk (Thunk m (NValue m))
|
|
|
|
thunk :: MonadVar m => m (NValue m) -> m (NThunk m)
|
|
thunk = fmap coerce . buildThunk
|
|
|
|
repeatingThunk :: MonadVar m => m (NValue m) -> NThunk m
|
|
repeatingThunk = coerce . buildRepeatingThunk
|
|
|
|
force :: (Framed e m, MonadFile m, MonadVar m)
|
|
=> NThunk m -> (NValue m -> m r) -> m r
|
|
force = forceThunk . coerce
|
|
|
|
valueThunk :: forall m. NValue m -> NThunk m
|
|
valueThunk = coerce . valueRef @_ @m
|
|
|
|
-- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation
|
|
-- is completed.
|
|
data NValueF m r
|
|
= NVConstant NAtom
|
|
-- | A string has a value and a context, which can be used to record what a
|
|
-- string has been build from
|
|
| NVStr Text (DList Text)
|
|
| NVList [r]
|
|
| NVSet (HashMap Text r) (HashMap Text Delta)
|
|
| NVClosure (Scopes m r) (Params (m r)) (m r)
|
|
-- ^ A function is a closed set of parameters representing the "call
|
|
-- signature", used at application time to check the type of arguments
|
|
-- passed to the function. Since it supports default values which may
|
|
-- depend on other values within the final argument set, this
|
|
-- dependency is represented as a set of pending evaluations. The
|
|
-- arguments are finally normalized into a set which is passed to the
|
|
-- function.
|
|
--
|
|
-- Note that 'm r' is being used here because effectively a function
|
|
-- and its set of default arguments is "never fully evaluated". This
|
|
-- enforces in the type that it must be re-evaluated for each call.
|
|
| NVLiteralPath FilePath
|
|
| NVEnvPath FilePath
|
|
| NVBuiltin String (NThunk m -> m (NValue m))
|
|
-- ^ A builtin function is itself already in normal form. Also, it may
|
|
-- or may not choose to evaluate its argument in the production of a
|
|
-- result.
|
|
deriving (Generic, Typeable, Functor)
|
|
|
|
-- | An 'NValueNF' is a fully evaluated value in normal form. An 'NValue m' is
|
|
-- a value in head normal form, where only the "top layer" has been
|
|
-- evaluated. An action of type 'm (NValue m)' is a pending evualation that
|
|
-- has yet to be performed. An 'NThunk m' is either a pending evaluation, or
|
|
-- a value in head normal form. A 'ValueSet' is a set of mappings from keys
|
|
-- to thunks.
|
|
|
|
type NValueNF m = Fix (NValueF m) -- normal form
|
|
type NValue m = NValueF m (NThunk m) -- head normal form
|
|
type ValueSet m = HashMap Text (NThunk m)
|
|
|
|
instance Show (NThunk m) where
|
|
show (NThunk (Value v)) = show v
|
|
show (NThunk _) = "<thunk>"
|
|
|
|
instance Show f => Show (NValueF m f) where
|
|
showsPrec = flip go where
|
|
go (NVConstant atom) = showsCon1 "NVConstant" atom
|
|
go (NVStr text context) = showsCon2 "NVStr" text (appEndo context [])
|
|
go (NVList list) = showsCon1 "NVList" list
|
|
go (NVSet attrs _) = showsCon1 "NVSet" attrs
|
|
go (NVClosure s r _) = showsCon2 "NVClosure" s (() <$ r)
|
|
go (NVLiteralPath p) = showsCon1 "NVLiteralPath" p
|
|
go (NVEnvPath p) = showsCon1 "NVEnvPath" p
|
|
go (NVBuiltin name _) = showsCon1 "NVBuiltin" name
|
|
|
|
showsCon1 :: Show a => String -> a -> Int -> String -> String
|
|
showsCon1 con a d =
|
|
showParen (d > 10) $ showString (con ++ " ") . showsPrec 11 a
|
|
|
|
showsCon2 :: (Show a, Show b)
|
|
=> String -> a -> b -> Int -> String -> String
|
|
showsCon2 con a b d =
|
|
showParen (d > 10)
|
|
$ showString (con ++ " ")
|
|
. showsPrec 11 a
|
|
. showString " "
|
|
. showsPrec 11 b
|