{-# language CPP #-}

module Nix.String.Coerce where

import           Nix.Prelude
import           Control.Monad.Catch            ( MonadThrow )
import           GHC.Exception                  ( ErrorCall(ErrorCall) )
import qualified Data.HashMap.Lazy             as M
import           Nix.Atoms
import           Nix.Expr.Types                 ( VarName )
import           Nix.Effects
import           Nix.Frames
import           Nix.String
import           Nix.Value
import           Nix.Value.Monad

#ifdef MIN_VERSION_ghc_datasize
import           GHC.DataSize
#endif

-- | Data type to avoid boolean blindness on what used to be called coerceMore
data CoercionLevel
  = CoerceStringlike
  -- ^ Coerce only stringlike types: strings, paths
  | CoerceAny
  -- ^ Coerce everything but functions
  deriving (CoercionLevel -> CoercionLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CoercionLevel -> CoercionLevel -> Bool
$c/= :: CoercionLevel -> CoercionLevel -> Bool
== :: CoercionLevel -> CoercionLevel -> Bool
$c== :: CoercionLevel -> CoercionLevel -> Bool
Eq,Eq CoercionLevel
CoercionLevel -> CoercionLevel -> Bool
CoercionLevel -> CoercionLevel -> Ordering
CoercionLevel -> CoercionLevel -> CoercionLevel
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CoercionLevel -> CoercionLevel -> CoercionLevel
$cmin :: CoercionLevel -> CoercionLevel -> CoercionLevel
max :: CoercionLevel -> CoercionLevel -> CoercionLevel
$cmax :: CoercionLevel -> CoercionLevel -> CoercionLevel
>= :: CoercionLevel -> CoercionLevel -> Bool
$c>= :: CoercionLevel -> CoercionLevel -> Bool
> :: CoercionLevel -> CoercionLevel -> Bool
$c> :: CoercionLevel -> CoercionLevel -> Bool
<= :: CoercionLevel -> CoercionLevel -> Bool
$c<= :: CoercionLevel -> CoercionLevel -> Bool
< :: CoercionLevel -> CoercionLevel -> Bool
$c< :: CoercionLevel -> CoercionLevel -> Bool
compare :: CoercionLevel -> CoercionLevel -> Ordering
$ccompare :: CoercionLevel -> CoercionLevel -> Ordering
Ord,Int -> CoercionLevel
CoercionLevel -> Int
CoercionLevel -> [CoercionLevel]
CoercionLevel -> CoercionLevel
CoercionLevel -> CoercionLevel -> [CoercionLevel]
CoercionLevel -> CoercionLevel -> CoercionLevel -> [CoercionLevel]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CoercionLevel -> CoercionLevel -> CoercionLevel -> [CoercionLevel]
$cenumFromThenTo :: CoercionLevel -> CoercionLevel -> CoercionLevel -> [CoercionLevel]
enumFromTo :: CoercionLevel -> CoercionLevel -> [CoercionLevel]
$cenumFromTo :: CoercionLevel -> CoercionLevel -> [CoercionLevel]
enumFromThen :: CoercionLevel -> CoercionLevel -> [CoercionLevel]
$cenumFromThen :: CoercionLevel -> CoercionLevel -> [CoercionLevel]
enumFrom :: CoercionLevel -> [CoercionLevel]
$cenumFrom :: CoercionLevel -> [CoercionLevel]
fromEnum :: CoercionLevel -> Int
$cfromEnum :: CoercionLevel -> Int
toEnum :: Int -> CoercionLevel
$ctoEnum :: Int -> CoercionLevel
pred :: CoercionLevel -> CoercionLevel
$cpred :: CoercionLevel -> CoercionLevel
succ :: CoercionLevel -> CoercionLevel
$csucc :: CoercionLevel -> CoercionLevel
Enum,CoercionLevel
forall a. a -> a -> Bounded a
maxBound :: CoercionLevel
$cmaxBound :: CoercionLevel
minBound :: CoercionLevel
$cminBound :: CoercionLevel
Bounded)

-- | Data type to avoid boolean blindness on what used to be called copyToStore
data CopyToStoreMode
  = CopyToStore
  -- ^ Add paths to the store as they are encountered
  | DontCopyToStore
  -- ^ Add paths to the store as they are encountered
  deriving (CopyToStoreMode -> CopyToStoreMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CopyToStoreMode -> CopyToStoreMode -> Bool
$c/= :: CopyToStoreMode -> CopyToStoreMode -> Bool
== :: CopyToStoreMode -> CopyToStoreMode -> Bool
$c== :: CopyToStoreMode -> CopyToStoreMode -> Bool
Eq,Eq CopyToStoreMode
CopyToStoreMode -> CopyToStoreMode -> Bool
CopyToStoreMode -> CopyToStoreMode -> Ordering
CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode
$cmin :: CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode
max :: CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode
$cmax :: CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode
>= :: CopyToStoreMode -> CopyToStoreMode -> Bool
$c>= :: CopyToStoreMode -> CopyToStoreMode -> Bool
> :: CopyToStoreMode -> CopyToStoreMode -> Bool
$c> :: CopyToStoreMode -> CopyToStoreMode -> Bool
<= :: CopyToStoreMode -> CopyToStoreMode -> Bool
$c<= :: CopyToStoreMode -> CopyToStoreMode -> Bool
< :: CopyToStoreMode -> CopyToStoreMode -> Bool
$c< :: CopyToStoreMode -> CopyToStoreMode -> Bool
compare :: CopyToStoreMode -> CopyToStoreMode -> Ordering
$ccompare :: CopyToStoreMode -> CopyToStoreMode -> Ordering
Ord,Int -> CopyToStoreMode
CopyToStoreMode -> Int
CopyToStoreMode -> [CopyToStoreMode]
CopyToStoreMode -> CopyToStoreMode
CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
CopyToStoreMode
-> CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CopyToStoreMode
-> CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
$cenumFromThenTo :: CopyToStoreMode
-> CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
enumFromTo :: CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
$cenumFromTo :: CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
enumFromThen :: CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
$cenumFromThen :: CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
enumFrom :: CopyToStoreMode -> [CopyToStoreMode]
$cenumFrom :: CopyToStoreMode -> [CopyToStoreMode]
fromEnum :: CopyToStoreMode -> Int
$cfromEnum :: CopyToStoreMode -> Int
toEnum :: Int -> CopyToStoreMode
$ctoEnum :: Int -> CopyToStoreMode
pred :: CopyToStoreMode -> CopyToStoreMode
$cpred :: CopyToStoreMode -> CopyToStoreMode
succ :: CopyToStoreMode -> CopyToStoreMode
$csucc :: CopyToStoreMode -> CopyToStoreMode
Enum,CopyToStoreMode
forall a. a -> a -> Bounded a
maxBound :: CopyToStoreMode
$cmaxBound :: CopyToStoreMode
minBound :: CopyToStoreMode
$cminBound :: CopyToStoreMode
Bounded)

--  2021-10-30: NOTE: This seems like metafunction that really is a bunch of functions thrown together.
-- Both code blocks are `\case` - which means they can be or 2 functions, or just as well can be one `\case` that goes through all of them and does not require a `CoercionLevel`. Use of function shows that - the `CoercionLevel` not once was used polymorphically.
-- Also `CopyToStoreMode` acts only in case of `NVPath` - that is a separate function
coerceToString
  :: forall e t f m
   . ( Framed e m
     , MonadStore m
     , MonadThrow m
     , MonadDataErrorContext t f m
     , MonadValue (NValue t f m) m
     )
  => (NValue t f m -> NValue t f m -> m (NValue t f m))
  -> CopyToStoreMode
  -> CoercionLevel
  -> NValue t f m
  -> m NixString
coerceToString :: forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
coerceToString NValue t f m -> NValue t f m -> m (NValue t f m)
call CopyToStoreMode
ctsm CoercionLevel
clevel =
  forall a. a -> a -> Bool -> a
bool
    (forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> NValue t f m -> m NixString
coerceAnyToNixString NValue t f m -> NValue t f m -> m (NValue t f m)
call CopyToStoreMode
ctsm)
    (forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
CopyToStoreMode -> NValue t f m -> m NixString
coerceStringlikeToNixString CopyToStoreMode
ctsm)
    (CoercionLevel
clevel forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceStringlike)

coerceAnyToNixString
  :: forall e t f m
   . ( Framed e m
     , MonadStore m
     , MonadThrow m
     , MonadDataErrorContext t f m
     , MonadValue (NValue t f m) m
     )
  => (NValue t f m -> NValue t f m -> m (NValue t f m))
  -> CopyToStoreMode
  -> NValue t f m
  -> m NixString
coerceAnyToNixString :: forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
(NValue t f m -> NValue t f m -> m (NValue t f m))
-> CopyToStoreMode -> NValue t f m -> m NixString
coerceAnyToNixString NValue t f m -> NValue t f m -> m (NValue t f m)
call CopyToStoreMode
ctsm = NValue t f m -> m NixString
go
 where
  go :: NValue t f m -> m NixString
  go :: NValue t f m -> m NixString
go NValue t f m
x =
    NValue t f m -> m NixString
coerceAny forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall v (m :: * -> *). MonadValue v m => v -> m v
demand NValue t f m
x
     where
      coerceAny :: NValue t f m -> m NixString
      coerceAny :: NValue t f m -> m NixString
coerceAny =
        \case
          -- TODO Return a singleton for "" and "1"
          NVConstant (NBool Bool
b) ->
            Text -> m NixString
castToNixString forall a b. (a -> b) -> a -> b
$ Text
"1" forall a. Monoid a => a -> Bool -> a
`whenTrue` Bool
b
          NVConstant (NInt Integer
n) ->
            Text -> m NixString
castToNixString forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show Integer
n
          NVConstant (NFloat Float
n) ->
            Text -> m NixString
castToNixString forall a b. (a -> b) -> a -> b
$ forall b a. (Show a, IsString b) => a -> b
show Float
n
          NVConstant NAtom
NNull ->
            Text -> m NixString
castToNixString forall a. Monoid a => a
mempty
          NVList [NValue t f m]
l ->
            [NixString] -> NixString
nixStringUnwords forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse NValue t f m -> m NixString
go [NValue t f m]
l
          v :: NValue t f m
v@(NVSet PositionSet
_ AttrSet (NValue t f m)
s) ->
            forall a. a -> Maybe a -> a
fromMaybe
              (forall {e} {m :: * -> *} {a} {a}.
(MonadReader e m, Has e Frames, MonadThrow m, Show a) =>
a -> m a
err NValue t f m
v)
              forall a b. (a -> b) -> a -> b
$ (NValue t f m -> m (NValue t f m))
-> VarName -> Maybe (m NixString)
continueOnKey (NValue t f m -> NValue t f m -> m (NValue t f m)
`call` NValue t f m
v) VarName
"__toString"
              forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NValue t f m -> m (NValue t f m))
