{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE ViewPatterns #-}

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

module Nix.Value where

import           Control.Comonad                ( Comonad, extract )
import           Control.Exception              ( Exception )
import           Control.Monad                  ( (<=<) )
import           Control.Monad.Free             ( Free(..)
                                                , hoistFree, iter, iterM )
import           Control.Monad.Trans.Class      ( MonadTrans, lift )
import qualified Data.Aeson                    as A
import           Data.Functor.Classes           ( Show1
                                                , liftShowsPrec
                                                , showsUnaryWith )
import           Data.HashMap.Lazy              ( HashMap )
import           Data.Text                      ( Text )
import           Data.Typeable                  ( Typeable )
import           GHC.Generics                   ( Generic )
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
import           Nix.Utils

-- | An 'NValue' is the most reduced form of an 'NExpr' after evaluation is
--   completed. 's' is related to the type of errors that might occur during
--   construction or use of a value.
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 String (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)

-- | This 'Foldable' instance only folds what the value actually is known to
--   contain at time of fold.
instance Foldable (NValueF p m) where
  foldMap :: (a -> m) -> NValueF p m a -> m
foldMap f :: a -> m
f = \case
    NVConstantF _  -> m
forall a. Monoid a => a
mempty
    NVStrF      _  -> m
forall a. Monoid a => a
mempty
    NVPathF     _  -> m
forall a. Monoid a => a
mempty
    NVListF     l :: [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     s :: AttrSet a
s _ -> (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 _ _ -> m
forall a. Monoid a => a
mempty
    NVBuiltinF _ _ -> m
forall a. Monoid a => a
mempty

instance Show r => Show (NValueF p m r) where
  showsPrec :: Int -> NValueF p m r -> ShowS
showsPrec = (NValueF p m r -> Int -> ShowS) -> Int -> NValueF p m r -> ShowS
forall a b c. (a -> b -> c) -> b -> a -> c
flip NValueF p m r -> Int -> ShowS
forall r p (m :: * -> *). Show r => NValueF p m r -> Int -> ShowS
go   where
    go :: NValueF p m r -> Int -> ShowS
go (NVConstantF atom :: NAtom
atom  ) = String -> NAtom -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVConstant" NAtom
atom
    go (NVStrF      ns :: NixString
ns    ) = String -> Text -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVStr" (NixString -> Text
hackyStringIgnoreContext NixString
ns)
    go (NVListF     lst :: [r]
lst   ) = String -> [r] -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVList" [r]
lst
    go (NVSetF     attrs :: AttrSet r
attrs _) = String -> AttrSet r -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVSet" AttrSet r
attrs
    go (NVClosureF p :: Params ()
p     _) = String -> Params () -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVClosure" Params ()
p
    go (NVPathF p :: String
p         ) = String -> String -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVPath" String
p
    go (NVBuiltinF name :: String
name _ ) = String -> String -> Int -> ShowS
forall a. Show a => String -> a -> Int -> ShowS
showsCon1 "NVBuiltin" String
name

    showsCon1 :: Show a => String -> a -> Int -> String -> String
    showsCon1 :: String -> a -> Int -> ShowS
showsCon1 con :: String
con a :: a
a d :: Int
d =
      Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString (String
con String -> ShowS
forall a. [a] -> [a] -> [a]
++ " ") ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec 11 a
a

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 f :: b -> a
f = \case
  NVConstantF a :: NAtom
a  -> NAtom -> NValueF b m r
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
a
  NVStrF      s :: NixString
s  -> NixString -> NValueF b m r
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
s
  NVPathF     p :: String
p  -> String -> NValueF b m r
forall p (m :: * -> *) r. String -> NValueF p m r
NVPathF String
p
  NVListF     l :: [r]
l  -> [r] -> NValueF b m r
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [r]
l
  NVSetF     s :: AttrSet r
s p :: 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 p :: Params ()
p g :: 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 s :: String
s g :: a -> m r
g -> String -> (b -> m r) -> NValueF b m r
forall p (m :: * -> *) r. String -> (p -> m r) -> NValueF p m r
NVBuiltinF String
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)

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 lft :: forall x. m x -> n x
lft = \case
  NVConstantF a :: NAtom
a  -> NAtom -> NValueF p n a
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
a
  NVStrF      s :: NixString
s  -> NixString -> NValueF p n a
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
s
  NVPathF     p :: String
p  -> String -> NValueF p n a
forall p (m :: * -> *) r. String -> NValueF p m r
NVPathF String
p
  NVListF     l :: [a]
l  -> [a] -> NValueF p n a
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [a]
l
  NVSetF     s :: AttrSet a
s p :: 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
  NVClosureF p :: Params ()
p g :: 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)
  NVBuiltinF s :: String
