{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}

module Nix.String.Coerce where

import           Control.Monad
import           Control.Monad.Catch     hiding ( catchJust )
import qualified Data.HashMap.Lazy             as M
import qualified Data.Text                     as Text
import           Nix.Atoms
import           Nix.Effects
import           Nix.Frames
import           Nix.String
import           Nix.Value
import           Nix.Value.Monad

#ifdef MIN_VERSION_ghc_datasize
#if MIN_VERSION_ghc_datasize(0,2,0)
import           GHC.DataSize
#endif
#endif

-- | Data type to avoid boolean blindness on what used to be called coerceMore
data CoercionLevel
  = CoerceStringy
  -- ^ Coerce only stringlike types: strings, paths, and appropriate sets
  | CoerceAny
  -- ^ Coerce everything but functions
  deriving (CoercionLevel -> CoercionLevel -> Bool
(CoercionLevel -> CoercionLevel -> Bool)
-> (CoercionLevel -> CoercionLevel -> Bool) -> Eq CoercionLevel
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
Eq CoercionLevel =>
(CoercionLevel -> CoercionLevel -> Ordering)
-> (CoercionLevel -> CoercionLevel -> Bool)
-> (CoercionLevel -> CoercionLevel -> Bool)
-> (CoercionLevel -> CoercionLevel -> Bool)
-> (CoercionLevel -> CoercionLevel -> Bool)
-> (CoercionLevel -> CoercionLevel -> CoercionLevel)
-> (CoercionLevel -> CoercionLevel -> CoercionLevel)
-> Ord 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
$cp1Ord :: Eq CoercionLevel
Ord,Int -> CoercionLevel
CoercionLevel -> Int
CoercionLevel -> [CoercionLevel]
CoercionLevel -> CoercionLevel
CoercionLevel -> CoercionLevel -> [CoercionLevel]
CoercionLevel -> CoercionLevel -> CoercionLevel -> [CoercionLevel]
(CoercionLevel -> CoercionLevel)
-> (CoercionLevel -> CoercionLevel)
-> (Int -> CoercionLevel)
-> (CoercionLevel -> Int)
-> (CoercionLevel -> [CoercionLevel])
-> (CoercionLevel -> CoercionLevel -> [CoercionLevel])
-> (CoercionLevel -> CoercionLevel -> [CoercionLevel])
-> (CoercionLevel
    -> CoercionLevel -> CoercionLevel -> [CoercionLevel])
-> Enum 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
CoercionLevel -> CoercionLevel -> Bounded 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
(CopyToStoreMode -> CopyToStoreMode -> Bool)
-> (CopyToStoreMode -> CopyToStoreMode -> Bool)
-> Eq CopyToStoreMode
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
Eq CopyToStoreMode =>
(CopyToStoreMode -> CopyToStoreMode -> Ordering)
-> (CopyToStoreMode -> CopyToStoreMode -> Bool)
-> (CopyToStoreMode -> CopyToStoreMode -> Bool)
-> (CopyToStoreMode -> CopyToStoreMode -> Bool)
-> (CopyToStoreMode -> CopyToStoreMode -> Bool)
-> (CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode)
-> (CopyToStoreMode -> CopyToStoreMode -> CopyToStoreMode)
-> Ord 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
$cp1Ord :: Eq CopyToStoreMode
Ord,Int -> CopyToStoreMode
CopyToStoreMode -> Int
CopyToStoreMode -> [CopyToStoreMode]
CopyToStoreMode -> CopyToStoreMode
CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
CopyToStoreMode
-> CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode]
(CopyToStoreMode -> CopyToStoreMode)
-> (CopyToStoreMode -> CopyToStoreMode)
-> (Int -> CopyToStoreMode)
-> (CopyToStoreMode -> Int)
-> (CopyToStoreMode -> [CopyToStoreMode])
-> (CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode])
-> (CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode])
-> (CopyToStoreMode
    -> CopyToStoreMode -> CopyToStoreMode -> [CopyToStoreMode])
-> Enum 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
CopyToStoreMode -> CopyToStoreMode -> Bounded CopyToStoreMode
forall a. a -> a -> Bounded a
maxBound :: CopyToStoreMode
$cmaxBound :: CopyToStoreMode
minBound :: CopyToStoreMode
$cminBound :: CopyToStoreMode
Bounded)

coerceToString
  :: ( 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))
-> CopyToStoreMode -> CoercionLevel -> NValue t f m -> m NixString
coerceToString call :: NValue t f m -> NValue t f m -> m (NValue t f m)
call ctsm :: CopyToStoreMode
ctsm clevel :: CoercionLevel
clevel = NValue t f m -> m NixString
forall e.
(MonadReader e m, Has e Frames) =>
NValue t f m -> m NixString
go
 where
  go :: NValue t f m -> m NixString
go x :: NValue t f m
x = NValue t f m -> (NValue t f m -> m NixString) -> m NixString
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
x ((NValue t f m -> m NixString) -> m NixString)
-> (NValue t f m -> m NixString) -> m NixString
forall a b. (a -> b) -> a -> b
$ \case
    NVConstant (NBool b :: Bool
b)
      |
        -- TODO Return a singleton for "" and "1"
        Bool
b Bool -> Bool -> Bool
&& CoercionLevel
clevel CoercionLevel -> CoercionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceAny -> NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure
      (NixString -> m NixString) -> NixString -> m NixString