-> VarName -> Maybe (m NixString)
continueOnKey forall (f :: * -> *) a. Applicative f => a -> f a
pure VarName
"outPath"
           where
            continueOnKey :: (NValue t f m -> m (NValue t f m)) -> VarName -> Maybe (m NixString)
            continueOnKey :: (NValue t f m -> m (NValue t f m))
-> VarName -> Maybe (m NixString)
continueOnKey NValue t f m -> m (NValue t f m)
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NValue t f m -> m NixString
go forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< NValue t f m -> m (NValue t f m)
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
`M.lookup` AttrSet (NValue t f m)
s)
            err :: a -> m a
err a
v' = forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ [Char]
"Expected a Set that has `__toString` or `outpath`, but saw: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show a
v'
          NValue t f m
v -> NValue t f m -> m NixString
coerceStringlike NValue t f m
v
       where
        castToNixString :: Text -> m NixString
castToNixString = forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NixString
mkNixStringWithoutContext

        nixStringUnwords :: [NixString] -> NixString
nixStringUnwords = NixString -> [NixString] -> NixString
intercalateNixString forall a b. (a -> b) -> a -> b
$ Text -> NixString
mkNixStringWithoutContext Text
" "

      coerceStringlike :: NValue t f m -> m NixString
      coerceStringlike :: NValue t f m -> m NixString