s g :: p -> m a
g -> String -> (p -> n a) -> NValueF p n a
forall p (m :: * -> *) r. String -> (p -> m r) -> NValueF p m r
NVBuiltinF String
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)

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 transform :: forall x. n x -> m x
transform = \case
  NVConstantF a :: 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      s :: 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     p :: String
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
$ String -> NValueF p m a
forall p (m :: * -> *) r. String -> NValueF p m r
NVPathF String
p
  NVListF     l :: [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     s :: AttrSet (n a)
s p :: AttrSet SourcePos
p -> AttrSet a -> AttrSet SourcePos -> NValueF p m a
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF (AttrSet a -> AttrSet SourcePos -> NValueF p m a)
-> n (AttrSet a) -> n (AttrSet SourcePos -> 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)
sequenceA AttrSet (n a)
s n (AttrSet SourcePos -> NValueF p m a)
-> n (AttrSet SourcePos) -> n (NValueF p m a)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttrSet SourcePos -> n (AttrSet SourcePos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet SourcePos
p
  NVClosureF p :: Params ()
p g :: 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 s :: String
s g :: 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
$ String -> (p -> m a) -> NValueF p m a
forall p (m :: * -> *) r. String -> (p -> m r) -> NValueF p m r
NVBuiltinF String
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)

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 transform :: forall x. n x -> m x
transform f :: a -> n b
f = \case
  NVConstantF a :: 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      s :: 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     p :: String
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
$ String -> NValueF p m b
forall p (m :: * -> *) r. String -> NValueF p m r
NVPathF String
p
  NVListF     l :: [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     s :: AttrSet a
s p :: AttrSet SourcePos
p -> AttrSet b -> AttrSet SourcePos -> NValueF p m b
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF (AttrSet b -> AttrSet SourcePos -> NValueF p m b)
-> n (AttrSet b) -> n (AttrSet SourcePos -> 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)
traverse a -> n b
f AttrSet a
s n (AttrSet SourcePos -> NValueF p m b)
-> n (AttrSet SourcePos) -> n (NValueF p m b)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> AttrSet SourcePos -> n (AttrSet SourcePos)
forall (f :: * -> *) a. Applicative f => a -> f a
pure AttrSet SourcePos
p
  NVClosureF p :: Params ()
p g :: 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 s :: String
s g :: 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
$ String -> (p -> m b) -> NValueF p m b
forall p (m :: * -> *) r. String -> (p -> m r) -> NValueF p m r
NVBuiltinF String
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)

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

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

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

-- | 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 { 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 -> String
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 -> String
forall a. Show a => a -> String
show NValueF (NValue t f m) m a
v

instance Comonad f => Show1 (NValue' t f m) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> NValue' t f m a -> ShowS
liftShowsPrec sp :: Int -> a -> ShowS
sp sl :: [a] -> ShowS
sl p :: Int
p = \case
    NVConstant' atom :: 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 "NVConstantF" Int
p NAtom
atom
    NVStr' ns :: 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 "NVStrF" Int
p (NixString -> Text
hackyStringIgnoreContext NixString
ns)
    NVList' lst :: [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 (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "NVListF" Int
p [a]
lst
    NVSet' attrs :: 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 (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl) "NVSetF" Int
p AttrSet a
attrs
    NVPath' path :: String
path      -> (Int -> String -> ShowS) -> String -> Int -> String -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec "NVPathF" Int
p String
path
    NVClosure' c :: Params ()
c    _ -> (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 "NVClosureF" Int
p Params ()
c
    NVBuiltin' name :: String
name _ -> (Int -> String -> ShowS) -> String -> Int -> String -> ShowS
forall a. (Int -> a -> ShowS) -> String -> Int -> a -> ShowS
showsUnaryWith Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec "NVBuiltinF" Int
p String
name
    _                 -> String -> ShowS
forall a. HasCallStack => String -> a
error "Pattern synonyms mask coverage"

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' transform :: forall x. n x -> m x
transform (NValue v :: 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

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' transform :: forall x. n x -> m x
transform f :: a -> n b
f (NValue v :: 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

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' run :: forall x. n x -> m x
run lft :: forall x. m x -> n x
lft (NValue v :: 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 ((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
fmap ((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) f (NValueF (NValue t f m) m a)
v)

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' run :: 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

unliftNValue'
  :: (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. u m x -> m x) -> NValue' t f (u m) a -> NValue' t f m a
unliftNValue' run :: forall x. u m x -> m x
run = (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 forall x. u m x -> m x
run

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' k :: a -> (NValue' t f m a -> r) -> r
k f :: 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 -> 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))

-- | An 'NValueNF' is a fully evaluated value in normal form. An 'NValue f t m' is
--   a value in head normal form, where only the "top layer" has been
--   evaluated. An action of type 'm (NValue f t m)' is a pending evaluation that
--   has yet to be performed. An 't' is either a pending evaluation, or
--   a value in head normal form. A 'NThunkSet' is a set of mappings from keys
--   to thunks.
--
--   The 'Free' structure is used here to represent the possibility that
--   cycles may appear during normalization.

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

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 run :: forall x. n x -> m x
run lft :: 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 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)

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 run :: 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

unliftNValue
  :: (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. u m x -> m x) -> NValue t f (u m) -> NValue t f m
unliftNValue run :: forall x. u m x -> m x
run = (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 forall x. u m x -> m x
run

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 k :: t -> (NValue t f m -> r) -> r
k f :: 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 -> 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))

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 transform :: forall x. n x -> m x
transform k :: t -> (NValue t f m -> n r) -> n r
k f :: 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)
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 -> 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
fmap (\t :: t
t -> t -> (NValue t f m -> n r) -> n r
k t
t ((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))
  where
    go :: Free (NValue' t f m) (n r) -> n (Free (NValue' t f m) r)
go (Pure x :: n r
x) = r -> Free (NValue' t f m) r
forall (f :: * -> *) a. a -> Free f a
Pure (r -> Free (NValue' t f m) r) -> n r -> n (Free (NValue' t f m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> n r
x
    go (Free fa :: NValue' t f m (Free (NValue' t f m) (n r))
fa) = NValue' t f m (Free (NValue' t f m) r) -> Free (NValue' t f m) r
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (NValue' t f m (Free (NValue' t f m) r) -> Free (NValue' t f m) r)
-> n (NValue' t f m (Free (NValue' t f m) r))
-> n (Free (NValue' t f m) r)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall x. n x -> m x)
-> (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))
-> n (NValue' t f m (Free (NValue' t f m) r))
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 r) -> n (Free (NValue' t f m) r)
go NValue' t f m (Free (NValue' t f m) (n r))
fa

