{-# 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) && __GLASGOW_HASKELL__ >= 804
import GHC.DataSize
#endif
#endif
data CoercionLevel
= CoerceStringy
| CoerceAny
deriving (Eq,Ord,Enum,Bounded)
data CopyToStoreMode
= CopyToStore
| DontCopyToStore
deriving (Eq,Ord,Enum,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 call ctsm clevel = go
where
go x = demand x $ \case
NVConstant (NBool b)
|
b && clevel == CoerceAny -> pure
$ principledMakeNixStringWithoutContext "1"
| clevel == CoerceAny -> pure $ principledMakeNixStringWithoutContext ""
NVConstant (NInt n) | clevel == CoerceAny ->
pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
NVConstant (NFloat n) | clevel == CoerceAny ->
pure $ principledMakeNixStringWithoutContext $ Text.pack $ show n
NVConstant NNull | clevel == CoerceAny ->
pure $ principledMakeNixStringWithoutContext ""
NVStr ns -> pure ns
NVPath p
| ctsm == CopyToStore -> storePathToNixString <$> addPath p
| otherwise -> pure $ principledMakeNixStringWithoutContext $ Text.pack p
NVList l | clevel == CoerceAny ->
nixStringUnwords <$> traverse (`demand` go) l
v@(NVSet s _) | Just p <- M.lookup "__toString" s ->
demand p $ (`call` v) >=> go
NVSet s _ | Just p <- M.lookup "outPath" s -> demand p go
v -> throwError $ ErrorCall $ "Expected a string, but saw: " ++ show v
nixStringUnwords =
principledIntercalateNixString (principledMakeNixStringWithoutContext " ")
storePathToNixString :: StorePath -> NixString
storePathToNixString sp = principledMakeNixStringWithSingletonContext
t
(StringContext t DirectPath)
where t = Text.pack $ unStorePath sp