{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

{-# 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           Prelude                 hiding ( force )
import           Nix.Utils
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           Data.Eq.Deriving
import qualified Text.Show
import           Text.Show                      ( showsPrec
                                                , showString
                                                , showParen
                                                )
import           Lens.Family2.Stock             ( _1 )
import           Lens.Family2.TH                ( makeTraversals
                                                , makeLenses
                                                )
import           Nix.Atoms
import           Nix.Expr.Types
import           Nix.Expr.Types.Annotated
import           Nix.String
import           Nix.Thunk


-- * @__NValueF__@: Base functor

-- | 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 FilePath
    | NVListF [r]
    | NVSetF (AttrSet r) (AttrSet SourcePos)
    | 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 Text (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
$cto :: forall p (m :: * -> *) r x. Rep (NValueF p m r) x -> NValueF p m r
$cfrom :: forall p (m :: * -> *) r x. NValueF p m r -> Rep (NValueF p m r) x
Generic, Typeable, a -> NValueF p m b -> NValueF p m a
(a -> b) -> NValueF p m a -> NValueF p m b
(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
<$ :: a -> NValueF p m b -> NValueF p m a
$c<$ :: forall p (m :: * -> *) a b.
Functor m =>
a -> NValueF p m b -> NValueF p m a
fmap :: (a -> b) -> NValueF p m a -> NValueF p m b
$cfmap :: forall p (m :: * -> *) a b.
Functor m =>
(a -> b) -> NValueF p m a -> NValueF p m b
Functor)


-- ** Eq1

instance Eq1 (NValueF p m) where
  liftEq :: (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
eq (NVListF     [a]
x) (NVListF     [b]
y) = (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 AttrSet a
x AttrSet SourcePos
_   ) (NVSetF AttrSet b
y AttrSet SourcePos
_   ) = (a -> b -> Bool) -> AttrSet a -> AttrSet 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
_  (NVPathF FilePath
x    ) (NVPathF FilePath
y    ) = FilePath
x FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
== FilePath
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 = NValueF p m r -> ShowS
go
   where
    go :: NValueF p m r -> String -> String
    go :: NValueF p m r -> ShowS
go = \case
      (NVConstantF NAtom
atom     ) -> FilePath -> NAtom -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVConstant" NAtom
atom
      (NVStrF      NixString
ns       ) -> FilePath -> Text -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVStr"      (NixString -> Text
stringIgnoreContext NixString
ns)
      (NVListF     [r]
lst      ) -> FilePath -> [r] -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVList"     [r]
lst
      (NVSetF      AttrSet r
attrs  AttrSet SourcePos
_ ) -> FilePath -> AttrSet r -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVSet"      AttrSet r
attrs
      (NVClosureF  Params ()
params p -> m r
_ ) -> FilePath -> Params () -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVClosure"  Params ()
params
      (NVPathF     FilePath
path     ) -> FilePath -> FilePath -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVPath"     FilePath
path
      (NVBuiltinF  Text
name   p -> m r
_ ) -> FilePath -> Text -> ShowS
forall a. Show a => FilePath -> a -> ShowS
showsCon1 FilePath
"NVBuiltin"  Text
name

    showsCon1 :: Show a => String -> a -> String -> String
    showsCon1 :: FilePath -> a -> ShowS
showsCon1 FilePath
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
$ FilePath -> ShowS
showString (FilePath
con FilePath -> ShowS
forall a. Semigroup a => a -> a -> a
<> FilePath
" ") 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 :: (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     FilePath
_  -> m
forall a. Monoid a => a
mempty
    NVListF     [a]
l  -> (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f [a]
l
    NVSetF     AttrSet a
s AttrSet SourcePos
_ -> (a -> m) -> AttrSet a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f AttrSet a
s
    NVClosureF Params ()
_ p -> m a
_ -> m
forall a. Monoid a => a
mempty
    NVBuiltinF Text
_ p -> m a
_ -> m
forall a. Monoid a => a
mempty


-- ** 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 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 (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 (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     FilePath
p  -> NValueF p m a -> n (NValueF p m 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
$ FilePath -> NValueF p m a
forall p (m :: * -> *) r. FilePath -> NValueF p m r
NVPathF FilePath
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)
sequenceA [n a]
l
  NVSetF     AttrSet (n a)
s AttrSet SourcePos
p ->
    (AttrSet a -> AttrSet SourcePos -> NValueF p m a)
-> n (AttrSet a) -> n (AttrSet SourcePos) -> n (NValueF p m a)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
      AttrSet a -> AttrSet SourcePos -> NValueF p m a
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF
      (AttrSet (n a) -> n (AttrSet a)
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA AttrSet (n a)
s)
      (AttrSet SourcePos -> n (AttrSet SourcePos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet SourcePos
p)
  NVClosureF Params ()
p p -> m (n a)
g -> NValueF p m a -> n (NValueF p m 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 Text
s p -> m (n a)
g -> NValueF p m a -> n (NValueF p m 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
$ Text -> (p -> m a) -> NValueF p m a
forall p (m :: * -> *) r. Text -> (p -> m r) -> NValueF p m r
NVBuiltinF Text
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)
  -> (a -> n b)
  -> NValueF p m a
  -> n (NValueF p m b)
bindNValueF :: (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 (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 (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     FilePath
p  -> NValueF p m b -> n (NValueF p m b)
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
$ FilePath -> NValueF p m b
forall p (m :: * -> *) r. FilePath -> NValueF p m r
NVPathF FilePath
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)
traverse a -> n b
f [a]
l
  NVSetF     AttrSet a
s AttrSet SourcePos
p ->
    (AttrSet b -> AttrSet SourcePos -> NValueF p m b)
-> n (AttrSet b) -> n (AttrSet SourcePos) -> n (NValueF p m b)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2
      AttrSet b -> AttrSet SourcePos -> NValueF p m b
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF
      ((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)
traverse a -> n b
f AttrSet a
s)
      (AttrSet SourcePos -> n (AttrSet SourcePos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet SourcePos
p)
  NVClosureF Params ()
p p -> m a
g -> NValueF p m b -> n (NValueF p m b)
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 Text
s p -> m a
g -> NValueF p m b -> n (NValueF p m b)
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
$ Text -> (p -> m b) -> NValueF p m b
forall p (m :: * -> *) r. Text -> (p -> m r) -> NValueF p m r
NVBuiltinF Text
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 :: 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 forall x. m x -> u m x
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 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 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 s p
    --   ]
    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     FilePath
p  -> FilePath -> NValueF p n a
forall p (m :: * -> *) r. FilePath -> NValueF p m r
NVPathF FilePath
p
    NVListF     [a]
l  -> [a] -> NValueF p n a
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [a]
l
    NVSetF     AttrSet a
s AttrSet SourcePos
p -> AttrSet a -> AttrSet SourcePos -> NValueF p n a
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF AttrSet a
s AttrSet SourcePos
p
    NVBuiltinF Text
s p -> m a
g -> Text -> (p -> n a) -> NValueF p n a
forall p (m :: * -> *) r. Text -> (p -> m r) -> NValueF p m r
NVBuiltinF Text
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))

-- | 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 \)).
    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
$cto :: forall t (f :: * -> *) (m :: * -> *) a x.
Rep (NValue' t f m a) x -> NValue' t f m a
$cfrom :: forall t (f :: * -> *) (m :: * -> *) a x.
NValue' t f m a -> Rep (NValue' t f m a) x
Generic, Typeable, a -> NValue' t f m b -> NValue' t f m a
(a -> b) -> NValue' t f m a -> NValue' t f m b
(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
<$ :: a -> NValue' t f m b -> NValue' t f m a
$c<$ :: forall t (f :: * -> *) (m :: * -> *) a b.
(Functor f, Functor m) =>
a -> NValue' t f m b -> NValue' t f m a
fmap :: (a -> b) -> NValue' t f m a -> NValue' t f m b
$cfmap :: forall t (f :: * -> *) (m :: * -> *) a b.
(Functor f, Functor m) =>
(a -> b) -> NValue' t f m a -> NValue' t f m b
Functor, NValue' t f m a -> Bool
(a -> m) -> NValue' t f m a -> m
(a -> b -> b) -> b -> NValue' t f m a -> b
(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
product :: NValue' t f m a -> a
$cproduct :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Num a) =>
NValue' t f m a -> a
sum :: NValue' t f m a -> a
$csum :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Num a) =>
NValue' t f m a -> a
minimum :: NValue' t f m a -> a
$cminimum :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Ord a) =>
NValue' t f m a -> a
maximum :: NValue' t f m a -> a
$cmaximum :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Ord a) =>
NValue' t f m a -> a
elem :: a -> NValue' t f m a -> Bool
$celem :: forall t (f :: * -> *) (m :: * -> *) a.
(Foldable f, Eq a) =>
a -> NValue' t f m a -> Bool
length :: NValue' t f m a -> Int
$clength :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> Int
null :: NValue' t f m a -> Bool
$cnull :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> Bool
toList :: NValue' t f m a -> [a]
$ctoList :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
NValue' t f m a -> [a]
foldl1 :: (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
foldr1 :: (a -> a -> a) -> NValue' t f m a -> a
$cfoldr1 :: forall t (f :: * -> *) (m :: * -> *) a.
Foldable f =>
(a -> a -> a) -> NValue' t f m a -> a
foldl' :: (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 :: (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
foldr' :: (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 :: (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
foldMap' :: (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 :: (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
fold :: NValue' t f m m -> m
$cfold :: forall t (f :: * -> *) (m :: * -> *) m.
(Foldable f, Monoid m) =>
NValue' t f m m -> m
Foldable)

instance (Comonad f, Show a) => Show (NValue' t f m a) where
  show :: NValue' t f m a -> FilePath
show (NValue' (f (NValueF (NValue t f m) m a) -> NValueF (NValue t f m) m 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 -> FilePath
forall b a. (Show a, IsString b) => a -> b
show NValueF (NValue t f m) m a
v


-- ** Show1

instance Comonad f => Show1 (NValue' t f m) where
  liftShowsPrec :: (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) -> FilePath -> Int -> NAtom -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith Int -> NAtom -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec FilePath
"NVConstantF" Int
p NAtom
atom
    NVStr' NixString
ns ->
      (Int -> Text -> ShowS) -> FilePath -> Int -> Text -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec FilePath
"NVStrF" Int
p (NixString -> Text
stringIgnoreContext NixString
ns)
    NVList' [a]
lst       -> (Int -> [a] -> ShowS) -> FilePath -> Int -> [a] -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith ((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) FilePath
"NVListF" Int
p [a]
lst
    NVSet' AttrSet a
attrs AttrSet SourcePos
_    -> (Int -> AttrSet a -> ShowS)
-> FilePath -> Int -> AttrSet a -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> AttrSet a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) FilePath
"NVSetF" Int
p AttrSet a
attrs
    NVPath' FilePath
path      -> (Int -> FilePath -> ShowS) -> FilePath -> Int -> FilePath -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith Int -> FilePath -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec FilePath
"NVPathF" Int
p FilePath
path
    NVClosure' Params ()
c    NValue t f m -> m a
_ -> (Int -> Params () -> ShowS)
-> FilePath -> Int -> Params () -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith Int -> Params () -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec FilePath
"NVClosureF" Int
p Params ()
c
    NVBuiltin' Text
name NValue t f m -> m a
_ -> (Int -> Text -> ShowS) -> FilePath -> Int -> Text -> ShowS
forall a. (Int -> a -> ShowS) -> FilePath -> Int -> a -> ShowS
showsUnaryWith Int -> Text -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec FilePath
"NVBuiltinF" Int
p Text
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 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)
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 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 :: (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     FilePath
p  -> FilePath -> NValueF b m r
forall p (m :: * -> *) r. FilePath -> NValueF p m r
NVPathF FilePath
p
  NVListF     [r]
l  -> [r] -> NValueF b m r
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [r]
l
  NVSetF     AttrSet r
s AttrSet SourcePos
p -> AttrSet r -> AttrSet SourcePos -> NValueF b m r
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF AttrSet r
s AttrSet SourcePos
p
  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 Text
s a -> m r
g -> Text -> (b -> m r) -> NValueF b m r
forall p (m :: * -> *) r. Text -> (p -> m r) -> NValueF p m r
NVBuiltinF Text
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
  => (a -> (NValue' t f m a -> r) -> r)
  -> (NValue' t f m r -> r)
  -> NValue' t f m a
  -> r
iterNValue' :: (a -> (NValue' t f m a -> r) -> r)
-> (NValue' t f m r -> r) -> NValue' t f m a -> r
iterNValue' a -> (NValue' t f m a -> r) -> r
k NValue' t f m r -> r
f = 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
. (a -> r) -> NValue' t f m a -> NValue' t f m r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\a
a -> a -> (NValue' t f m a -> r) -> r
k a
a ((a -> (NValue' t f m a -> r) -> r)
-> (NValue' t f m r -> r) -> NValue' t f m a -> r
forall t (f :: * -> *) (m :: * -> *) a r.
MonadDataContext f m =>
(a -> (NValue' t f m a -> r) -> r)
-> (NValue' t f m r -> r) -> NValue' t f m a -> r
iterNValue' a -> (NValue' t f m a -> r) -> r
k NValue' t f m r -> r
f))

-- *** 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 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 forall x. m x -> n x
lft 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 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 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)
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 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 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' forall x. u m x -> m x
run forall x. m x -> u m x
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 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' forall x. m x -> u m x
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift


-- ** Bijective Hask subcategory <-> @NValue'@
-- *** @F: Hask subcategory → NValue'@
--
-- #mantra#
-- $Methods @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.
--
-- Facts of which are seen below:


-- | Haskell constant to the Nix constant,
nvConstant' :: Applicative f
  => NAtom
  -> NValue' t f m r
nvConstant' :: NAtom -> NValue' t f m r
nvConstant' = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> (NAtom -> f (NValueF (NValue t f m) m r))
-> NAtom
-> NValue' t f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> (NAtom -> NValueF (NValue t f m) m r)
-> NAtom
-> f (NValueF (NValue t f m) m r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF


-- | Haskell text & context to the Nix text & context,
nvStr' :: Applicative f
  => NixString
  -> NValue' t f m r
nvStr' :: NixString -> NValue' t f m r
nvStr' = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> (NixString -> f (NValueF (NValue t f m) m r))
-> NixString
-> NValue' t f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> (NixString -> NValueF (NValue t f m) m r)
-> NixString
-> f (NValueF (NValue t f m) m r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF


-- | Haskell @FilePath@ to the Nix path,
nvPath' :: Applicative f
  => FilePath
  -> NValue' t f m r
nvPath' :: FilePath -> NValue' t f m r
nvPath' = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> (FilePath -> f (NValueF (NValue t f m) m r))
-> FilePath
-> NValue' t f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> (FilePath -> NValueF (NValue t f m) m r)
-> FilePath
-> f (NValueF (NValue t f m) m r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. FilePath -> NValueF p m r
NVPathF


-- | Haskell @[]@ to the Nix @[]@,
nvList' :: Applicative f
  => [r]
  -> NValue' t f m r
nvList' :: [r] -> NValue' t f m r
nvList' = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> ([r] -> f (NValueF (NValue t f m) m r))
-> [r]
-> NValue' t f m r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> ([r] -> NValueF (NValue t f m) m r)
-> [r]
-> f (NValueF (NValue t f m) m r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [r] -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF


-- | Haskell key-value to the Nix key-value,
nvSet' :: Applicative f
  => HashMap Text SourcePos
  -> HashMap Text r
  -> NValue' t f m r
nvSet' :: AttrSet SourcePos -> HashMap Text r -> NValue' t f m r
nvSet' AttrSet SourcePos
x HashMap Text r
s = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> f (NValueF (NValue t f m) m r) -> NValue' t f m r
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall a b. (a -> b) -> a -> b
$ HashMap Text r -> AttrSet SourcePos -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF HashMap Text r
s AttrSet SourcePos
x


-- | Haskell closure to the Nix closure,
nvClosure' :: (Applicative f, Functor m)
  => Params ()
  -> (NValue t f m
      -> m r
    )
  -> NValue' t f m r
nvClosure' :: Params () -> (NValue t f m -> m r) -> NValue' t f m r
nvClosure' Params ()
x NValue t f m -> m r
f = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> f (NValueF (NValue t f m) m r) -> NValue' t f m r
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall a b. (a -> b) -> a -> b
$ Params () -> (NValue t f m -> m r) -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
x NValue t f m -> m r
f


-- | Haskell functions to the Nix functions!
nvBuiltin' :: (Applicative f, Functor m)
  => Text
  -> (NValue t f m -> m r)
  -> NValue' t f m r
nvBuiltin' :: Text -> (NValue t f m -> m r) -> NValue' t f m r
nvBuiltin' Text
name NValue t f m -> m r
f = f (NValueF (NValue t f m) m r) -> NValue' t f m r
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 r) -> NValue' t f m r)
-> f (NValueF (NValue t f m) m r) -> NValue' t f m r
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r))
-> NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall a b. (a -> b) -> a -> b
$ Text -> (NValue t f m -> m r) -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. Text -> (p -> m r) -> NValueF p m r
NVBuiltinF Text
name NValue t f m -> m r
f


-- So above we have maps of Hask subcategory objects to Nix objects,
-- and Hask subcategory morphisms to Nix morphisms.

-- *** @F: NValue -> NValue'@

-- | Module pattens use @language PatternSynonyms@: unidirectional 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.
pattern $mNVConstant' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a -> (NAtom -> r) -> (Void# -> r) -> r
NVConstant' x <- NValue' (extract -> NVConstantF x)
pattern $mNVStr' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a -> (NixString -> r) -> (Void# -> r) -> r
NVStr' ns <- NValue' (extract -> NVStrF ns)
pattern $mNVPath' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a -> (FilePath -> r) -> (Void# -> r) -> r
NVPath' x <- NValue' (extract -> NVPathF x)
pattern $mNVList' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a -> ([a] -> r) -> (Void# -> r) -> r
NVList' l <- NValue' (extract -> NVListF l)
pattern $mNVSet' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a
-> (AttrSet a -> AttrSet SourcePos -> r) -> (Void# -> r) -> r
NVSet' s x <- NValue' (extract -> NVSetF s x)
pattern $mNVClosure' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a
-> (Params () -> (NValue t w m -> m a) -> r) -> (Void# -> r) -> r
NVClosure' x f <- NValue' (extract -> NVClosureF x f)
pattern $mNVBuiltin' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a
-> (Text -> (NValue t w m -> m a) -> r) -> (Void# -> r) -> r
NVBuiltin' name f <- NValue' (extract -> NVBuiltinF name 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

-- | @iter@
iterNValue
  :: forall t f m r
   . MonadDataContext f m
  => (t -> (NValue t f m -> r) -> r)
  -> (NValue' t f m r -> r)
  -> NValue t f m
  -> r
iterNValue :: (t -> (NValue t f m -> r) -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue t -> (NValue t f m -> r) -> r
k NValue' t f m r -> r
f = (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
. (t -> r) -> NValue t f m -> Free (NValue' t f m) r
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\t
t -> t -> (NValue t f m -> r) -> r
k t
t ((t -> (NValue t f m -> r) -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
forall t (f :: * -> *) (m :: * -> *) r.
MonadDataContext f m =>
(t -> (NValue t f m -> r) -> r)
-> (NValue' t f m r -> r) -> NValue t f m -> r
iterNValue t -> (NValue t f m -> r) -> r
k NValue' t f m r -> r
f))


-- | @iter@ for monadic values
iterNValueM
  :: (MonadDataContext f m, Monad n)
  => (forall x . n x -> m x)
  -> (t -> (NValue t f m -> n r) -> n r)
  -> (NValue' t f m (n r) -> n r)
  -> NValue t f m
  -> n r
iterNValueM :: (forall x. n x -> m x)
-> (t -> (NValue t f m -> n r) -> n r)
-> (NValue' t f m (n r) -> n r)
-> NValue t f m
-> n r
iterNValueM forall x. n x -> m x
transform t -> (NValue t f m -> n r) -> n r
k NValue' t f m (n r) -> n r
f =
    (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)
-> (NValue t f m -> n (Free (NValue' t f m) r))
-> NValue t f m
-> 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 (Free (NValue' t f m) r))
-> (NValue t f m -> Free (NValue' t f m) (n r))
-> NValue t f m
-> n (Free (NValue' t f m) r)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((\t
t -> t -> (NValue t f m -> n r) -> n r
k t
t ((NValue t f m -> n r) -> n r) -> (NValue t f m -> n r) -> n r
forall a b. (a -> b) -> a -> b
$ (forall x. n x -> m x)
-> (t -> (NValue t f m -> n r) -> n r)
-> (NValue' t f m (n r) -> n r)
-> NValue t f m
-> n r
forall (f :: * -> *) (m :: * -> *) (n :: * -> *) t r.
(MonadDataContext f m, Monad n) =>
(forall x. n x -> m x)
-> (t -> (NValue t f m -> n r) -> n r)
-> (NValue' t f m (n r) -> n r)
-> NValue t f m
-> n r
iterNValueM forall x. n x -> m x
transform t -> (NValue t f m -> n r) -> n r
k NValue' t f m (n r) -> n r
f) (t -> n r) -> NValue t f m -> Free (NValue' t f m) (n r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
  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
    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' 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 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)
-> NValue t f m -> NValue t f n
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)
 -> NValue t f m -> NValue t f n)
-> (forall a. NValue' t f m a -> NValue' t f n a)
-> NValue t f m
-> NValue t f n
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' forall x. n x -> m x
run 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 x. u m x -> m x) -> NValue t f m -> NValue t f (u m)
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 -> 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 forall x. u m x -> m x
run forall x. m x -> u m x
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 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 forall x. m x -> u m x
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"


-- | Life of a Haskell thunk to the life of a Nix thunk,
nvThunk :: Applicative f
  => t
  -> NValue t f m
nvThunk :: t -> NValue t f m
nvThunk = t -> NValue t f m
forall (f :: * -> *) a. a -> Free f a
Pure


-- | Life of a Haskell constant to the life of a Nix constant,
nvConstant :: Applicative f
  => NAtom
  -> NValue t f m
nvConstant :: NAtom -> NValue t f m
nvConstant = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> (NAtom -> NValue' t f m (NValue t f m)) -> NAtom -> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NAtom -> NValue' t f m (NValue t f m)
forall (f :: * -> *) t (m :: * -> *) r.
Applicative f =>
NAtom -> NValue' t f m r
nvConstant'


-- | Life of a Haskell sting & context to the life of a Nix string & context,
nvStr :: Applicative f
  => NixString
  -> NValue t f m
nvStr :: NixString -> NValue t f m
nvStr = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> (NixString -> NValue' t f m (NValue t f m))
-> NixString
-> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixString -> NValue' t f m (NValue t f m)
forall (f :: * -> *) t (m :: * -> *) r.
Applicative f =>
NixString -> NValue' t f m r
nvStr'


-- | Life of a Haskell FilePath to the life of a Nix path
nvPath :: Applicative f
  => FilePath
  -> NValue t f m
nvPath :: FilePath -> NValue t f m
nvPath = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> (FilePath -> NValue' t f m (NValue t f m))
-> FilePath
-> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> NValue' t f m (NValue t f m)
forall (f :: * -> *) t (m :: * -> *) r.
Applicative f =>
FilePath -> NValue' t f m r
nvPath'


nvList :: Applicative f
  => [NValue t f m]
  -> NValue t f m
nvList :: [NValue t f m] -> NValue t f m
nvList = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> ([NValue t f m] -> NValue' t f m (NValue t f m))
-> [NValue t f m]
-> NValue t f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [NValue t f m] -> NValue' t f m (NValue t f m)
forall (f :: * -> *) r t (m :: * -> *).
Applicative f =>
[r] -> NValue' t f m r
nvList'


nvSet :: Applicative f
  => HashMap Text SourcePos
  -> HashMap Text (NValue t f m)
  -> NValue t f m
nvSet :: AttrSet SourcePos -> HashMap Text (NValue t f m) -> NValue t f m
nvSet AttrSet SourcePos
x HashMap Text (NValue t f m)
s = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> NValue' t f m (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$ AttrSet SourcePos
-> HashMap Text (NValue t f m) -> NValue' t f m (NValue t f m)
forall (f :: * -> *) r t (m :: * -> *).
Applicative f =>
AttrSet SourcePos -> HashMap Text r -> NValue' t f m r
nvSet' AttrSet SourcePos
x HashMap Text (NValue t f m)
s


nvClosure :: (Applicative f, Functor m)
  => Params ()
  -> (NValue t f m
      -> m (NValue t f m)
    )
  -> NValue t f m
nvClosure :: Params () -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvClosure Params ()
x NValue t f m -> m (NValue t f m)
f = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> NValue' t f m (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$ Params ()
-> (NValue t f m -> m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall (f :: * -> *) (m :: * -> *) t r.
(Applicative f, Functor m) =>
Params () -> (NValue t f m -> m r) -> NValue' t f m r
nvClosure' Params ()
x NValue t f m -> m (NValue t f m)
f


nvBuiltin :: (Applicative f, Functor m)
  => Text
  -> (NValue t f m
    -> m (NValue t f m)
    )
  -> NValue t f m
nvBuiltin :: Text -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltin Text
name NValue t f m -> m (NValue t f m)
f = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (NValue t f m) -> NValue t f m)
-> NValue' t f m (NValue t f m) -> NValue t f m
forall a b. (a -> b) -> a -> b
$ Text
-> (NValue t f m -> m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall (f :: * -> *) (m :: * -> *) t r.
(Applicative f, Functor m) =>
Text -> (NValue t f m -> m r) -> NValue' t f m r
nvBuiltin' Text
name NValue t f m -> m (NValue t f m)
f


builtin
  :: forall m f t
   . (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => Text
  -> ( NValue t f m
    -> m (NValue t f m)
    )
  -> m (NValue t f m)
builtin :: Text -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin Text
name NValue t f m -> m (NValue t f m)
f = NValue t f m -> m (NValue t f m)
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)
forall a b. (a -> b) -> a -> b
$ Text -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
forall (f :: * -> *) (m :: * -> *) t.
(Applicative f, Functor m) =>
Text -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltin Text
name ((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
forall a b. (a -> b) -> a -> b
$ \NValue t f m
a -> NValue t f m -> m (NValue t f m)
f NValue t f m
a


builtin2
  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => Text
  -> ( NValue t f m
    -> NValue t f m
    -> m (NValue t f m)
    )
  -> m (NValue t f m)
builtin2 :: Text
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin2 Text
name NValue t f m -> NValue t f m -> m (NValue t f m)
f = Text -> (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) =>
Text -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin Text
name ((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)
forall a b. (a -> b) -> a -> b
$ \NValue t f m
a -> Text -> (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) =>
Text -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin Text
name ((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)
forall a b. (a -> b) -> a -> b
$ \NValue t f m
b -> NValue t f m -> NValue t f m -> m (NValue t f m)
f NValue t f m
a NValue t f m
b


builtin3
  :: (MonadThunk t m (NValue t f m), MonadDataContext f m)
  => Text
  -> ( NValue t f m
    -> NValue t f m
    -> NValue t f m
    -> m (NValue t f m)
    )
  -> m (NValue t f m)
builtin3 :: Text
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin3 Text
name NValue t f m -> NValue t f m -> NValue t f m -> m (NValue t f m)
f =
  Text -> (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) =>
Text -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin Text
name ((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)
forall a b. (a -> b) -> a -> b
$ \NValue t f m
a -> Text -> (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) =>
Text -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin Text
name ((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)
forall a b. (a -> b) -> a -> b
$ \NValue t f m
b -> Text -> (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) =>
Text -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin Text
name ((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)
forall a b. (a -> b) -> a -> b
$ \NValue t f m
c -> NValue t f m -> NValue t f m -> NValue t f m -> m (NValue t f m)
f NValue t f m
a NValue t f m
b NValue t f m
c

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

pattern $mNVThunk :: forall r (f :: * -> *) a. Free f a -> (a -> r) -> (Void# -> r) -> r
NVThunk t <- Pure t
pattern $mNVValue :: forall r (f :: * -> *) a.
Free f a -> (f (Free f a) -> r) -> (Void# -> r) -> r
NVValue v <- Free v
{-# COMPLETE NVThunk, NVValue #-}
pattern $mNVConstant :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a -> (NAtom -> r) -> (Void# -> r) -> r
NVConstant x <- Free (NVConstant' x)
pattern $mNVStr :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a -> (NixString -> r) -> (Void# -> r) -> r
NVStr ns <- Free (NVStr' ns)
pattern $mNVPath :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a -> (FilePath -> r) -> (Void# -> r) -> r
NVPath x <- Free (NVPath' x)
pattern $mNVList :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a
-> ([Free (NValue' t w m) a] -> r) -> (Void# -> r) -> r
NVList l <- Free (NVList' l)
pattern $mNVSet :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a
-> (AttrSet (Free (NValue' t w m) a) -> AttrSet SourcePos -> r)
-> (Void# -> r)
-> r
NVSet s x <- Free (NVSet' s x)
pattern $mNVClosure :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a
-> (Params () -> (NValue t w m -> m (Free (NValue' t w m) a)) -> r)
-> (Void# -> r)
-> r
NVClosure x f <- Free (NVClosure' x f)
pattern $mNVBuiltin :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a
-> (Text -> (NValue t w m -> m (Free (NValue' t w m) a)) -> r)
-> (Void# -> r)
-> r
NVBuiltin name f <- Free (NVBuiltin' name f)
{-# COMPLETE NVThunk, NVConstant, NVStr, NVPath, NVList, NVSet, NVClosure, NVBuiltin #-}



-- * @TStringContext@

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

-- * @ValueType@

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


-- | Determine type of a value
valueType :: NValueF a m r -> ValueType
valueType :: NValueF a m r -> ValueType
valueType =
  \case
    NVConstantF NAtom
a ->
      case NAtom
a of
        NURI   Text
_ -> TStringContext -> ValueType
TString TStringContext
NoContext
        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 -> TStringContext -> Bool -> TStringContext
forall a. a -> a -> Bool -> a
bool
          TStringContext
NoContext
          TStringContext
HasContext
          (NixString -> Bool
stringHasContext 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"
    TString TStringContext
HasContext -> Text
"a string with context"
    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 :: 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 (w :: * -> *) a. Comonad w => w a -> a
extract -> NValueF (NValue t f m) m (NValue t f m)
v))) =
  Text -> m Text
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 (Comonad f, Show t) => Show (ValueFrame t f m)


-- * @MonadDataContext@

type MonadDataContext f (m :: * -> *)
  = (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 Eq1 NValue'@

-- TH derivable works only after MonadDataContext
$(deriveEq1 ''NValue')


-- * @NValue'@ 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 :: Text -> LensLike' g (NValue' t f m a) (Maybe a)
key Text
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)))
-> LensLike' g (NValue' t f m a) (Maybe 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)
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
. ((AttrSet a, AttrSet SourcePos)
 -> g (AttrSet a, AttrSet SourcePos))
-> NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a)
forall (f :: * -> *) r p (m :: * -> *).
Applicative f =>
((AttrSet r, AttrSet SourcePos)
 -> f (AttrSet r, AttrSet SourcePos))
-> NValueF p m r -> f (NValueF p m r)
_NVSetF (((AttrSet a, AttrSet SourcePos)
  -> g (AttrSet a, AttrSet SourcePos))
 -> NValueF (NValue t f m) m a -> g (NValueF (NValue t f m) m a))
-> ((Maybe a -> g (Maybe a))
    -> (AttrSet a, AttrSet SourcePos)
    -> g (AttrSet a, AttrSet SourcePos))
-> (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
  (AttrSet a, AttrSet SourcePos)
  (AttrSet a, AttrSet SourcePos)
  (AttrSet a)
  (AttrSet a)
forall a r b. Lens (a, r) (b, r) a b
_1 LensLike
  g
  (AttrSet a, AttrSet SourcePos)
  (AttrSet a, AttrSet SourcePos)
  (AttrSet a)
  (AttrSet a)
-> ((Maybe a -> g (Maybe a)) -> AttrSet a -> g (AttrSet a))
-> (Maybe a -> g (Maybe a))
-> (AttrSet a, AttrSet SourcePos)
-> g (AttrSet a, AttrSet SourcePos)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Lens' (AttrSet a) (Maybe a)
forall v. Text -> Lens' (AttrSet v) (Maybe v)
hashAt Text
k