{-# language CPP #-}
{-# language DeriveAnyClass #-}
{-# language KindSignatures #-}
{-# language ConstraintKinds #-}
{-# language PatternSynonyms #-}
{-# language RankNTypes #-}
{-# language TemplateHaskell #-}

{-# options_ghc -Wno-missing-signatures #-}
{-# options_ghc -Wno-missing-pattern-synonym-signatures #-}

-- | The core of the type system, Nix language values
module Nix.Value
where

import           Nix.Prelude
import           Control.Comonad                ( Comonad
                                                , extract
                                                )
import           Control.Monad.Free             ( Free(..)
                                                , hoistFree
                                                , iter
                                                , iterM
                                                )
import qualified Data.Aeson                    as Aeson
import           Data.Functor.Classes           ( Show1
                                                , liftShowsPrec
                                                , showsUnaryWith
                                                , Eq1(liftEq) )
import qualified Text.Show
import           Text.Show                      ( showsPrec
                                                , showString
                                                , showParen
                                                )
import           Lens.Family2.Stock             ( _2 )
import           Lens.Family2.TH                ( makeTraversals
                                                , makeLenses
                                                )
import           Nix.Atoms
import           Nix.Expr.Types
import           Nix.String
import           Nix.Thunk


-- * @__NValueF__@: Base functor (F)

-- | An NValueF p m r represents all the possible types of Nix values.
--
--   Is is the base functor to form the Free monad of nix expressions.
--   The parameter `r` represents Nix values in their final form (NValue).
--   The parameter `p` represents exactly the same type, but is kept separate
--   or it would prevent NValueF from being a proper functor.
--   It is intended to be hard-coded to the same final type as r.
--   `m` is the monad in which evaluations will run.

-- | An NValue' t f m a is a magic layer between NValueF and the Free monad construction.
--
--   It fixes the `p` parameter of NValueF to the final NValue type, making the
--   definition of NValue' and NValue depend on each other in a recursive
--   fashion.
--
--   It also introduces a `f` parameter for a custom functor that can be used
--   to wrap each intermediate value in the reduced expression tree.
--   This is where expression evaluations can store annotations and other
--   useful information.
--
--   `t` is not really used here, but is needed to type the (NValue t f m)
--   used to tie the knot of the `p` parameter in the inner NValueF.
--
--   `a` is will be an `NValue t f m` when NValue' functor is turned into a
--   Free monad.

-- | 'NValue t f m' is the most reduced form of a 'NExpr' after evaluation is
--   completed. It is a layer cake of NValueF base values, wrapped in the f
--   functor and into the Free recursive construction.
--
--   Concretely, an NValue t f m can either be a thunk, representing a value
--   yet to be evaluated (Pure t), or a know value in WHNF
--   (Free (NValue' t f m (NValue t f m))) = (Free (f (NValueF NValue m NValue))
--   That is, a base value type, wrapped into the generic `f`
--   functor, and based on other NValue's, which can in turn be either thunks,
--   or more already WHNF evaluated values.
--
--   As an example, the value `[1]` will be represented as
--
--   Free (f (NVListF [
--      (Free (f (NVConstantF (NInt 1))))
--   ]))
--
--   Should this 1 be a laziy and yet unevaluated value, it would be represented as
--
--   Free (f (NVListF [ (Pure t) ]))
--
--   Where the t is evaluator dependant, and should contain anough information
--   to be evaluated to an NValue when needed. `demand` of `force` are used to
--   turn a potential thunk into a `m (NValue t f m)`.
--
--   Of course, trees can be much bigger.
--
--   The number of layers and type aliases for similar things is huge, so
--   this module provides ViewPatterns for each NValueF constructor.
--
--   For example, the pattern NVStr' ns matches a NValue' containing an NVStrF,
--   and bind that NVStrF to ns, ignoring the f functor inside.
--   Similarly, the pattern NVStr ns (without prime mark) will match the inner
--   NVstrF value inside an NValue. Of course, the patterns are declined for
--   all the NValueF constructors. The non primed version also has an NVThunk t
--   pattern to account for the possibility of an NValue to no be fully
--   evaluated yet, as opposed to an NValue'.

data NValueF p m r
    = NVConstantF NAtom
     -- | A string has a value and a context, which can be used to record what a
     -- string has been build from
    | NVStrF NixString
    | NVPathF Path
    | NVListF [r]
    | NVSetF PositionSet (AttrSet r)
      -- ^
      --   Quite frequently actions/processing happens with values
      --   (for example - forcing of values & recreation of the monad),
      --   but @SourcePos@ does not change then.
    | NVClosureF (Params ()) (p -> 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.
    | NVBuiltinF VarName (p -> m r)
      -- ^ 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 ((forall x. NValueF p m r -> Rep (NValueF p m r) x)
-> (forall x. Rep (NValueF p m r) x -> NValueF p m r)
-> Generic (NValueF p m r)
forall x. Rep (NValueF p m r) x -> NValueF p m r
forall x. NValueF p m r -> Rep (NValueF p m r) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall p (m :: * -> *) r x. Rep (NValueF p m r) x -> NValueF p m r
forall p (m :: * -> *) r x. NValueF p m r -> Rep (NValueF p m r) x
$cfrom :: forall p (m :: * -> *) r x. NValueF p m r -> Rep (NValueF p m r) x
from :: forall x. NValueF p m r -> Rep (NValueF p m r) x
$cto :: forall p (m :: * -> *) r x. Rep (NValueF p m r) x -> NValueF p m r
to :: forall x. Rep (NValueF p m r) x -> NValueF p m r
Generic, Typeable, (forall a b. (a -> b) -> NValueF p m a -> NValueF p m b)
-> (forall a b. a -> NValueF p m b -> NValueF p m a)
-> Functor (NValueF p m)
forall a b. a -> NValueF p m b -> NValueF p m a
forall a b. (a -> b) -> NValueF p m a -> NValueF p m b
forall p (m :: * -> *) a b.
Functor m =>
a -> NValueF p m b -> NValueF p m a
forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> NValueF p m a -> NValueF p m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> NValueF p m a -> NValueF p m b
fmap :: forall a b. (a -> b) -> NValueF p m a -> NValueF p m b
$c<$ :: forall p (m :: * -> *) a b.
Functor m =>
a -> NValueF p m b -> NValueF p m a
<$ :: forall a b. a -> NValueF p m b -> NValueF p m a
Functor)


-- ** Eq

instance Eq r => Eq (NValueF p m r) where
  == :: NValueF p m r -> NValueF p m r -> Bool
(==) (NVConstantF NAtom
x) (NVConstantF NAtom
y) = NAtom
x NAtom -> NAtom -> Bool
forall a. Eq a => a -> a -> Bool
== NAtom
y
  (==) (NVStrF      NixString
x) (NVStrF      NixString
y) = NixString
x NixString -> NixString -> Bool
forall a. Eq a => a -> a -> Bool
== NixString
y
  (==) (NVPathF     Path
x) (NVPathF     Path
y) = Path
x Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
y
  (==) (NVListF     [r]
x) (NVListF     [r]
y) = [r]
x [r] -> [r] -> Bool
forall a. Eq a => a -> a -> Bool
== [r]
y
  (==) (NVSetF  PositionSet
_   AttrSet r
x) (NVSetF PositionSet
_    AttrSet r
y) = AttrSet r
x AttrSet r -> AttrSet r -> Bool
forall a. Eq a => a -> a -> Bool
== AttrSet r
y
  (==) NValueF p m r
_               NValueF p m r
_               = Bool
False

-- ** Eq1

instance Eq1 (NValueF p m) where
  liftEq :: forall a b.
(a -> b -> Bool) -> NValueF p m a -> NValueF p m b -> Bool
liftEq a -> b -> Bool
_  (NVConstantF NAtom
x) (NVConstantF NAtom
y) = NAtom
x NAtom -> NAtom -> Bool
forall a. Eq a => a -> a -> Bool
== NAtom
y
  liftEq a -> b -> Bool
_  (NVStrF      NixString
x) (NVStrF      NixString
y) = NixString
x NixString -> NixString -> Bool
forall a. Eq a => a -> a -> Bool
== NixString
y
  liftEq a -> b -> Bool
_  (NVPathF     Path
x) (NVPathF     Path
y) = Path
x Path -> Path -> Bool
forall a. Eq a => a -> a -> Bool
== Path
y
  liftEq a -> b -> Bool
eq (NVListF     [a]
x) (NVListF     [b]
y) = (a -> b -> Bool) -> [a] -> [b] -> Bool
forall a b. (a -> b -> Bool) -> [a] -> [b] -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq [a]
x [b]
y
  liftEq a -> b -> Bool
eq (NVSetF  PositionSet
_   AttrSet a
x) (NVSetF PositionSet
_    AttrSet b
y) = (a -> b -> Bool) -> AttrSet a -> AttrSet b -> Bool
forall a b.
(a -> b -> Bool) -> HashMap VarName a -> HashMap VarName b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq AttrSet a
x AttrSet b
y
  liftEq a -> b -> Bool
_  NValueF p m a
_               NValueF p m b
_               = Bool
False


-- ** Show

instance Show r => Show (NValueF p m r) where
  showsPrec :: Int -> NValueF p m r -> ShowS
showsPrec Int
d =
    \case
      (NVConstantF NAtom
atom     ) -> String -> NAtom -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVConstant" NAtom
atom
      (NVStrF      NixString
ns       ) -> String -> Text -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVStr"      (Text -> ShowS) -> Text -> ShowS
forall a b. (a -> b) -> a -> b
$ NixString -> Text
ignoreContext NixString
ns
      (NVListF     [r]
lst      ) -> String -> [r] -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVList"     [r]
lst
      (NVSetF      PositionSet
_   AttrSet r
attrs) -> String -> AttrSet r -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVSet"      AttrSet r
attrs
      (NVClosureF  Params ()
params p -> m r
_ ) -> String -> Params () -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVClosure"  Params ()
params
      (NVPathF     Path
path     ) -> String -> Path -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVPath"     Path
path
      (NVBuiltinF  VarName
name   p -> m r
_ ) -> String -> VarName -> ShowS
forall a. Show a => String -> a -> ShowS
showsCon1 String
"NVBuiltin"  VarName
name
   where
    showsCon1 :: Show a => String -> a -> String -> String
    showsCon1 :: forall a. Show a => String -> a -> ShowS
showsCon1 String
con a
a =
      Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String
con String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
" ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 a
a


-- ** Foldable

-- | Folds what the value is known to contain at time of fold.
instance Foldable (NValueF p m) where
  foldMap :: forall m a. Monoid m => (a -> m) -> NValueF p m a -> m
foldMap a -> m
f = \case
    NVConstantF NAtom
_  -> m
forall a. Monoid a => a
mempty
    NVStrF      NixString
_  -> m
forall a. Monoid a => a
mempty
    NVPathF     Path
_  -> m
forall a. Monoid a => a
mempty
    NVClosureF Params ()
_ p -> m a
_ -> m
forall a. Monoid a => a
mempty
    NVBuiltinF VarName
_ p -> m a
_ -> m
forall a. Monoid a => a
mempty
    NVListF     [a]
l  -> (a -> m) -> [a] -> m
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
l
    NVSetF     PositionSet
_ AttrSet a
s -> (a -> m) -> AttrSet a -> m
forall m a. Monoid m => (a -> m) -> HashMap VarName a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AttrSet a
s


-- ** Traversable

-- | @sequence@
sequenceNValueF
  :: (Functor n, Monad m, Applicative n)
  => (forall x . n x -> m x)
  -> NValueF p m (n a)
  -> n (NValueF p m a)
sequenceNValueF :: forall (n :: * -> *) (m :: * -> *) p a.
(Functor n, Monad m, Applicative n) =>
(forall x. n x -> m x) -> NValueF p m (n a) -> n (NValueF p m a)
sequenceNValueF forall x. n x -> m x
transform = \case
  NVConstantF NAtom
a  -> NValueF p m a -> n (NValueF p m a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m a -> n (NValueF p m a))
-> NValueF p m a -> n (NValueF p m a)
forall a b. (a -> b) -> a -> b
$ NAtom -> NValueF p m a
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
a
  NVStrF      NixString
s  -> NValueF p m a -> n (NValueF p m a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m a -> n (NValueF p m a))
-> NValueF p m a -> n (NValueF p m a)
forall a b. (a -> b) -> a -> b
$ NixString -> NValueF p m a
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
s
  NVPathF     Path
p  -> NValueF p m a -> n (NValueF p m a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m a -> n (NValueF p m a))
-> NValueF p m a -> n (NValueF p m a)
forall a b. (a -> b) -> a -> b
$ Path -> NValueF p m a
forall p (m :: * -> *) r. Path -> NValueF p m r
NVPathF Path
p
  NVListF     [n a]
l  -> [a] -> NValueF p m a
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF ([a] -> NValueF p m a) -> n [a] -> n (NValueF p m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [n a] -> n [a]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA [n a]
l
  NVSetF     PositionSet
p AttrSet (n a)
s -> PositionSet -> AttrSet a -> NValueF p m a
forall p (m :: * -> *) r. PositionSet -> AttrSet r -> NValueF p m r
NVSetF PositionSet
p (AttrSet a -> NValueF p m a) -> n (AttrSet a) -> n (NValueF p m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> AttrSet (n a) -> n (AttrSet a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a.
Applicative f =>
HashMap VarName (f a) -> f (HashMap VarName a)
sequenceA AttrSet (n a)
s
  NVClosureF Params ()
p p -> m (n a)
g -> NValueF p m a -> n (NValueF p m a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m a -> n (NValueF p m a))
-> NValueF p m a -> n (NValueF p m a)
forall a b. (a -> b) -> a -> b
$ Params () -> (p -> m a) -> NValueF p m a
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
p (n a -> m a
forall x. n x -> m x
transform (n a -> m a) -> (p -> m (n a)) -> p -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< p -> m (n a)
g)
  NVBuiltinF VarName
s p -> m (n a)
g -> NValueF p m a -> n (NValueF p m a)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m a -> n (NValueF p m a))
-> NValueF p m a -> n (NValueF p m a)
forall a b. (a -> b) -> a -> b
$ VarName -> (p -> m a) -> NValueF p m a
forall p (m :: * -> *) r. VarName -> (p -> m r) -> NValueF p m r
NVBuiltinF VarName
s (n a -> m a
forall x. n x -> m x
transform (n a -> m a) -> (p -> m (n a)) -> p -> m a
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< p -> m (n a)
g)


-- ** Monad

-- | @bind@
bindNValueF
  :: (Monad m, Monad n)
  => (forall x . n x -> m x) -- ^ Transform @n@ into @m@.
  -> (a -> n b) -- ^ A Kleisli arrow (see 'Control.Arrow.Kleisli' & Kleisli catagory).
  -> NValueF p m a -- ^ "Unfixed" (openly recursive) value of an embedded Nix language.
  -> n (NValueF p m b) -- ^ An implementation of @transform (f =<< x)@ for embedded Nix language values.
bindNValueF :: forall (m :: * -> *) (n :: * -> *) a b p.
(Monad m, Monad n) =>
(forall x. n x -> m x)
-> (a -> n b) -> NValueF p m a -> n (NValueF p m b)
bindNValueF forall x. n x -> m x
transform a -> n b
f = \case
  NVConstantF NAtom
a  -> NValueF p m b -> n (NValueF p m b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m b -> n (NValueF p m b))
-> NValueF p m b -> n (NValueF p m b)
forall a b. (a -> b) -> a -> b
$ NAtom -> NValueF p m b
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
a
  NVStrF      NixString
s  -> NValueF p m b -> n (NValueF p m b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m b -> n (NValueF p m b))
-> NValueF p m b -> n (NValueF p m b)
forall a b. (a -> b) -> a -> b
$ NixString -> NValueF p m b
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
s
  NVPathF     Path
p  -> NValueF p m b -> n (NValueF p m b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m b -> n (NValueF p m b))
-> NValueF p m b -> n (NValueF p m b)
forall a b. (a -> b) -> a -> b
$ Path -> NValueF p m b
forall p (m :: * -> *) r. Path -> NValueF p m r
NVPathF Path
p
  NVListF     [a]
l  -> [b] -> NValueF p m b
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF ([b] -> NValueF p m b) -> n [b] -> n (NValueF p m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> n b) -> [a] -> n [b]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse a -> n b
f [a]
l
  NVSetF     PositionSet
p AttrSet a
s -> PositionSet -> AttrSet b -> NValueF p m b
forall p (m :: * -> *) r. PositionSet -> AttrSet r -> NValueF p m r
NVSetF PositionSet
p (AttrSet b -> NValueF p m b) -> n (AttrSet b) -> n (NValueF p m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> n b) -> AttrSet a -> n (AttrSet b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashMap VarName a -> f (HashMap VarName b)
traverse a -> n b
f AttrSet a
s
  NVClosureF Params ()
p p -> m a
g -> NValueF p m b -> n (NValueF p m b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m b -> n (NValueF p m b))
-> NValueF p m b -> n (NValueF p m b)
forall a b. (a -> b) -> a -> b
$ Params () -> (p -> m b) -> NValueF p m b
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
p (n b -> m b
forall x. n x -> m x
transform (n b -> m b) -> (a -> n b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> n b
f (a -> m b) -> (p -> m a) -> p -> m b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< p -> m a
g)
  NVBuiltinF VarName
s p -> m a
g -> NValueF p m b -> n (NValueF p m b)
forall a. a -> n a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF p m b -> n (NValueF p m b))
-> NValueF p m b -> n (NValueF p m b)
forall a b. (a -> b) -> a -> b
$ VarName -> (p -> m b) -> NValueF p m b
forall p (m :: * -> *) r. VarName -> (p -> m r) -> NValueF p m r
NVBuiltinF VarName
s (n b -> m b
forall x. n x -> m x
transform (n b -> m b) -> (a -> n b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> n b
f (a -> m b) -> (p -> m a) -> p -> m b
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< p -> m a
g)


-- *** MonadTrans

-- | @lift@
liftNValueF
  :: (MonadTrans u, Monad m)
  => NValueF p m a
  -> NValueF p (u m) a
liftNValueF :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) p a.
(MonadTrans u, Monad m) =>
NValueF p m a -> NValueF p (u m) a
liftNValueF = (forall x. m x -> u m x) -> NValueF p m a -> NValueF p (u m) a
forall (m :: * -> *) (n :: * -> *) p a.
(forall x. m x -> n x) -> NValueF p m a -> NValueF p n a
hoistNValueF m x -> u m x
forall x. m x -> u m x
forall (m :: * -> *) a. Monad m => m a -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- **** MonadTransUnlift

-- | @unlift@
unliftNValueF
  :: (MonadTrans u, Monad m)
  => (forall x . u m x -> m x)
  -> NValueF p (u m) a
  -> NValueF p m a
unliftNValueF :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) p a.
(MonadTrans u, Monad m) =>
(forall x. u m x -> m x) -> NValueF p (u m) a -> NValueF p m a
unliftNValueF = (forall x. u m x -> m x) -> NValueF p (u m) a -> NValueF p m a
forall (m :: * -> *) (n :: * -> *) p a.
(forall x. m x -> n x) -> NValueF p m a -> NValueF p n a
hoistNValueF

-- **** Utils

-- | Back & forth hoisting in the monad stack
hoistNValueF
  :: (forall x . m x -> n x)
  -> NValueF p m a
  -> NValueF p n a
hoistNValueF :: forall (m :: * -> *) (n :: * -> *) p a.
(forall x. m x -> n x) -> NValueF p m a -> NValueF p n a
hoistNValueF forall x. m x -> n x
lft =
  \case
    -- Pass-through the:
    --   [ NVConstantF a
    --   , NVStrF s
    --   , NVPathF p
    --   , NVListF l
    --   , NVSetF p s
    --   ]
    NVConstantF NAtom
a  -> NAtom -> NValueF p n a
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
a
    NVStrF      NixString
s  -> NixString -> NValueF p n a
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
s
    NVPathF     Path
p  -> Path -> NValueF p n a
forall p (m :: * -> *) r. Path -> NValueF p m r
NVPathF Path
p
    NVListF     [a]
l  -> [a] -> NValueF p n a
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [a]
l
    NVSetF     PositionSet
p AttrSet a
s -> PositionSet -> AttrSet a -> NValueF p n a
forall p (m :: * -> *) r. PositionSet -> AttrSet r -> NValueF p m r
NVSetF PositionSet
p AttrSet a
s
    NVBuiltinF VarName
s p -> m a
g -> VarName -> (p -> n a) -> NValueF p n a
forall p (m :: * -> *) r. VarName -> (p -> m r) -> NValueF p m r
NVBuiltinF VarName
s (m a -> n a
forall x. m x -> n x
lft (m a -> n a) -> (p -> m a) -> p -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> m a
g)
    NVClosureF Params ()
p p -> m a
g -> Params () -> (p -> n a) -> NValueF p n a
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
p (m a -> n a
forall x. m x -> n x
lft (m a -> n a) -> (p -> m a) -> p -> n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. p -> m a
g)
{-# inline hoistNValueF #-}

-- * @__NValue'__@: forming the (F(A))

-- | NVConstraint constraint the f layer in @NValue'@.
-- It makes bijection between sub category of Hask and Nix Value possible.
-- 'Comonad' enable Nix Value to Hask part.
-- 'Applicative' enable Hask to Nix Value part.
type NVConstraint f = (Comonad f, Applicative f)

-- | At the time of constructor, the expected arguments to closures are values
--   that may contain thunks. The type of such thunks are fixed at that time.
newtype NValue' t f m a =
  NValue'
    {
    -- | Applying F-algebra Base functor data type (@NValueF@) to the F-algebra carrier (@NValue@), forming the \( F(A)-> A \)).
    forall t (f :: * -> *) (m :: * -> *) a.
NValue' t f m a -> f (NValueF (NValue t f m) m a)
_nValue :: f (NValueF (NValue t f m) m a)
    }
  deriving ((forall x. NValue' t f m a -> Rep (NValue' t f m a) x)
-> (forall x. Rep (NValue' t f m a) x -> NValue' t f m a)
-> Generic (NValue' t f m a)
forall x. Rep (NValue' t f m a) x -> NValue' t f m a
forall x. NValue' t f m a -> Rep (NValue' t f m a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall t (f :: * -> *) (m :: * -> *) a x.
Rep (NValue' t f m a) x -> NValue' t f m a
forall t (f :: * -> *) (m :: * -> *) a x.
NValue' t f m a -> Rep (NValue' t f m a) x
$cfrom :: forall t (f :: * -> *) (m :: * -> *) a x.
NValue' t f m a -> Rep (NValue' t f m a) x
from :: forall x. NValue' t f m a -> Rep (NValue' t f m a) x
$cto :: forall t (f :: * -> *) (m :: * -> *) a x.
Rep (NValue' t f m a) x -> NValue' t f m a
to :: forall x. Rep (NValue' t f m a) x -> NValue' t f m a
Generic, Typeable, (forall a b. (a -> b) -> NValue' t f m a -> NValue' t f m b)
-> (forall a b. a -> NValue' t f m b -> NValue' t f m a)
-> Functor (NValue' t f m)
forall a b. a -> NValue' t f m b -> NValue' t f m a
forall a b. (a -> b) -> NValue' t f m a -> NValue' t f m b
forall t (f :: * -> *) (m :: * -> *) a b.
(Functor f, Functor m) =>
a -> NValue' t f m b -> NValue' t f m a
forall t (f :: * -> *) (m :: * -> *) a b.
(Functor f, Functor m) =>
(a -> b) -> NValue' t f m a -> NValue' t f m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall t (f :: * -> *) (m :: * -> *) a b.
(Functor f, Functor m) =>
(a -> b) -> NValue' t f m a -> NValue' t f m b
fmap :: forall a b. (a -> b) -> NValue' t f m a -> NValue' t f m b
$c<$ :: forall t (f :: * -> *) (m :: * -> *) a b.
(Functor f, Functor m) =>
a -> NValue' t f m b -> NValue' t f m a
<$ :: forall a b. a -> NValue' t f m b -> NValue' t f m a
Functor, (forall m. Monoid m => NValue' t f m m -> m)
-> (forall m a. Monoid m => (a -> m) -> NValue' t f m a -> m)
-> (forall m a. Monoid m => (a -> m) -> NValue' t f m a -> m)
-> (forall a b. (a -> b -> b) -> b -> NValue' t f m a -> b)
-> (forall a b. (a -> b -> b) -> b -> NValue' t f m a -> b)
-> (forall b a. (b -> a -> b) -> b -> NValue' t f m a -> b)
-> (forall b a. (b -> a -> b) -> b -> NValue' t f m a -> b)
-> (forall a. (a -> a -> a) -> NValue' t f m a -> a)
-> (forall a. (a -> a -> a) -> NValue' t f m a -> a)
-> (forall a. NValue' t f m a -> [a])
-> (forall a. NValue' t f m a -> Bool)
-> (forall a. NValue' t f m a -> Int)
-> (forall a. Eq a => a -> NValue' t f m a -> Bool)
-> (forall a. Ord a => NValue' t f m a -> a)
-> (forall a. Ord a => NValue' t f m a -> a)
-> (forall a. Num a => NValue' t f m a -> a)
-> (forall a. Num a => NValue' t f m a -> a)
-> Foldable (NValue' t f m)
forall a. Eq a => a -> NValue' t f m a -> Bool
forall a. Num a => NValue' t f m a -> a
forall a. Ord a => NValue' t f m a -> a
forall m. Monoid m => NValue' t f m m -> m
forall a. NValue' t f m a -> Bool
forall a. NValue' t f m a -> Int
forall a. NValue' t f m a -> [a]
forall a. (a -> a -> a) -> NValue' t f m a -> a
forall m a. Monoid m => (a -> m) -> NValue' t f m a -> m
forall b a. (b -> a -> b) -> b -> NValue' t f m a -> b
forall a b. (a -> b -> b) -> b -> NValue' t f m a -> b
forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Eq a) =>
a -> NValue' t f m a -> Bool
forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Num a) =>
NValue' t f m a -> a
forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Ord a) =>
NValue' t f m a -> a
forall t (f :: * -> *) (m :: * -> *) m.
(Foldable f, Monoid m) =>
NValue' t f m m -> m
forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> Bool
forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> Int
forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> [a]
forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
(a -> a -> a) -> NValue' t f m a -> a
forall t (f :: * -> *) (m :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> NValue' t f m a -> m
forall t (f :: * -> *) (m :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> NValue' t f m a -> b
forall t (f :: * -> *) (m :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> NValue' t f m 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
$cfold :: forall t (f :: * -> *) (m :: * -> *) m.
(Foldable f, Monoid m) =>
NValue' t f m m -> m
fold :: forall m. Monoid m => NValue' t f m m -> m
$cfoldMap :: forall t (f :: * -> *) (m :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> NValue' t f m a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> NValue' t f m a -> m
$cfoldMap' :: forall t (f :: * -> *) (m :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> NValue' t f m a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> NValue' t f m a -> m
$cfoldr :: forall t (f :: * -> *) (m :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> NValue' t f m a -> b
foldr :: forall a b. (a -> b -> b) -> b -> NValue' t f m a -> b
$cfoldr' :: forall t (f :: * -> *) (m :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> NValue' t f m a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> NValue' t f m a -> b
$cfoldl :: forall t (f :: * -> *) (m :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> NValue' t f m a -> b
foldl :: forall b a. (b -> a -> b) -> b -> NValue' t f m a -> b
$cfoldl' :: forall t (f :: * -> *) (m :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> NValue' t f m a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> NValue' t f m a -> b
$cfoldr1 :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
(a -> a -> a) -> NValue' t f m a -> a
foldr1 :: forall a. (a -> a -> a) -> NValue' t f m a -> a
$cfoldl1 :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
(a -> a -> a) -> NValue' t f m a -> a
foldl1 :: forall a. (a -> a -> a) -> NValue' t f m a -> a
$ctoList :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> [a]
toList :: forall a. NValue' t f m a -> [a]
$cnull :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> Bool
null :: forall a. NValue' t f m a -> Bool
$clength :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> Int
length :: forall a. NValue' t f m a -> Int
$celem :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Eq a) =>
a -> NValue' t f m a -> Bool
elem :: forall a. Eq a => a -> NValue' t f m a -> Bool
$cmaximum :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Ord a) =>
NValue' t f m a -> a
maximum :: forall a. Ord a => NValue' t f m a -> a
$cminimum :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Ord a) =>
NValue' t f m a -> a
minimum :: forall a. Ord a => NValue' t f m a -> a
$csum :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Num a) =>
NValue' t f m a -> a
sum :: forall a. Num a => NValue' t f m a -> a
$cproduct :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Num a) =>
NValue' t f m a -> a
product :: forall a. Num a => NValue' t f m a -> a
Foldable)

instance (NVConstraint f, Show a) => Show (NValue' t f m a) where
  show :: NValue' t f m a -> String
show (NValue' (f (NValueF (NValue t f m) m a) -> NValueF (NValue t f m) m a
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m a
v)) = NValueF (NValue t f m) m a -> String
forall b a. (Show a, IsString b) => a -> b
show NValueF (NValue t f m) m a
v


-- ** Show1

instance NVConstraint f  => Show1 (NValue' t f m) where
  liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NValue' t f m a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p = \case
    NVConstant' NAtom
atom  -> (Int -> NAtom -> ShowS) -> String -> Int -> NAtom -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> NAtom -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec             String
"NVConstantF" Int
p NAtom
atom
    NVStr' NixString
ns         -> (Int -> Text -> ShowS) -> String -> Int -> Text -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec             String
"NVStrF"      Int
p (Text -> ShowS) -> Text -> ShowS
forall a b. (a -> b) -> a -> b
$ NixString -> Text
ignoreContext NixString
ns
    NVList' [a]
lst       -> (Int -> [a] -> ShowS) -> String -> Int -> [a] -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
forall a.
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> [a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"NVListF"     Int
p [a]
lst
    NVSet'  PositionSet
_   AttrSet a
attrs -> (Int -> AttrSet a -> ShowS) -> String -> Int -> AttrSet a -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> AttrSet a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> HashMap VarName a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) String
"NVSetF"      Int
p AttrSet a
attrs
    NVPath' Path
path      -> (Int -> Path -> ShowS) -> String -> Int -> Path -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> Path -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec             String
"NVPathF"     Int
p Path
path
    NVClosure' Params ()
c    NValue t f m -> m a
_ -> (Int -> Params () -> ShowS) -> String -> Int -> Params () -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> Params () -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec             String
"NVClosureF"  Int
p Params ()
c
    NVBuiltin' VarName
name NValue t f m -> m a
_ -> (Int -> VarName -> ShowS) -> String -> Int -> VarName -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> VarName -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec             String
"NVBuiltinF"  Int
p VarName
name


-- ** Traversable

-- | @sequence@
sequenceNValue'
  :: (Functor n, Traversable f, Monad m, Applicative n)
  => (forall x . n x -> m x)
  -> NValue' t f m (n a)
  -> n (NValue' t f m a)
sequenceNValue' :: forall (n :: * -> *) (f :: * -> *) (m :: * -> *) t a.
(Functor n, Traversable f, Monad m, Applicative n) =>
(forall x. n x -> m x)
-> NValue' t f m (n a) -> n (NValue' t f m a)
sequenceNValue' forall x. n x -> m x
transform (NValue' f (NValueF (NValue t f m) m (n a))
v) =
  f (NValueF (NValue t f m) m a) -> NValue' t f m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (f (NValueF (NValue t f m) m a) -> NValue' t f m a)
-> n (f (NValueF (NValue t f m) m a)) -> n (NValue' t f m a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NValueF (NValue t f m) m (n a) -> n (NValueF (NValue t f m) m a))
-> f (NValueF (NValue t f m) m (n a))
-> n (f (NValueF (NValue t f m) m a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((forall x. n x -> m x)
-> NValueF (NValue t f m) m (n a) -> n (NValueF (NValue t f m) m a)
forall (n :: * -> *) (m :: * -> *) p a.
(Functor n, Monad m, Applicative n) =>
(forall x. n x -> m x) -> NValueF p m (n a) -> n (NValueF p m a)
sequenceNValueF n x -> m x
forall x. n x -> m x
transform) f (NValueF (NValue t f m) m (n a))
v


-- ** Profunctor

-- | @lmap@
lmapNValueF :: Functor m => (b -> a) -> NValueF a m r -> NValueF b m r
lmapNValueF :: forall (m :: * -> *) b a r.
Functor m =>
(b -> a) -> NValueF a m r -> NValueF b m r
lmapNValueF b -> a
f = \case
  NVConstantF NAtom
a  -> NAtom -> NValueF b m r
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
a
  NVStrF      NixString
s  -> NixString -> NValueF b m r
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
s
  NVPathF     Path
p  -> Path -> NValueF b m r
forall p (m :: * -> *) r. Path -> NValueF p m r
NVPathF Path
p
  NVListF     [r]
l  -> [r] -> NValueF b m r
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [r]
l
  NVSetF     PositionSet
p AttrSet r
s -> PositionSet -> AttrSet r -> NValueF b m r
forall p (m :: * -> *) r. PositionSet -> AttrSet r -> NValueF p m r
NVSetF PositionSet
p AttrSet r
s
  NVClosureF Params ()
p a -> m r
g -> Params () -> (b -> m r) -> NValueF b m r
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
p (a -> m r
g (a -> m r) -> (b -> a) -> b -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)
  NVBuiltinF VarName
s a -> m r
g -> VarName -> (b -> m r) -> NValueF b m r
forall p (m :: * -> *) r. VarName -> (p -> m r) -> NValueF p m r
NVBuiltinF VarName
s (a -> m r
g (a -> m r) -> (b -> a) -> b -> m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> a
f)


-- ** Free

-- | @iter@
iterNValue'
  :: forall t f m a r
   . MonadDataContext f m
  => ((NValue' t f m a -> r) -> a -> r)
  -> (NValue' t f m r -> r)
  -> NValue' t f m a
  -> r
iterNValue' :: forall t (f :: * -> *) (m :: * -> *) a r.
MonadDataContext f m =>
((NValue' t f m a -> r) -> a -> r)
-> (NValue' t f m r -> r) -> NValue' t f m a -> r
iterNValue' (NValue' t f m a -> r) -> a -> r
k NValue' t f m r -> r
f = ((NValue' t f m a -> r) -> NValue' t f m a -> r)
-> NValue' t f m a -> r
forall a. (a -> a) -> a
fix ((NValue' t f m r -> r
f (NValue' t f m r -> r)
-> (NValue' t f m a -> NValue' t f m r) -> NValue' t f m a -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((NValue' t f m a -> NValue' t f m r) -> NValue' t f m a -> r)
-> ((NValue' t f m a -> r) -> NValue' t f m a -> NValue' t f m r)
-> (NValue' t f m a -> r)
-> NValue' t f m a
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> r) -> NValue' t f m a -> NValue' t f m r
forall a b. (a -> b) -> NValue' t f m a -> NValue' t f m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> r) -> NValue' t f m a -> NValue' t f m r)
-> ((NValue' t f m a -> r) -> a -> r)
-> (NValue' t f m a -> r)
-> NValue' t f m a
-> NValue' t f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NValue' t f m a -> r) -> a -> r
k)

-- *** Utils

-- | @hoistFree@: Back & forth hoisting in the monad stack
hoistNValue'
  :: (Functor m, Functor n, Functor f)
  => (forall x . n x -> m x)
  -> (forall x . m x -> n x)
  -> NValue' t f m a
  -> NValue' t f n a
hoistNValue' :: forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t a.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue' t f m a -> NValue' t f n a
hoistNValue' forall x. n x -> m x
run forall x. m x -> n x
lft (NValue' f (NValueF (NValue t f m) m a)
v) =
  f (NValueF (NValue t f n) n a) -> NValue' t f n a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (f (NValueF (NValue t f n) n a) -> NValue' t f n a)
-> f (NValueF (NValue t f n) n a) -> NValue' t f n a
forall a b. (a -> b) -> a -> b
$ (NValue t f n -> NValue t f m)
-> NValueF (NValue t f m) n a -> NValueF (NValue t f n) n a
forall (m :: * -> *) b a r.
Functor m =>
(b -> a) -> NValueF a m r -> NValueF b m r
lmapNValueF ((forall x. m x -> n x)
-> (forall x. n x -> m x) -> NValue t f n -> NValue t f m
forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue t f m -> NValue t f n
hoistNValue m x -> n x
forall x. m x -> n x
lft n x -> m x
forall x. n x -> m x
run) (NValueF (NValue t f m) n a -> NValueF (NValue t f n) n a)
-> (NValueF (NValue t f m) m a -> NValueF (NValue t f m) n a)
-> NValueF (NValue t f m) m a
-> NValueF (NValue t f n) n a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall x. m x -> n x)
-> NValueF (NValue t f m) m a -> NValueF (NValue t f m) n a
forall (m :: * -> *) (n :: * -> *) p a.
(forall x. m x -> n x) -> NValueF p m a -> NValueF p n a
hoistNValueF m x -> n x
forall x. m x -> n x
lft (NValueF (NValue t f m) m a -> NValueF (NValue t f n) n a)
-> f (NValueF (NValue t f m) m a) -> f (NValueF (NValue t f n) n a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (NValueF (NValue t f m) m a)
v
{-# inline hoistNValue' #-}

-- ** Monad

-- |@bind@
bindNValue'
  :: (Traversable f, Monad m, Monad n)
  => (forall x . n x -> m x)
  -> (a -> n b)
  -> NValue' t f m a
  -> n (NValue' t f m b)
bindNValue' :: forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a b t.
(Traversable f, Monad m, Monad n) =>
(forall x. n x -> m x)
-> (a -> n b) -> NValue' t f m a -> n (NValue' t f m b)
bindNValue' forall x. n x -> m x
transform a -> n b
f (NValue' f (NValueF (NValue t f m) m a)
v) =
  f (NValueF (NValue t f m) m b) -> NValue' t f m b
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (f (NValueF (NValue t f m) m b) -> NValue' t f m b)
-> n (f (NValueF (NValue t f m) m b)) -> n (NValue' t f m b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NValueF (NValue t f m) m a -> n (NValueF (NValue t f m) m b))
-> f (NValueF (NValue t f m) m a)
-> n (f (NValueF (NValue t f m) m b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((forall x. n x -> m x)
-> (a -> n b)
-> NValueF (NValue t f m) m a
-> n (NValueF (NValue t f m) m b)
forall (m :: * -> *) (n :: * -> *) a b p.
(Monad m, Monad n) =>
(forall x. n x -> m x)
-> (a -> n b) -> NValueF p m a -> n (NValueF p m b)
bindNValueF n x -> m x
forall x. n x -> m x
transform a -> n b
f) f (NValueF (NValue t f m) m a)
v

-- *** MonadTrans

-- | @lift@
liftNValue'
  :: (MonadTrans u, Monad m, Functor (u m), Functor f)
  => (forall x . u m x -> m x)
  -> NValue' t f m a
  -> NValue' t f (u m) a
liftNValue' :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) (f :: * -> *) t a.
(MonadTrans u, Monad m, Functor (u m), Functor f) =>
(forall x. u m x -> m x) -> NValue' t f m a -> NValue' t f (u m) a
liftNValue' forall x. u m x -> m x
run = (forall x. u m x -> m x)
-> (forall x. m x -> u m x)
-> NValue' t f m a
-> NValue' t f (u m) a
forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t a.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue' t f m a -> NValue' t f n a
hoistNValue' u m x -> m x
forall x. u m x -> m x
run m x -> u m x
forall x. m x -> u m x
forall (m :: * -> *) a. Monad m => m a -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift

-- **** MonadTransUnlift

-- | @unlift@
unliftNValue'
  :: (MonadTrans u, Monad m, Functor (u m), Functor f)
  => (forall x . u m x -> m x) -- aka "run"
  -> NValue' t f (u m) a
  -> NValue' t f m a
unliftNValue' :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) (f :: * -> *) t a.
(MonadTrans u, Monad m, Functor (u m), Functor f) =>
(forall x. u m x -> m x) -> NValue' t f (u m) a -> NValue' t f m a
unliftNValue' = (forall x. m x -> u m x)
-> (forall x. u m x -> m x)
-> NValue' t f (u m) a
-> NValue' t f m a
forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t a.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue' t f m a -> NValue' t f n a
hoistNValue' m x -> u m x
forall x. m x -> u m x
forall (m :: * -> *) a. Monad m => m a -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


-- ** Bijective Hask subcategory <-> @NValue'@
-- *** @F: Hask subcategory <-> NValue'@
-- #mantra#
-- $Patterns @F: Hask <-> NValue'@
--
-- Since Haskell and Nix are both recursive purely functional lazy languages.
-- And since recursion-schemes.
-- It is possible to create a direct functor between the Hask and Nix categories.
-- Or make Nix a DLS language of Haskell, embed it into a Hask, if you would like.
-- Of course, we mean: pick Hask subcategory and form Nix Category from it.
-- Take subcategory of Hask, and by applying functor to it - have a Nix Category.
-- Wouldn't it be cool and fast?
--
-- In fact - it is what we do here.
--
-- Since it is a proper way of scientific implementation, we would eventually form a
-- lawful functor.
--
-- Module pattens use @language PatternSynonyms@: bidirectional synonyms (@<-@),
-- and @ViewPatterns@: (@->@) at the same time.
-- @ViewPatterns Control.Comonad.extract@ extracts
-- from the @NValue (Free (NValueF a))@
-- the @NValueF a@. Which is @NValueF p m r@. Since it extracted from the
-- @NValue@, which is formed by \( (F a -> a) F a \) in the first place.
-- So @NValueF p m r@ which is extracted here, internally holds the next NValue.
--
-- Facts of bijection between Hask subcategory objects and Nix objects,
-- and between Hask subcategory morphisms and Nix morphisms are seen blow:


-- | Using of Nulls is generally discouraged (in programming language design et al.), but, if you need it.
pattern NVNull' :: NVConstraint w => NValue' t w m a
pattern $mNVNull' :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
NVConstraint w =>
NValue' t w m a -> ((# #) -> r) -> ((# #) -> r) -> r
$bNVNull' :: forall (w :: * -> *) t (m :: * -> *) a.
NVConstraint w =>
NValue' t w m a
NVNull' = NVConstant' NNull

-- | Haskell constant to the Nix constant,
pattern NVConstant' :: NVConstraint w => NAtom -> NValue' t w m a
pattern $mNVConstant' :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
NVConstraint w =>
NValue' t w m a -> (NAtom -> r) -> ((# #) -> r) -> r
$bNVConstant' :: forall (w :: * -> *) t (m :: * -> *) a.
NVConstraint w =>
NAtom -> NValue' t w m a
NVConstant' x <- NValue' (extract -> NVConstantF x)
  where NVConstant' = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> (NAtom -> w (NValueF (NValue t w m) m a))
-> NAtom
-> NValue' t w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> (NAtom -> NValueF (NValue t w m) m a)
-> NAtom
-> w (NValueF (NValue t w m) m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF

-- | Haskell text & context to the Nix text & context,
pattern NVStr' :: NVConstraint w => NixString -> NValue' t w m a
pattern $mNVStr' :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
NVConstraint w =>
NValue' t w m a -> (NixString -> r) -> ((# #) -> r) -> r
$bNVStr' :: forall (w :: * -> *) t (m :: * -> *) a.
NVConstraint w =>
NixString -> NValue' t w m a
NVStr' ns <- NValue' (extract -> NVStrF ns)
  where NVStr' = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> (NixString -> w (NValueF (NValue t w m) m a))
-> NixString
-> NValue' t w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> (NixString -> NValueF (NValue t w m) m a)
-> NixString
-> w (NValueF (NValue t w m) m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF

-- | Haskell @Path@ to the Nix path,
pattern NVPath' :: NVConstraint w => Path -> NValue' t w m a
pattern $mNVPath' :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
NVConstraint w =>
NValue' t w m a -> (Path -> r) -> ((# #) -> r) -> r
$bNVPath' :: forall (w :: * -> *) t (m :: * -> *) a.
NVConstraint w =>
Path -> NValue' t w m a
NVPath' x <- NValue' (extract -> NVPathF x)
  where NVPath' = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> (Path -> w (NValueF (NValue t w m) m a))
-> Path
-> NValue' t w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> (Path -> NValueF (NValue t w m) m a)
-> Path
-> w (NValueF (NValue t w m) m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. Path -> NValueF p m r
NVPathF (Path -> NValueF (NValue t w m) m a)
-> (Path -> Path) -> Path -> NValueF (NValue t w m) m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path -> Path
forall a b. Coercible a b => a -> b
coerce

-- | Haskell @[]@ to the Nix @[]@,
pattern NVList' :: NVConstraint w => [a] -> NValue' t w m a
pattern $mNVList' :: forall {r} {w :: * -> *} {a} {t} {m :: * -> *}.
NVConstraint w =>
NValue' t w m a -> ([a] -> r) -> ((# #) -> r) -> r
$bNVList' :: forall (w :: * -> *) a t (m :: * -> *).
NVConstraint w =>
[a] -> NValue' t w m a
NVList' l <- NValue' (extract -> NVListF l)
  where NVList' = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> ([a] -> w (NValueF (NValue t w m) m a))
-> [a]
-> NValue' t w m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> ([a] -> NValueF (NValue t w m) m a)
-> [a]
-> w (NValueF (NValue t w m) m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF

-- | Haskell key-value to the Nix key-value,
pattern NVSet' :: NVConstraint w => PositionSet -> AttrSet a -> NValue' t w m a
pattern $mNVSet' :: forall {r} {w :: * -> *} {a} {t} {m :: * -> *}.
NVConstraint w =>
NValue' t w m a
-> (PositionSet -> AttrSet a -> r) -> ((# #) -> r) -> r
$bNVSet' :: forall (w :: * -> *) a t (m :: * -> *).
NVConstraint w =>
PositionSet -> AttrSet a -> NValue' t w m a
NVSet' p s <- NValue' (extract -> NVSetF p s)
  where NVSet' PositionSet
p AttrSet a
s = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a b. (a -> b) -> a -> b
$ PositionSet -> AttrSet a -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. PositionSet -> AttrSet r -> NValueF p m r
NVSetF PositionSet
p AttrSet a
s

-- | Haskell closure to the Nix closure,
pattern NVClosure' :: NVConstraint w => Params () -> (NValue t w m -> m a) -> NValue' t w m a
pattern $mNVClosure' :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
NVConstraint w =>
NValue' t w m a
-> (Params () -> (NValue t w m -> m a) -> r) -> ((# #) -> r) -> r
$bNVClosure' :: forall (w :: * -> *) t (m :: * -> *) a.
NVConstraint w =>
Params () -> (NValue t w m -> m a) -> NValue' t w m a
NVClosure' x f <- NValue' (extract -> NVClosureF x f)
  where NVClosure' Params ()
x NValue t w m -> m a
f = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a b. (a -> b) -> a -> b
$ Params () -> (NValue t w m -> m a) -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
x NValue t w m -> m a
f

-- | Haskell functions to the Nix functions!
pattern NVBuiltin' :: NVConstraint w => VarName -> (NValue t w m -> m a) -> NValue' t w m a
pattern $mNVBuiltin' :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
NVConstraint w =>
NValue' t w m a
-> (VarName -> (NValue t w m -> m a) -> r) -> ((# #) -> r) -> r
$bNVBuiltin' :: forall (w :: * -> *) t (m :: * -> *) a.
NVConstraint w =>
VarName -> (NValue t w m -> m a) -> NValue' t w m a
NVBuiltin' name f <- NValue' (extract -> NVBuiltinF name f)
  where NVBuiltin' VarName
name NValue t w m -> m a
f = w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue' (w (NValueF (NValue t w m) m a) -> NValue' t w m a)
-> w (NValueF (NValue t w m) m a) -> NValue' t w m a
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a. a -> w a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a))
-> NValueF (NValue t w m) m a -> w (NValueF (NValue t w m) m a)
forall a b. (a -> b) -> a -> b
$ VarName -> (NValue t w m -> m a) -> NValueF (NValue t w m) m a
forall p (m :: * -> *) r. VarName -> (p -> m r) -> NValueF p m r
NVBuiltinF VarName
name NValue t w m -> m a
f
{-# complete NVConstant', NVStr', NVPath', NVList', NVSet', NVClosure', NVBuiltin' #-}


-- * @__NValue__@: Nix language values

-- | 'NValue t f m' is
--   a value in head normal form (it means only the tip of it has been
--   evaluated to the normal form, while the rest of it is in lazy
--   not evaluated form (thunk), this known as WHNF).
--
--   An action 'm (NValue t f m)' is a pending evaluation that
--   has yet to be performed.
--
--   An 't' is either:
--     * a pending evaluation.
--     * a value in head normal form.
--
--   The 'Free' structure is used here to represent the possibility that
--   Nix language allows cycles that may appear during normalization.

type NValue t f m = Free (NValue' t f m) t


-- ** Free

-- | HOF of @iter@ from @Free@
iterNValue
  :: forall t f m r
   . MonadDataContext f m
  => ((NValue t f m -> r) -> t -> r)
  -> (NValue' t f m r -> r)
  -> NValue t f m
  -> r
iterNValue :: forall t (f :: * -> *) (m :: * -> *) r.
MonadDataContext f m =>
((NValue t f m -> r) -> t -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue (NValue t f m -> r) -> t -> r
k NValue' t f m r -> r
f = ((NValue t f m -> r) -> NValue t f m -> r) -> NValue t f m -> r
forall a. (a -> a) -> a
fix (((NValue' t f m r -> r) -> Free (NValue' t f m) r -> r
forall (f :: * -> *) a. Functor f => (f a -> a) -> Free f a -> a
iter NValue' t f m r -> r
f (Free (NValue' t f m) r -> r)
-> (NValue t f m -> Free (NValue' t f m) r) -> NValue t f m -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((NValue t f m -> Free (NValue' t f m) r) -> NValue t f m -> r)
-> ((NValue t f m -> r) -> NValue t f m -> Free (NValue' t f m) r)
-> (NValue t f m -> r)
-> NValue t f m
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> r) -> NValue t f m -> Free (NValue' t f m) r
forall a b.
(a -> b) -> Free (NValue' t f m) a -> Free (NValue' t f m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t -> r) -> NValue t f m -> Free (NValue' t f m) r)
-> ((NValue t f m -> r) -> t -> r)
-> (NValue t f m -> r)
-> NValue t f m
-> Free (NValue' t f m) r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NValue t f m -> r) -> t -> r
k) -- already almost iterNValue'

iterNValueByDiscardWith
  :: MonadDataContext f m
  => r
  -> (NValue' t f m r -> r)
  -> NValue t f m
  -> r
iterNValueByDiscardWith :: forall (f :: * -> *) (m :: * -> *) r t.
MonadDataContext f m =>
r -> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValueByDiscardWith = ((NValue t f m -> r) -> t -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
forall t (f :: * -> *) (m :: * -> *) r.
MonadDataContext f m =>
((NValue t f m -> r) -> t -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue (((NValue t f m -> r) -> t -> r)
 -> (NValue' t f m r -> r) -> NValue t f m -> r)
-> (r -> (NValue t f m -> r) -> t -> r)
-> r
-> (NValue' t f m r -> r)
-> NValue t f m
-> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> r) -> (NValue t f m -> r) -> t -> r
forall a b. a -> b -> a
const ((t -> r) -> (NValue t f m -> r) -> t -> r)
-> (r -> t -> r) -> r -> (NValue t f m -> r) -> t -> r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. r -> t -> r
forall a b. a -> b -> a
const


-- | HOF of @iterM@ from @Free@
iterNValueM
  :: (MonadDataContext f m, Monad n)
  => (forall x . n x -> m x)
  -> ((NValue t f m -> n r) -> t -> n r)
  -> (NValue' t f m (n r) -> n r)
  -> NValue t f m
  -> n r
iterNValueM :: forall (f :: * -> *) (m :: * -> *) (n :: * -> *) t r.
(MonadDataContext f m, Monad n) =>
(forall x. n x -> m x)
-> ((NValue t f m -> n r) -> t -> n r)
-> (NValue' t f m (n r) -> n r)
-> NValue t f m
-> n r
iterNValueM forall x. n x -> m x
transform (NValue t f m -> n r) -> t -> n r
k NValue' t f m (n r) -> n r
f = ((NValue t f m -> n r) -> NValue t f m -> n r)
-> NValue t f m -> n r
forall a. (a -> a) -> a
fix ((((NValue' t f m (n r) -> n r) -> Free (NValue' t f m) r -> n r
forall (m :: * -> *) (f :: * -> *) a.
(Monad m, Functor f) =>
(f (m a) -> m a) -> Free f a -> m a
iterM NValue' t f m (n r) -> n r
f (Free (NValue' t f m) r -> n r)
-> (Free (NValue' t f m) (n r) -> n (Free (NValue' t f m) r))
-> Free (NValue' t f m) (n r)
-> n r
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< Free (NValue' t f m) (n r) -> n (Free (NValue' t f m) r)
forall {f :: * -> *} {t} {a}.
Traversable f =>
Free (NValue' t f m) (n a) -> n (Free (NValue' t f m) a)
go) (Free (NValue' t f m) (n r) -> n r)
-> (NValue t f m -> Free (NValue' t f m) (n r))
-> NValue t f m
-> n r
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) ((NValue t f m -> Free (NValue' t f m) (n r))
 -> NValue t f m -> n r)
-> ((NValue t f m -> n r)
    -> NValue t f m -> Free (NValue' t f m) (n r))
-> (NValue t f m -> n r)
-> NValue t f m
-> n r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (t -> n r) -> NValue t f m -> Free (NValue' t f m) (n r)
forall a b.
(a -> b) -> Free (NValue' t f m) a -> Free (NValue' t f m) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((t -> n r) -> NValue t f m -> Free (NValue' t f m) (n r))
-> ((NValue t f m -> n r) -> t -> n r)
-> (NValue t f m -> n r)
-> NValue t f m
-> Free (NValue' t f m) (n r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NValue t f m -> n r) -> t -> n r
k)
  where
    go :: Free (NValue' t f m) (n a) -> n (Free (NValue' t f m) a)
go (Pure n a
x) = a -> Free (NValue' t f m) a
forall (f :: * -> *) a. a -> Free f a
Pure (a -> Free (NValue' t f m) a) -> n a -> n (Free (NValue' t f m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> n a
x -- It should be a 'sequenceA' if to remote 'transform' form function.
    go (Free NValue' t f m (Free (NValue' t f m) (n a))
fa) = NValue' t f m (Free (NValue' t f m) a) -> Free (NValue' t f m) a
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (Free (NValue' t f m) a) -> Free (NValue' t f m) a)
-> n (NValue' t f m (Free (NValue' t f m) a))
-> n (Free (NValue' t f m) a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x. n x -> m x)
-> (Free (NValue' t f m) (n a) -> n (Free (NValue' t f m) a))
-> NValue' t f m (Free (NValue' t f m) (n a))
-> n (NValue' t f m (Free (NValue' t f m) a))
forall (f :: * -> *) (m :: * -> *) (n :: * -> *) a b t.
(Traversable f, Monad m, Monad n) =>
(forall x. n x -> m x)
-> (a -> n b) -> NValue' t f m a -> n (NValue' t f m b)
bindNValue' n x -> m x
forall x. n x -> m x
transform Free (NValue' t f m) (n a) -> n (Free (NValue' t f m) a)
go NValue' t f m (Free (NValue' t f m) (n a))
fa

-- *** Utils

-- | @hoistFree@, Back & forth hoisting in the monad stack
hoistNValue
  :: (Functor m, Functor n, Functor f)
  => (forall x . n x -> m x)
  -> (forall x . m x -> n x)
  -> NValue t f m
  -> NValue t f n
hoistNValue :: forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue t f m -> NValue t f n
hoistNValue forall x. n x -> m x
run forall x. m x -> n x
lft = (forall a. NValue' t f m a -> NValue' t f n a)
-> Free (NValue' t f m) t -> Free (NValue' t f n) t
forall (g :: * -> *) (f :: * -> *) b.
Functor g =>
(forall a. f a -> g a) -> Free f b -> Free g b
hoistFree ((forall a. NValue' t f m a -> NValue' t f n a)
 -> Free (NValue' t f m) t -> Free (NValue' t f n) t)
-> (forall a. NValue' t f m a -> NValue' t f n a)
-> Free (NValue' t f m) t
-> Free (NValue' t f n) t
forall a b. (a -> b) -> a -> b
$ (forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue' t f m a -> NValue' t f n a
forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t a.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue' t f m a -> NValue' t f n a
hoistNValue' n x -> m x
forall x. n x -> m x
run m x -> n x
forall x. m x -> n x
lft
{-# inline hoistNValue #-}

-- ** MonadTrans

-- | @lift@
liftNValue
  :: (MonadTrans u, Monad m, Functor (u m), Functor f)
  => (forall x . u m x -> m x)
  -> NValue t f m
  -> NValue t f (u m)
liftNValue :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) (f :: * -> *) t.
(MonadTrans u, Monad m, Functor (u m), Functor f) =>
(forall x. u m x -> m x) -> NValue t f m -> NValue t f (u m)
liftNValue forall x. u m x -> m x
f = (forall x. u m x -> m x)
-> (forall x. m x -> u m x) -> NValue t f m -> NValue t f (u m)
forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue t f m -> NValue t f n
hoistNValue u m x -> m x
forall x. u m x -> m x
f m x -> u m x
forall x. m x -> u m x
forall (m :: * -> *) a. Monad m => m a -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


-- *** MonadTransUnlift
-- | @unlift@
unliftNValue
  :: (MonadTrans u, Monad m, Functor (u m), Functor f)
  => (forall x . u m x -> m x)  -- aka "run"
  -> NValue t f (u m)
  -> NValue t f m
unliftNValue :: forall (u :: (* -> *) -> * -> *) (m :: * -> *) (f :: * -> *) t.
(MonadTrans u, Monad m, Functor (u m), Functor f) =>
(forall x. u m x -> m x) -> NValue t f (u m) -> NValue t f m
unliftNValue = (forall x. m x -> u m x)
-> (forall x. u m x -> m x) -> NValue t f (u m) -> NValue t f m
forall (m :: * -> *) (n :: * -> *) (f :: * -> *) t.
(Functor m, Functor n, Functor f) =>
(forall x. n x -> m x)
-> (forall x. m x -> n x) -> NValue t f m -> NValue t f n
hoistNValue m x -> u m x
forall x. m x -> u m x
forall (m :: * -> *) a. Monad m => m a -> u m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


-- ** Methods @F: Hask → NValue@
--
-- $Methods @F: Hask → NValue@
--
-- The morphisms of the functor @Hask → NValue@.
-- Continuation of the mantra: "Nix.Value#mantra"

-- | Using of Nulls is generally discouraged (in programming language design et al.), but, if you need it.

mkNVStrWithoutContext :: NVConstraint f
  => Text
  -> NValue t f m
mkNVStrWithoutContext :: forall (f :: * -> *) t (m :: * -> *).
NVConstraint f =>
Text -> NValue t f m
mkNVStrWithoutContext = NixString -> Free (NValue' t f m) t
forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NixString -> Free (NValue' t w m) a
NVStr (NixString -> Free (NValue' t f m) t)
-> (Text -> NixString) -> Text -> Free (NValue' t f m) t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NixString
mkNixStringWithoutContext


builtin
  :: forall m f t
   . (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => VarName -- ^ function name
  -> ( NValue t f m
    -> m (NValue t f m)
    ) -- ^ unary function
  -> m (NValue t f m)
builtin :: forall (m :: * -> *) (f :: * -> *) t.
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
VarName -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin = (NValue t f m -> m (NValue t f m)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValue t f m -> m (NValue t f m))
-> ((NValue t f m -> m (NValue t f m)) -> NValue t f m)
-> (NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.) (((NValue t f m -> m (NValue t f m)) -> NValue t f m)
 -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (VarName -> (NValue t f m -> m (NValue t f m)) -> NValue t f m)
-> VarName
-> (NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
VarName
-> (NValue t w m -> m (Free (NValue' t w m) a))
-> Free (NValue' t w m) a
NVBuiltin


builtin2
  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => VarName -- ^ function name
  -> ( NValue t f m
    -> NValue t f m
    -> m (NValue t f m)
    ) -- ^ binary function
  -> m (NValue t f m)
builtin2 :: forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
VarName
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin2 = (((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> ((NValue t f m -> NValue t f m -> m (NValue t f m))
    -> NValue t f m -> m (NValue t f m))
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
 -> ((NValue t f m -> NValue t f m -> m (NValue t f m))
     -> NValue t f m -> m (NValue t f m))
 -> (NValue t f m -> NValue t f m -> m (NValue t f m))
 -> m (NValue t f m))
-> (((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
    -> (NValue t f m -> NValue t f m -> m (NValue t f m))
    -> NValue t f m
    -> m (NValue t f m))
-> ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall a b.
(((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
 -> a -> b)
-> (((NValue t f m -> m (NValue t f m)) -> m (NValue t f m)) -> a)
-> ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.)) (((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
 -> (NValue t f m -> NValue t f m -> m (NValue t f m))
 -> m (NValue t f m))
-> (VarName
    -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> VarName
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) (f :: * -> *) t.
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
VarName -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin


builtin3
  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => VarName -- ^ function name
  -> ( NValue t f m
    -> NValue t f m
    -> NValue t f m
    -> m (NValue t f m)
    ) -- ^ ternary function
  -> m (NValue t f m)
builtin3 :: forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
VarName
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin3 =
  (((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
 -> ((NValue t f m
      -> NValue t f m -> NValue t f m -> m (NValue t f m))
     -> NValue t f m -> m (NValue t f m))
 -> (NValue t f m
     -> NValue t f m -> NValue t f m -> m (NValue t f m))
 -> m (NValue t f m))
-> (VarName
    -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> (VarName
    -> (NValue t f m
        -> NValue t f m -> NValue t f m -> m (NValue t f m))
    -> NValue t f m
    -> m (NValue t f m))
-> VarName
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall a b c.
(a -> b -> c) -> (VarName -> a) -> (VarName -> b) -> VarName -> c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 ((NValue t f m -> m (NValue t f m)) -> m (NValue t f m))
-> ((NValue t f m
     -> NValue t f m -> NValue t f m -> m (NValue t f m))
    -> NValue t f m -> m (NValue t f m))
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) -- compose 2 together
    VarName -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
forall (m :: * -> *) (f :: * -> *) t.
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
VarName -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin
    (((NValue t f m -> NValue t f m -> m (NValue t f m))
 -> m (NValue t f m))
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) (((NValue t f m -> NValue t f m -> m (NValue t f m))
  -> m (NValue t f m))
 -> (NValue t f m
     -> NValue t f m -> NValue t f m -> m (NValue t f m))
 -> NValue t f m
 -> m (NValue t f m))
-> (VarName
    -> (NValue t f m -> NValue t f m -> m (NValue t f m))
    -> m (NValue t f m))
-> VarName
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> NValue t f m
-> m (NValue t f m)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), MonadDataContext f m) =>
VarName
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin2)

-- *** @F: Evaluation -> NValue@

pattern $mNVNull :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a -> ((# #) -> r) -> ((# #) -> r) -> r
$bNVNull :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a
NVNull = Free NVNull'
pattern $mNVThunk :: forall {r} {f :: * -> *} {a}.
Free f a -> (a -> r) -> ((# #) -> r) -> r
$bNVThunk :: forall (f :: * -> *) a. a -> Free f a
NVThunk t = Pure t
pattern $mNVValue :: forall {r} {f :: * -> *} {a}.
Free f a -> (f (Free f a) -> r) -> ((# #) -> r) -> r
$bNVValue :: forall (f :: * -> *) a. f (Free f a) -> Free f a
NVValue v = Free v
{-# complete NVThunk, NVValue, NVNull #-}
pattern $mNVConstant :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a -> (NAtom -> r) -> ((# #) -> r) -> r
$bNVConstant :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NAtom -> Free (NValue' t w m) a
NVConstant x = Free (NVConstant' x)
pattern $mNVStr :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a -> (NixString -> r) -> ((# #) -> r) -> r
$bNVStr :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
NixString -> Free (NValue' t w m) a
NVStr ns = Free (NVStr' ns)
pattern $mNVPath :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a -> (Path -> r) -> ((# #) -> r) -> r
$bNVPath :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Path -> Free (NValue' t w m) a
NVPath x = Free (NVPath' x)
pattern $mNVList :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a
-> ([Free (NValue' t w m) a] -> r) -> ((# #) -> r) -> r
$bNVList :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
[Free (NValue' t w m) a] -> Free (NValue' t w m) a
NVList l = Free (NVList' l)
pattern $mNVSet :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a
-> (PositionSet -> AttrSet (Free (NValue' t w m) a) -> r)
-> ((# #) -> r)
-> r
$bNVSet :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
PositionSet
-> AttrSet (Free (NValue' t w m) a) -> Free (NValue' t w m) a
NVSet s x = Free (NVSet' s x)
pattern $mNVBuiltin :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a
-> (VarName -> (NValue t w m -> m (Free (NValue' t w m) a)) -> r)
-> ((# #) -> r)
-> r
$bNVBuiltin :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
VarName
-> (NValue t w m -> m (Free (NValue' t w m) a))
-> Free (NValue' t w m) a
NVBuiltin name f = Free (NVBuiltin' name f)
pattern $mNVClosure :: forall {r} {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Free (NValue' t w m) a
-> (Params () -> (NValue t w m -> m (Free (NValue' t w m) a)) -> r)
-> ((# #) -> r)
-> r
$bNVClosure :: forall {w :: * -> *} {t} {m :: * -> *} {a}.
(Comonad w, Applicative w) =>
Params ()
-> (NValue t w m -> m (Free (NValue' t w m) a))
-> Free (NValue' t w m) a
NVClosure x f = Free (NVClosure' x f)
{-# complete NVThunk, NVConstant, NVStr, NVPath, NVList, NVSet, NVClosure, NVBuiltin #-}




-- * @TStringContext@

data TStringContext = NoContext | HasContext
 deriving Int -> TStringContext -> ShowS
[TStringContext] -> ShowS
TStringContext -> String
(Int -> TStringContext -> ShowS)
-> (TStringContext -> String)
-> ([TStringContext] -> ShowS)
-> Show TStringContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TStringContext -> ShowS
showsPrec :: Int -> TStringContext -> ShowS
$cshow :: TStringContext -> String
show :: TStringContext -> String
$cshowList :: [TStringContext] -> ShowS
showList :: [TStringContext] -> ShowS
Show

instance Semigroup TStringContext where
  <> :: TStringContext -> TStringContext -> TStringContext
(<>) TStringContext
NoContext TStringContext
NoContext = TStringContext
NoContext
  (<>) TStringContext
_         TStringContext
_         = TStringContext
HasContext


instance Monoid TStringContext where
  mempty :: TStringContext
mempty = TStringContext
NoContext

-- * @ValueType@

data ValueType
  = TInt
  | TFloat
  | TBool
  | TNull
  | TString TStringContext
  | TList
  | TSet
  | TClosure
  | TPath
  | TBuiltin
 deriving Int -> ValueType -> ShowS
[ValueType] -> ShowS
ValueType -> String
(Int -> ValueType -> ShowS)
-> (ValueType -> String)
-> ([ValueType] -> ShowS)
-> Show ValueType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ValueType -> ShowS
showsPrec :: Int -> ValueType -> ShowS
$cshow :: ValueType -> String
show :: ValueType -> String
$cshowList :: [ValueType] -> ShowS
showList :: [ValueType] -> ShowS
Show


-- | Determine type of a value
valueType :: NValueF a m r -> ValueType
valueType :: forall a (m :: * -> *) r. NValueF a m r -> ValueType
valueType =
  \case
    NVConstantF NAtom
a ->
      case NAtom
a of
        NURI   Text
_ -> TStringContext -> ValueType
TString TStringContext
forall a. Monoid a => a
mempty
        NInt   Integer
_ -> ValueType
TInt
        NFloat Float
_ -> ValueType
TFloat
        NBool  Bool
_ -> ValueType
TBool
        NAtom
NNull    -> ValueType
TNull
    NVStrF NixString
ns  ->
      TStringContext -> ValueType
TString (TStringContext -> ValueType) -> TStringContext -> ValueType
forall a b. (a -> b) -> a -> b
$
        TStringContext
HasContext TStringContext -> Bool -> TStringContext
forall a. Monoid a => a -> Bool -> a
`whenTrue` NixString -> Bool
hasContext NixString
ns
    NVListF{}    -> ValueType
TList
    NVSetF{}     -> ValueType
TSet
    NVClosureF{} -> ValueType
TClosure
    NVPathF{}    -> ValueType
TPath
    NVBuiltinF{} -> ValueType
TBuiltin


-- | Describe type value
describeValue :: ValueType -> Text
describeValue :: ValueType -> Text
describeValue =
  \case
    ValueType
TInt               -> Text
"an integer"
    ValueType
TFloat             -> Text
"a float"
    ValueType
TBool              -> Text
"a boolean"
    ValueType
TNull              -> Text
"a null"
    TString TStringContext
NoContext  -> Text
"a string with no context"
    TString TStringContext
HasContext -> Text
"a string"
    ValueType
TList              -> Text
"a list"
    ValueType
TSet               -> Text
"an attr set"
    ValueType
TClosure           -> Text
"a function"
    ValueType
TPath              -> Text
"a path"
    ValueType
TBuiltin           -> Text
"a builtin function"


showValueType :: (MonadThunk t m (NValue t f m), Comonad f)
  => NValue t f m
  -> m Text
showValueType :: forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
NValue t f m -> m Text
showValueType (Pure t
t) = NValue t f m -> m Text
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
NValue t f m -> m Text
showValueType (NValue t f m -> m Text) -> m (NValue t f m) -> m Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< t -> m (NValue t f m)
forall t (m :: * -> *) a. MonadThunk t m a => t -> m a
force t
t
showValueType (Free (NValue' (f (NValueF (NValue t f m) m (NValue t f m))
-> NValueF (NValue t f m) m (NValue t f m)
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m (NValue t f m)
v))) =
  Text -> m Text
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> m Text) -> Text -> m Text
forall a b. (a -> b) -> a -> b
$ ValueType -> Text
describeValue (ValueType -> Text) -> ValueType -> Text
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t f m) m (NValue t f m) -> ValueType
forall a (m :: * -> *) r. NValueF a m r -> ValueType
valueType NValueF (NValue t f m) m (NValue t f m)
v


-- * @ValueFrame@

data ValueFrame t f m
  = ForcingThunk t
  | ConcerningValue (NValue t f m)
  | Comparison (NValue t f m) (NValue t f m)
  | Addition (NValue t f m) (NValue t f m)
  | Multiplication (NValue t f m) (NValue t f m)
  | Division (NValue t f m) (NValue t f m)
  | Coercion ValueType ValueType
  | CoercionToJson (NValue t f m)
  | CoercionFromJson Aeson.Value
  | Expectation ValueType (NValue t f m)
 deriving Typeable

deriving instance (NVConstraint f, Show t) => Show (ValueFrame t f m)


-- * @MonadDataContext@

type MonadDataContext f (m :: Type -> Type)
  = (Comonad f, Applicative f, Traversable f, Monad m)

-- * @MonadDataErrorContext@

type MonadDataErrorContext t f m
  = (Show t, Typeable t, Typeable m, Typeable f, MonadDataContext f m, MonadFail m)

instance MonadDataErrorContext t f m => Exception (ValueFrame t f m)


-- * @instance Eq NValue'@

instance (Eq a, Comonad f) => Eq (NValue' t f m a) where
    == :: NValue' t f m a -> NValue' t f m a -> Bool
(==) (NValue' (f (NValueF (NValue t f m) m a) -> NValueF (NValue t f m) m a
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m a
x)) (NValue' (f (NValueF (NValue t f m) m a) -> NValueF (NValue t f m) m a
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m a
y)) = NValueF (NValue t f m) m a
x NValueF (NValue t f m) m a -> NValueF (NValue t f m) m a -> Bool
forall a. Eq a => a -> a -> Bool
== NValueF (NValue t f m) m a
y

-- * @instance Eq1 NValue'@

-- TH derivable works only after MonadDataContext
instance Comonad f => Eq1 (NValue' t f m) where
  liftEq :: forall a b.
(a -> b -> Bool) -> NValue' t f m a -> NValue' t f m b -> Bool
liftEq a -> b -> Bool
eq (NValue' (f (NValueF (NValue t f m) m a) -> NValueF (NValue t f m) m a
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m a
x)) (NValue' (f (NValueF (NValue t f m) m b) -> NValueF (NValue t f m) m b
forall a. f a -> a
forall (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m b
y)) = (a -> b -> Bool)
-> NValueF (NValue t f m) m a -> NValueF (NValue t f m) m b -> Bool
forall a b.
(a -> b -> Bool)
-> NValueF (NValue t f m) m a -> NValueF (NValue t f m) m b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
eq NValueF (NValue t f m) m a
x NValueF (NValue t f m) m b
y


-- * @NValueF@ traversals, getter & setters

-- | Make traversals for Nix traversable structures.
$(makeTraversals ''NValueF)

-- | Make lenses for the Nix values
$(makeLenses ''NValue')


-- | Lens-generated getter-setter function for a traversable NValue' key-val structures.
--   Nix value analogue of the @Data-Aeson-Lens@:@key :: AsValue t => Text -> Traversal' t Value@.
key
  :: (Traversable f, Applicative g)
  => VarName
  -> LensLike' g (NValue' t f m a) (Maybe a)
key :: forall (f :: * -> *) (g :: * -> *) t (m :: * -> *) a.
(Traversable f, Applicative g) =>
VarName -> LensLike' g (NValue' t f m a) (Maybe a)
key VarName
k = (f (NValueF (NValue t f m) m a)
 -> g (f (NValueF (NValue t f m) m a)))
-> NValue' t f m a -> g (NValue' t f m a)
forall {f :: * -> *} {f :: * -> *} {t} {m :: * -> *} {a}
       {f :: * -> *} {t} {m :: * -> *} {a}.
Functor f =>
(f (NValueF (NValue t f m) m a)
 -> f (f (NValueF (NValue t f m) m a)))
-> NValue' t f m a -> f (NValue' t f m a)
nValue ((f (NValueF (NValue t f m) m a)
  -> g (f (NValueF (NValue t f m) m a)))
 -> NValue' t f m a -> g (NValue' t f m a))
-> ((Maybe a -> g (Maybe a))
    -> f (NValueF (NValue t f m) m a)
    -> g (f (NValueF (NValue t f m) m a)))
-> (Maybe a -> g (Maybe a))
-> NValue' t f m a
-> g (NValue' t f m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a))
-> f (NValueF (NValue t f m) m a)
-> g (f (NValueF (NValue t f m) m a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> f a -> f (f b)
traverse ((NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a))
 -> f (NValueF (NValue t f m) m a)
 -> g (f (NValueF (NValue t f m) m a)))
-> ((Maybe a -> g (Maybe a))
    -> NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a))
-> (Maybe a -> g (Maybe a))
-> f (NValueF (NValue t f m) m a)
-> g (f (NValueF (NValue t f m) m a))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((PositionSet, AttrSet a) -> g (PositionSet, AttrSet a))
-> NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a)
forall {f :: * -> *} {r} {p} {m :: * -> *}.
Applicative f =>
((PositionSet, AttrSet r) -> f (PositionSet, AttrSet r))
-> NValueF p m r -> f (NValueF p m r)
_NVSetF (((PositionSet, AttrSet a) -> g (PositionSet, AttrSet a))
 -> NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a))
-> ((Maybe a -> g (Maybe a))
    -> (PositionSet, AttrSet a) -> g (PositionSet, AttrSet a))
-> (Maybe a -> g (Maybe a))
-> NValueF (NValue t f m) m a
-> g (NValueF (NValue t f m) m a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LensLike
  g
  (PositionSet, AttrSet a)
  (PositionSet, AttrSet a)
  (AttrSet a)
  (AttrSet a)
forall r a b (f :: * -> *).
Functor f =>
LensLike f (r, a) (r, b) a b
_2 LensLike
  g
  (PositionSet, AttrSet a)
  (PositionSet, AttrSet a)
  (AttrSet a)
  (AttrSet a)
-> ((Maybe a -> g (Maybe a)) -> AttrSet a -> g (AttrSet a))
-> (Maybe a -> g (Maybe a))
-> (PositionSet, AttrSet a)
-> g (PositionSet, AttrSet a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarName -> (Maybe a -> g (Maybe a)) -> AttrSet a -> g (AttrSet a)
forall (f :: * -> *) v.
Functor f =>
VarName -> (Maybe v -> f (Maybe v)) -> AttrSet v -> f (AttrSet v)
hashAt VarName
k