pattern $mNVThunk :: forall r (f :: * -> *) a. Free f a -> (a -> r) -> (Void# -> r) -> r
NVThunk t <- Pure t

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

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 $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)

nvConstant' :: Applicative f => NAtom -> NValue' t f m r
nvConstant' :: NAtom -> NValue' t f m r
nvConstant' x :: NAtom
x = 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NAtom -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
x))
nvConstant :: Applicative f => NAtom -> NValue t f m
nvConstant :: NAtom -> NValue t f m
nvConstant x :: NAtom
x = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NAtom -> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r. NAtom -> NValueF p m r
NVConstantF NAtom
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 $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)

nvStr' :: Applicative f => NixString -> NValue' t f m r
nvStr' :: NixString -> NValue' t f m r
nvStr' ns :: NixString
ns = 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
ns))
nvStr :: Applicative f => NixString -> NValue t f m
nvStr :: NixString -> NValue t f m
nvStr ns :: NixString
ns = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r. NixString -> NValueF p m r
NVStrF NixString
ns)))

pattern $mNVPath' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a -> (String -> r) -> (Void# -> r) -> r
NVPath' x <- NValue (extract -> NVPathF x)
pattern $mNVPath :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a -> (String -> r) -> (Void# -> r) -> r
NVPath x <- Free (NVPath' x)

nvPath' :: Applicative f => FilePath -> NValue' t f m r
nvPath' :: String -> NValue' t f m r
nvPath' x :: String
x = 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. String -> NValueF p m r
NVPathF String
x))
nvPath :: Applicative f => FilePath -> NValue t f m
nvPath :: String -> NValue t f m
nvPath x :: String
x = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r. String -> NValueF p m r
NVPathF String
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 $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)