coerceStringlike = forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
CopyToStoreMode -> NValue t f m -> m NixString
coerceStringlikeToNixString CopyToStoreMode
ctsm

coerceStringlikeToNixString
  :: forall e t f m
   . ( Framed e m
     , MonadStore m
     , MonadThrow m
     , MonadDataErrorContext t f m
     , MonadValue (NValue t f m) m
     )
  => CopyToStoreMode
  -> NValue t f m
  -> m NixString
coerceStringlikeToNixString :: forall e t (f :: * -> *) (m :: * -> *).
(Framed e m, MonadStore m, MonadThrow m,
 MonadDataErrorContext t f m, MonadValue (NValue t f m) m) =>
CopyToStoreMode -> NValue t f m -> m NixString
coerceStringlikeToNixString CopyToStoreMode
ctsm =
  (\case
    NVStr NixString
ns -> forall (f :: * -> *) a. Applicative f => a -> f a
pure NixString
ns
    NVPath Path
p -> forall (m :: * -> *) e.
(MonadStore m, Framed e m) =>
CopyToStoreMode -> Path -> m NixString
coercePathToNixString CopyToStoreMode
ctsm Path
p
    NValue t f m
v -> forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError forall a b. (a -> b) -> a -> b
$ [Char] -> ErrorCall
ErrorCall forall a b. (a -> b) -> a -> b
$ [Char]
"Expected a path or string, but saw: " forall a. Semigroup a => a -> a -> a
<> forall b a. (Show a, IsString b) => a -> b
show NValue t f m
v
  ) forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall v (m :: * -> *). MonadValue v m => v -> m v
demand

-- | Convert @Path@ into @NixString@.
-- With an additional option to store the resolved path into Nix Store.
coercePathToNixString :: (MonadStore m, Framed e m) => CopyToStoreMode -> Path -> m NixString
coercePathToNixString :: forall (m :: * -> *) e.
(MonadStore m, Framed e m) =>
CopyToStoreMode -> Path -> m NixString
coercePathToNixString =
  forall a. a -> a -> Bool -> a
bool
    (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> NixString
mkNixStringWithoutContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce)
    ((StorePath -> NixString
storePathToNixString forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
Path -> m StorePath
addPath)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CopyToStoreMode
CopyToStore forall a. Eq a => a -> a -> Bool
==)
 where
  storePathToNixString :: StorePath -> NixString
  storePathToNixString :: StorePath -> NixString
storePathToNixString (forall a. IsString a => [Char] -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. coerce :: forall a b. Coercible a b => a -> b
coerce -> VarName
sp) =
    (StringContext -> VarName -> NixString
mkNixStringWithSingletonContext forall b c a. (b -> c) -> (a -> b) -> a -> c
. ContextFlavor -> VarName -> StringContext
StringContext ContextFlavor
DirectPath) VarName
sp VarName
sp