forall a b. (a -> b) -> a -> b
$  Text -> NixString
principledMakeNixStringWithoutContext "1"
      | CoercionLevel
clevel CoercionLevel -> CoercionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceAny -> NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> m NixString) -> NixString -> m NixString
forall a b. (a -> b) -> a -> b
$ Text -> NixString
principledMakeNixStringWithoutContext ""
    NVConstant (NInt n :: Integer
n) | CoercionLevel
clevel CoercionLevel -> CoercionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceAny ->
      NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> m NixString) -> NixString -> m NixString
forall a b. (a -> b) -> a -> b
$ Text -> NixString
principledMakeNixStringWithoutContext (Text -> NixString) -> Text -> NixString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Integer -> String
forall a. Show a => a -> String
show Integer
n
    NVConstant (NFloat n :: Float
n) | CoercionLevel
clevel CoercionLevel -> CoercionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceAny ->
      NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> m NixString) -> NixString -> m NixString
forall a b. (a -> b) -> a -> b
$ Text -> NixString
principledMakeNixStringWithoutContext (Text -> NixString) -> Text -> NixString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Float -> String
forall a. Show a => a -> String
show Float
n
    NVConstant NNull | CoercionLevel
clevel CoercionLevel -> CoercionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceAny ->
      NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> m NixString) -> NixString -> m NixString
forall a b. (a -> b) -> a -> b
$ Text -> NixString
principledMakeNixStringWithoutContext ""
    NVStr ns :: NixString
ns -> NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure NixString
ns
    NVPath p :: String
p
      | CopyToStoreMode
ctsm CopyToStoreMode -> CopyToStoreMode -> Bool
forall a. Eq a => a -> a -> Bool
== CopyToStoreMode
CopyToStore -> StorePath -> NixString
storePathToNixString (StorePath -> NixString) -> m StorePath -> m NixString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> m StorePath
forall e (m :: * -> *).
(Framed e m, MonadStore m) =>
String -> m StorePath
addPath String
p
      | Bool
otherwise -> NixString -> m NixString
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NixString -> m NixString) -> NixString -> m NixString
forall a b. (a -> b) -> a -> b
$ Text -> NixString
principledMakeNixStringWithoutContext (Text -> NixString) -> Text -> NixString
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
p
    NVList l :: [NValue t f m]
l | CoercionLevel
clevel CoercionLevel -> CoercionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== CoercionLevel
CoerceAny ->
      [NixString] -> NixString
nixStringUnwords ([NixString] -> NixString) -> m [NixString] -> m NixString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NValue t f m -> m NixString) -> [NValue t f m] -> m [NixString]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (NValue t f m -> (NValue t f m -> m NixString) -> m NixString
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
`demand` NValue t f m -> m NixString
go) [NValue t f m]
l

    v :: NValue t f m
v@(NVSet s :: AttrSet (NValue t f m)
s _) | Just p :: NValue t f m
p <- Text -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup "__toString" AttrSet (NValue t f m)
s ->
      NValue t f m -> (NValue t f m -> m NixString) -> m NixString
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
p ((NValue t f m -> m NixString) -> m NixString)
-> (NValue t f m -> m NixString) -> m NixString
forall a b. (a -> b) -> a -> b
$ (NValue t f m -> NValue t f m -> m (NValue t f m)
`call` NValue t f m
v) (NValue t f m -> m (NValue t f m))
-> (NValue t f m -> m NixString) -> NValue t f m -> m NixString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> NValue t f m -> m NixString
go

    NVSet s :: AttrSet (NValue t f m)
s _ | Just p :: NValue t f m
p <- Text -> AttrSet (NValue t f m) -> Maybe (NValue t f m)
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
M.lookup "outPath" AttrSet (NValue t f m)
s -> NValue t f m -> (NValue t f m -> m NixString) -> m NixString
forall v (m :: * -> *) r. MonadValue v m => v -> (v -> m r) -> m r
demand NValue t f m
p NValue t f m -> m NixString
go

    v :: NValue t f m
v -> ErrorCall -> m NixString
forall s e (m :: * -> *) a.
(Framed e m, Exception s, MonadThrow m) =>
s -> m a
throwError (ErrorCall -> m NixString) -> ErrorCall -> m NixString
forall a b. (a -> b) -> a -> b
$ String -> ErrorCall
ErrorCall (String -> ErrorCall) -> String -> ErrorCall
forall a b. (a -> b) -> a -> b
$ "Expected a string, but saw: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ NValue t f m -> String
forall a. Show a => a -> String
show NValue t f m
v

  nixStringUnwords :: [NixString] -> NixString
nixStringUnwords =
    NixString -> [NixString] -> NixString
principledIntercalateNixString (Text -> NixString
principledMakeNixStringWithoutContext " ")
  storePathToNixString :: StorePath -> NixString
  storePathToNixString :: StorePath -> NixString
storePathToNixString sp :: StorePath
sp = Text -> StringContext -> NixString
principledMakeNixStringWithSingletonContext
    Text
t
    (Text -> ContextFlavor -> StringContext
StringContext Text
t ContextFlavor
DirectPath)
    where t :: Text
t = String -> Text
Text.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ StorePath -> String
unStorePath StorePath
sp