nvList' :: Applicative f => [r] -> NValue' t f m r
nvList' :: [r] -> NValue' t f m r
nvList' l :: [r]
l = 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([r] -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [r]
l))
nvList :: Applicative f => [NValue t f m] -> NValue t f m
nvList :: [NValue t f m] -> NValue t f m
nvList l :: [NValue t f m]
l = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([NValue t f m] -> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r. [r] -> NValueF p m r
NVListF [NValue t f m]
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 $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)

nvSet' :: Applicative f
       => HashMap Text r -> HashMap Text SourcePos -> NValue' t f m r
nvSet' :: HashMap Text r -> AttrSet SourcePos -> NValue' t f m r
nvSet' s :: HashMap Text r
s x :: AttrSet SourcePos
x = 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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))
nvSet :: Applicative f
      => HashMap Text (NValue t f m) -> HashMap Text SourcePos -> NValue t f m
nvSet :: HashMap Text (NValue t f m) -> AttrSet SourcePos -> NValue t f m
nvSet s :: HashMap Text (NValue t f m)
s x :: AttrSet SourcePos
x = NValue' t f m (NValue t f m) -> NValue t f m
forall (f :: * -> *) a. f (Free f a) -> Free f a
Free (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HashMap Text (NValue t f m)
-> AttrSet SourcePos -> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r.
AttrSet r -> AttrSet SourcePos -> NValueF p m r
NVSetF HashMap Text (NValue t f m)
s AttrSet SourcePos
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 $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)

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' x :: Params ()
x f :: 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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))
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 x :: Params ()
x f :: 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 (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Params ()
-> (NValue t f m -> m (NValue t f m))
-> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r. Params () -> (p -> m r) -> NValueF p m r
NVClosureF Params ()
x NValue t f m -> m (NValue t f m)
f)))

pattern $mNVBuiltin' :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
NValue' t w m a
-> (String -> (NValue t w m -> m a) -> r) -> (Void# -> r) -> r
NVBuiltin' name f <- NValue (extract -> NVBuiltinF name f)
pattern $mNVBuiltin :: forall r (w :: * -> *) t (m :: * -> *) a.
Comonad w =>
Free (NValue' t w m) a
-> (String -> (NValue t w m -> m (Free (NValue' t w m) a)) -> r)
-> (Void# -> r)
-> r
NVBuiltin name f <- Free (NVBuiltin' name f)

nvBuiltin' :: (Applicative f, Functor m)
           => String -> (NValue t f m -> m r) -> NValue' t f m r
nvBuiltin' :: String -> (NValue t f m -> m r) -> NValue' t f m r
nvBuiltin' name :: String
name f :: 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 (NValueF (NValue t f m) m r -> f (NValueF (NValue t f m) m r)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> (NValue t f m -> m r) -> NValueF (NValue t f m) m r
forall p (m :: * -> *) r. String -> (p -> m r) -> NValueF p m r
NVBuiltinF String
name NValue t f m -> m r
f))
nvBuiltin :: (Applicative f, Functor m)
          => String -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltin :: String -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltin name :: String
name f :: 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 (f (NValueF (NValue t f m) m (NValue t f m))
-> NValue' t f m (NValue t f m)
forall t (f :: * -> *) (m :: * -> *) a.
f (NValueF (NValue t f m) m a) -> NValue' t f m a
NValue (NValueF (NValue t f m) m (NValue t f m)
-> f (NValueF (NValue t f m) m (NValue t f m))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String
-> (NValue t f m -> m (NValue t f m))
-> NValueF (NValue t f m) m (NValue t f m)
forall p (m :: * -> *) r. String -> (p -> m r) -> NValueF p m r
NVBuiltinF String
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)
  => String
  -> (NValue t f m -> m (NValue t f m))
  -> m (NValue t f m)
builtin :: String -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin name :: String
name f :: NValue t f m -> m (NValue t f m)
f = NValue t f m -> m (NValue t f m)
forall (m :: * -> *) a. Monad m => a -> m a
return (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
$ String -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
forall (f :: * -> *) (m :: * -> *) t.
(Applicative f, Functor m) =>
String -> (NValue t f m -> m (NValue t f m)) -> NValue t f m
nvBuiltin String
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
$ \a :: 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)
  => String
  -> (NValue t f m -> NValue t f m -> m (NValue t f m))
  -> m (NValue t f m)
builtin2 :: String
-> (NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin2 name :: String
name f :: NValue t f m -> NValue t f m -> m (NValue t f m)
f = String -> (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) =>
String -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin String
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
$ \a :: NValue t f m
a -> String -> (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) =>
String -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin String
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
$ \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)
  => String
  -> (  NValue t f m
     -> NValue t f m
     -> NValue t f m
     -> m (NValue t f m)
     )
  -> m (NValue t f m)
builtin3 :: String
-> (NValue t f m
    -> NValue t f m -> NValue t f m -> m (NValue t f m))
-> m (NValue t f m)
builtin3 name :: String
name f :: NValue t f m -> NValue t f m -> NValue t f m -> m (NValue t f m)
f =
  String -> (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) =>
String -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin String
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
$ \a :: NValue t f m
a -> String -> (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) =>
String -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin String
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
$ \b :: NValue t f m
b -> String -> (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) =>
String -> (NValue t f m -> m (NValue t f m)) -> m (NValue t f m)
builtin String
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
$ \c :: 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

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
showList :: [TStringContext] -> ShowS
$cshowList :: [TStringContext] -> ShowS
show :: TStringContext -> String
$cshow :: TStringContext -> String
showsPrec :: Int -> TStringContext -> ShowS
$cshowsPrec :: Int -> TStringContext -> ShowS
Show

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
showList :: [ValueType] -> ShowS
$cshowList :: [ValueType] -> ShowS
show :: ValueType -> String
$cshow :: ValueType -> String
showsPrec :: Int -> ValueType -> ShowS
$cshowsPrec :: Int -> ValueType -> ShowS
Show

valueType :: NValueF a m r -> ValueType
valueType :: NValueF a m r -> ValueType
valueType = \case
  NVConstantF a :: NAtom
a -> case NAtom
a of
    NURI   _ -> TStringContext -> ValueType
TString TStringContext
NoContext
    NInt   _ -> ValueType
TInt
    NFloat _ -> ValueType
TFloat
    NBool  _ -> ValueType
TBool
    NNull    -> ValueType
TNull
  NVStrF ns :: NixString
ns | NixString -> Bool
stringHasContext NixString
ns -> TStringContext -> ValueType
TString TStringContext
HasContext
            | Bool
otherwise           -> TStringContext -> ValueType
TString TStringContext
NoContext
  NVListF{}    -> ValueType
TList
  NVSetF{}     -> ValueType
TSet
  NVClosureF{} -> ValueType
TClosure
  NVPathF{}    -> ValueType
TPath
  NVBuiltinF{} -> ValueType
TBuiltin

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

showValueType :: (MonadThunk t m (NValue t f m), Comonad f)
              => NValue t f m -> m String
showValueType :: NValue t f m -> m String
showValueType (Pure t :: t
t) = t -> (NValue t f m -> m String) -> m String
forall t (m :: * -> *) a r.
MonadThunk t m a =>
t -> (a -> m r) -> m r
force t
t NValue t f m -> m String
forall t (m :: * -> *) (f :: * -> *).
(MonadThunk t m (NValue t f m), Comonad f) =>
NValue t f m -> m String
showValueType
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))) =
  String -> m String
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> m String) -> String -> m String
forall a b. (a -> b) -> a -> b
$ ValueType -> String
describeValue (ValueType -> String) -> ValueType -> String
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) -> ValueType)
-> NValueF (NValue t f m) m (NValue t f m) -> ValueType
forall a b. (a -> b) -> a -> b
$ NValueF (NValue t f m) m (NValue t f m)
v

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 A.Value
    | Expectation ValueType (NValue t f m)
    deriving Typeable

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

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

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

$(makeTraversals ''NValueF)
$(makeLenses ''NValue')

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 k :: 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