{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Nix.String
  ( NixString
  , principledGetContext
  , principledMakeNixString
  , principledMempty
  , StringContext(..)
  , ContextFlavor(..)
  , NixLikeContext(..)
  , NixLikeContextValue(..)
  , toNixLikeContext
  , fromNixLikeContext
  , stringHasContext
  , principledIntercalateNixString
  , hackyGetStringNoContext
  , principledGetStringNoContext
  , principledStringIgnoreContext
  , hackyStringIgnoreContext
  , hackyMakeNixStringWithoutContext
  , principledMakeNixStringWithoutContext
  , principledMakeNixStringWithSingletonContext
  , principledModifyNixContents
  , principledStringMappend
  , principledStringMempty
  , principledStringMConcat
  , WithStringContext
  , WithStringContextT(..)
  , extractNixString
  , addStringContext
  , addSingletonStringContext
  , runWithStringContextT
  , runWithStringContext
  )
where

import           Control.Monad.Writer
import           Data.Functor.Identity
import qualified Data.HashMap.Lazy             as M
import qualified Data.HashSet                  as S
import           Data.Hashable
import           Data.Text                      ( Text )
import qualified Data.Text                     as Text
import           GHC.Generics

-- {-# WARNING hackyGetStringNoContext, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext "This NixString function needs to be replaced" #-}

-- | A 'ContextFlavor' describes the sum of possible derivations for string contexts
data ContextFlavor =
    DirectPath
  | AllOutputs
  | DerivationOutput !Text
  deriving (Int -> ContextFlavor -> ShowS
[ContextFlavor] -> ShowS
ContextFlavor -> String
(Int -> ContextFlavor -> ShowS)
-> (ContextFlavor -> String)
-> ([ContextFlavor] -> ShowS)
-> Show ContextFlavor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContextFlavor] -> ShowS
$cshowList :: [ContextFlavor] -> ShowS
show :: ContextFlavor -> String
$cshow :: ContextFlavor -> String
showsPrec :: Int -> ContextFlavor -> ShowS
$cshowsPrec :: Int -> ContextFlavor -> ShowS
Show, ContextFlavor -> ContextFlavor -> Bool
(ContextFlavor -> ContextFlavor -> Bool)
-> (ContextFlavor -> ContextFlavor -> Bool) -> Eq ContextFlavor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContextFlavor -> ContextFlavor -> Bool
$c/= :: ContextFlavor -> ContextFlavor -> Bool
== :: ContextFlavor -> ContextFlavor -> Bool
$c== :: ContextFlavor -> ContextFlavor -> Bool
Eq, Eq ContextFlavor
Eq ContextFlavor =>
(ContextFlavor -> ContextFlavor -> Ordering)
-> (ContextFlavor -> ContextFlavor -> Bool)
-> (ContextFlavor -> ContextFlavor -> Bool)
-> (ContextFlavor -> ContextFlavor -> Bool)
-> (ContextFlavor -> ContextFlavor -> Bool)
-> (ContextFlavor -> ContextFlavor -> ContextFlavor)
-> (ContextFlavor -> ContextFlavor -> ContextFlavor)
-> Ord ContextFlavor
ContextFlavor -> ContextFlavor -> Bool
ContextFlavor -> ContextFlavor -> Ordering
ContextFlavor -> ContextFlavor -> ContextFlavor
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 :: ContextFlavor -> ContextFlavor -> ContextFlavor
$cmin :: ContextFlavor -> ContextFlavor -> ContextFlavor
max :: ContextFlavor -> ContextFlavor -> ContextFlavor
$cmax :: ContextFlavor -> ContextFlavor -> ContextFlavor
>= :: ContextFlavor -> ContextFlavor -> Bool
$c>= :: ContextFlavor -> ContextFlavor -> Bool
> :: ContextFlavor -> ContextFlavor -> Bool
$c> :: ContextFlavor -> ContextFlavor -> Bool
<= :: ContextFlavor -> ContextFlavor -> Bool
$c<= :: ContextFlavor -> ContextFlavor -> Bool
< :: ContextFlavor -> ContextFlavor -> Bool
$c< :: ContextFlavor -> ContextFlavor -> Bool
compare :: ContextFlavor -> ContextFlavor -> Ordering
$ccompare :: ContextFlavor -> ContextFlavor -> Ordering
$cp1Ord :: Eq ContextFlavor
Ord, (forall x. ContextFlavor -> Rep ContextFlavor x)
-> (forall x. Rep ContextFlavor x -> ContextFlavor)
-> Generic ContextFlavor
forall x. Rep ContextFlavor x -> ContextFlavor
forall x. ContextFlavor -> Rep ContextFlavor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContextFlavor x -> ContextFlavor
$cfrom :: forall x. ContextFlavor -> Rep ContextFlavor x
Generic)

instance Hashable ContextFlavor

-- | A 'StringContext' ...
data StringContext =
  StringContext { StringContext -> Text
scPath :: !Text
                , StringContext -> ContextFlavor
scFlavor :: !ContextFlavor
                } deriving (StringContext -> StringContext -> Bool
(StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> Bool) -> Eq StringContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StringContext -> StringContext -> Bool
$c/= :: StringContext -> StringContext -> Bool
== :: StringContext -> StringContext -> Bool
$c== :: StringContext -> StringContext -> Bool
Eq, Eq StringContext
Eq StringContext =>
(StringContext -> StringContext -> Ordering)
-> (StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> Bool)
-> (StringContext -> StringContext -> StringContext)
-> (StringContext -> StringContext -> StringContext)
-> Ord StringContext
StringContext -> StringContext -> Bool
StringContext -> StringContext -> Ordering
StringContext -> StringContext -> StringContext
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 :: StringContext -> StringContext -> StringContext
$cmin :: StringContext -> StringContext -> StringContext
max :: StringContext -> StringContext -> StringContext
$cmax :: StringContext -> StringContext -> StringContext
>= :: StringContext -> StringContext -> Bool
$c>= :: StringContext -> StringContext -> Bool
> :: StringContext -> StringContext -> Bool
$c> :: StringContext -> StringContext -> Bool
<= :: StringContext -> StringContext -> Bool
$c<= :: StringContext -> StringContext -> Bool
< :: StringContext -> StringContext -> Bool
$c< :: StringContext -> StringContext -> Bool
compare :: StringContext -> StringContext -> Ordering
$ccompare :: StringContext -> StringContext -> Ordering
$cp1Ord :: Eq StringContext
Ord, Int -> StringContext -> ShowS
[StringContext] -> ShowS
StringContext -> String
(Int -> StringContext -> ShowS)
-> (StringContext -> String)
-> ([StringContext] -> ShowS)
-> Show StringContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StringContext] -> ShowS
$cshowList :: [StringContext] -> ShowS
show :: StringContext -> String
$cshow :: StringContext -> String
showsPrec :: Int -> StringContext -> ShowS
$cshowsPrec :: Int -> StringContext -> ShowS
Show, (forall x. StringContext -> Rep StringContext x)
-> (forall x. Rep StringContext x -> StringContext)
-> Generic StringContext
forall x. Rep StringContext x -> StringContext
forall x. StringContext -> Rep StringContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StringContext x -> StringContext
$cfrom :: forall x. StringContext -> Rep StringContext x
Generic)

instance Hashable StringContext

data NixString = NixString
  { NixString -> Text
nsContents :: !Text
  , NixString -> HashSet StringContext
nsContext :: !(S.HashSet StringContext)
  } deriving (NixString -> NixString -> Bool
(NixString -> NixString -> Bool)
-> (NixString -> NixString -> Bool) -> Eq NixString
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixString -> NixString -> Bool
$c/= :: NixString -> NixString -> Bool
== :: NixString -> NixString -> Bool
$c== :: NixString -> NixString -> Bool
Eq, Eq NixString
Eq NixString =>
(NixString -> NixString -> Ordering)
-> (NixString -> NixString -> Bool)
-> (NixString -> NixString -> Bool)
-> (NixString -> NixString -> Bool)
-> (NixString -> NixString -> Bool)
-> (NixString -> NixString -> NixString)
-> (NixString -> NixString -> NixString)
-> Ord NixString
NixString -> NixString -> Bool
NixString -> NixString -> Ordering
NixString -> NixString -> NixString
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 :: NixString -> NixString -> NixString
$cmin :: NixString -> NixString -> NixString
max :: NixString -> NixString -> NixString
$cmax :: NixString -> NixString -> NixString
>= :: NixString -> NixString -> Bool
$c>= :: NixString -> NixString -> Bool
> :: NixString -> NixString -> Bool
$c> :: NixString -> NixString -> Bool
<= :: NixString -> NixString -> Bool
$c<= :: NixString -> NixString -> Bool
< :: NixString -> NixString -> Bool
$c< :: NixString -> NixString -> Bool
compare :: NixString -> NixString -> Ordering
$ccompare :: NixString -> NixString -> Ordering
$cp1Ord :: Eq NixString
Ord, Int -> NixString -> ShowS
[NixString] -> ShowS
NixString -> String
(Int -> NixString -> ShowS)
-> (NixString -> String)
-> ([NixString] -> ShowS)
-> Show NixString
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixString] -> ShowS
$cshowList :: [NixString] -> ShowS
show :: NixString -> String
$cshow :: NixString -> String
showsPrec :: Int -> NixString -> ShowS
$cshowsPrec :: Int -> NixString -> ShowS
Show, (forall x. NixString -> Rep NixString x)
-> (forall x. Rep NixString x -> NixString) -> Generic NixString
forall x. Rep NixString x -> NixString
forall x. NixString -> Rep NixString x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NixString x -> NixString
$cfrom :: forall x. NixString -> Rep NixString x
Generic)

instance Hashable NixString

newtype NixLikeContext = NixLikeContext
  { NixLikeContext -> HashMap Text NixLikeContextValue
getNixLikeContext :: M.HashMap Text NixLikeContextValue
  } deriving (NixLikeContext -> NixLikeContext -> Bool
(NixLikeContext -> NixLikeContext -> Bool)
-> (NixLikeContext -> NixLikeContext -> Bool) -> Eq NixLikeContext
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixLikeContext -> NixLikeContext -> Bool
$c/= :: NixLikeContext -> NixLikeContext -> Bool
== :: NixLikeContext -> NixLikeContext -> Bool
$c== :: NixLikeContext -> NixLikeContext -> Bool
Eq, Eq NixLikeContext
Eq NixLikeContext =>
(NixLikeContext -> NixLikeContext -> Ordering)
-> (NixLikeContext -> NixLikeContext -> Bool)
-> (NixLikeContext -> NixLikeContext -> Bool)
-> (NixLikeContext -> NixLikeContext -> Bool)
-> (NixLikeContext -> NixLikeContext -> Bool)
-> (NixLikeContext -> NixLikeContext -> NixLikeContext)
-> (NixLikeContext -> NixLikeContext -> NixLikeContext)
-> Ord NixLikeContext
NixLikeContext -> NixLikeContext -> Bool
NixLikeContext -> NixLikeContext -> Ordering
NixLikeContext -> NixLikeContext -> NixLikeContext
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 :: NixLikeContext -> NixLikeContext -> NixLikeContext
$cmin :: NixLikeContext -> NixLikeContext -> NixLikeContext
max :: NixLikeContext -> NixLikeContext -> NixLikeContext
$cmax :: NixLikeContext -> NixLikeContext -> NixLikeContext
>= :: NixLikeContext -> NixLikeContext -> Bool
$c>= :: NixLikeContext -> NixLikeContext -> Bool
> :: NixLikeContext -> NixLikeContext -> Bool
$c> :: NixLikeContext -> NixLikeContext -> Bool
<= :: NixLikeContext -> NixLikeContext -> Bool
$c<= :: NixLikeContext -> NixLikeContext -> Bool
< :: NixLikeContext -> NixLikeContext -> Bool
$c< :: NixLikeContext -> NixLikeContext -> Bool
compare :: NixLikeContext -> NixLikeContext -> Ordering
$ccompare :: NixLikeContext -> NixLikeContext -> Ordering
$cp1Ord :: Eq NixLikeContext
Ord, Int -> NixLikeContext -> ShowS
[NixLikeContext] -> ShowS
NixLikeContext -> String
(Int -> NixLikeContext -> ShowS)
-> (NixLikeContext -> String)
-> ([NixLikeContext] -> ShowS)
-> Show NixLikeContext
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixLikeContext] -> ShowS
$cshowList :: [NixLikeContext] -> ShowS
show :: NixLikeContext -> String
$cshow :: NixLikeContext -> String
showsPrec :: Int -> NixLikeContext -> ShowS
$cshowsPrec :: Int -> NixLikeContext -> ShowS
Show, (forall x. NixLikeContext -> Rep NixLikeContext x)
-> (forall x. Rep NixLikeContext x -> NixLikeContext)
-> Generic NixLikeContext
forall x. Rep NixLikeContext x -> NixLikeContext
forall x. NixLikeContext -> Rep NixLikeContext x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NixLikeContext x -> NixLikeContext
$cfrom :: forall x. NixLikeContext -> Rep NixLikeContext x
Generic)

data NixLikeContextValue = NixLikeContextValue
  { NixLikeContextValue -> Bool
nlcvPath :: !Bool
  , NixLikeContextValue -> Bool
nlcvAllOutputs :: !Bool
  , NixLikeContextValue -> [Text]
nlcvOutputs :: ![Text]
  } deriving (Int -> NixLikeContextValue -> ShowS
[NixLikeContextValue] -> ShowS
NixLikeContextValue -> String
(Int -> NixLikeContextValue -> ShowS)
-> (NixLikeContextValue -> String)
-> ([NixLikeContextValue] -> ShowS)
-> Show NixLikeContextValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixLikeContextValue] -> ShowS
$cshowList :: [NixLikeContextValue] -> ShowS
show :: NixLikeContextValue -> String
$cshow :: NixLikeContextValue -> String
showsPrec :: Int -> NixLikeContextValue -> ShowS
$cshowsPrec :: Int -> NixLikeContextValue -> ShowS
Show, NixLikeContextValue -> NixLikeContextValue -> Bool
(NixLikeContextValue -> NixLikeContextValue -> Bool)
-> (NixLikeContextValue -> NixLikeContextValue -> Bool)
-> Eq NixLikeContextValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixLikeContextValue -> NixLikeContextValue -> Bool
$c/= :: NixLikeContextValue -> NixLikeContextValue -> Bool
== :: NixLikeContextValue -> NixLikeContextValue -> Bool
$c== :: NixLikeContextValue -> NixLikeContextValue -> Bool
Eq, Eq NixLikeContextValue
Eq NixLikeContextValue =>
(NixLikeContextValue -> NixLikeContextValue -> Ordering)
-> (NixLikeContextValue -> NixLikeContextValue -> Bool)
-> (NixLikeContextValue -> NixLikeContextValue -> Bool)
-> (NixLikeContextValue -> NixLikeContextValue -> Bool)
-> (NixLikeContextValue -> NixLikeContextValue -> Bool)
-> (NixLikeContextValue
    -> NixLikeContextValue -> NixLikeContextValue)
-> (NixLikeContextValue
    -> NixLikeContextValue -> NixLikeContextValue)
-> Ord NixLikeContextValue
NixLikeContextValue -> NixLikeContextValue -> Bool
NixLikeContextValue -> NixLikeContextValue -> Ordering
NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
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 :: NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
$cmin :: NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
max :: NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
$cmax :: NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
>= :: NixLikeContextValue -> NixLikeContextValue -> Bool
$c>= :: NixLikeContextValue -> NixLikeContextValue -> Bool
> :: NixLikeContextValue -> NixLikeContextValue -> Bool
$c> :: NixLikeContextValue -> NixLikeContextValue -> Bool
<= :: NixLikeContextValue -> NixLikeContextValue -> Bool
$c<= :: NixLikeContextValue -> NixLikeContextValue -> Bool
< :: NixLikeContextValue -> NixLikeContextValue -> Bool
$c< :: NixLikeContextValue -> NixLikeContextValue -> Bool
compare :: NixLikeContextValue -> NixLikeContextValue -> Ordering
$ccompare :: NixLikeContextValue -> NixLikeContextValue -> Ordering
$cp1Ord :: Eq NixLikeContextValue
Ord, (forall x. NixLikeContextValue -> Rep NixLikeContextValue x)
-> (forall x. Rep NixLikeContextValue x -> NixLikeContextValue)
-> Generic NixLikeContextValue
forall x. Rep NixLikeContextValue x -> NixLikeContextValue
forall x. NixLikeContextValue -> Rep NixLikeContextValue x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NixLikeContextValue x -> NixLikeContextValue
$cfrom :: forall x. NixLikeContextValue -> Rep NixLikeContextValue x
Generic)

instance Semigroup NixLikeContextValue where
  a :: NixLikeContextValue
a <> :: NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
<> b :: NixLikeContextValue
b = $WNixLikeContextValue :: Bool -> Bool -> [Text] -> NixLikeContextValue
NixLikeContextValue
    { nlcvPath :: Bool
nlcvPath       = NixLikeContextValue -> Bool
nlcvPath NixLikeContextValue
a Bool -> Bool -> Bool
|| NixLikeContextValue -> Bool
nlcvPath NixLikeContextValue
b
    , nlcvAllOutputs :: Bool
nlcvAllOutputs = NixLikeContextValue -> Bool
nlcvAllOutputs NixLikeContextValue
a Bool -> Bool -> Bool
|| NixLikeContextValue -> Bool
nlcvAllOutputs NixLikeContextValue
b
    , nlcvOutputs :: [Text]
nlcvOutputs    = NixLikeContextValue -> [Text]
nlcvOutputs NixLikeContextValue
a [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> NixLikeContextValue -> [Text]
nlcvOutputs NixLikeContextValue
b
    }

instance Monoid NixLikeContextValue where
  mempty :: NixLikeContextValue
mempty = Bool -> Bool -> [Text] -> NixLikeContextValue
NixLikeContextValue Bool
False Bool
False []

toStringContexts :: (Text, NixLikeContextValue) -> [StringContext]
toStringContexts :: (Text, NixLikeContextValue) -> [StringContext]
toStringContexts (path :: Text
path, nlcv :: NixLikeContextValue
nlcv) = case NixLikeContextValue
nlcv of
  NixLikeContextValue True _ _ -> Text -> ContextFlavor -> StringContext
StringContext Text
path ContextFlavor
DirectPath
    StringContext -> [StringContext] -> [StringContext]
forall a. a -> [a] -> [a]
: (Text, NixLikeContextValue) -> [StringContext]
toStringContexts (Text
path, NixLikeContextValue
nlcv { nlcvPath :: Bool
nlcvPath = Bool
False })
  NixLikeContextValue _ True _ -> Text -> ContextFlavor -> StringContext
StringContext Text
path ContextFlavor
AllOutputs
    StringContext -> [StringContext] -> [StringContext]
forall a. a -> [a] -> [a]
: (Text, NixLikeContextValue) -> [StringContext]
toStringContexts (Text
path, NixLikeContextValue
nlcv { nlcvAllOutputs :: Bool
nlcvAllOutputs = Bool
False })
  NixLikeContextValue _ _ ls :: [Text]
ls | Bool -> Bool
not ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ls) ->
    (Text -> StringContext) -> [Text] -> [StringContext]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> ContextFlavor -> StringContext
StringContext Text
path (ContextFlavor -> StringContext)
-> (Text -> ContextFlavor) -> Text -> StringContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ContextFlavor
DerivationOutput) [Text]
ls
  _ -> []

toNixLikeContextValue :: StringContext -> (Text, NixLikeContextValue)
toNixLikeContextValue :: StringContext -> (Text, NixLikeContextValue)
toNixLikeContextValue sc :: StringContext
sc = (,) (StringContext -> Text
scPath StringContext
sc) (NixLikeContextValue -> (Text, NixLikeContextValue))
-> NixLikeContextValue -> (Text, NixLikeContextValue)
forall a b. (a -> b) -> a -> b
$ case StringContext -> ContextFlavor
scFlavor StringContext
sc of
  DirectPath         -> Bool -> Bool -> [Text] -> NixLikeContextValue
NixLikeContextValue Bool
True Bool
False []
  AllOutputs         -> Bool -> Bool -> [Text] -> NixLikeContextValue
NixLikeContextValue Bool
False Bool
True []
  DerivationOutput t :: Text
t -> Bool -> Bool -> [Text] -> NixLikeContextValue
NixLikeContextValue Bool
False Bool
False [Text
t]

toNixLikeContext :: S.HashSet StringContext -> NixLikeContext
toNixLikeContext :: HashSet StringContext -> NixLikeContext
toNixLikeContext stringContext :: HashSet StringContext
stringContext = HashMap Text NixLikeContextValue -> NixLikeContext
NixLikeContext
  (HashMap Text NixLikeContextValue -> NixLikeContext)
-> HashMap Text NixLikeContextValue -> NixLikeContext
forall a b. (a -> b) -> a -> b
$ (StringContext
 -> HashMap Text NixLikeContextValue
 -> HashMap Text NixLikeContextValue)
-> HashMap Text NixLikeContextValue
-> HashSet StringContext
-> HashMap Text NixLikeContextValue
forall b a. (b -> a -> a) -> a -> HashSet b -> a
S.foldr StringContext
-> HashMap Text NixLikeContextValue
-> HashMap Text NixLikeContextValue
go HashMap Text NixLikeContextValue
forall a. Monoid a => a
mempty HashSet StringContext
stringContext
 where
  go :: StringContext
-> HashMap Text NixLikeContextValue
-> HashMap Text NixLikeContextValue
go sc :: StringContext
sc hm :: HashMap Text NixLikeContextValue
hm =
    let (t :: Text
t, nlcv :: NixLikeContextValue
nlcv) = StringContext -> (Text, NixLikeContextValue)
toNixLikeContextValue StringContext
sc in (NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue)
-> Text
-> NixLikeContextValue
-> HashMap Text NixLikeContextValue
-> HashMap Text NixLikeContextValue
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
M.insertWith NixLikeContextValue -> NixLikeContextValue -> NixLikeContextValue
forall a. Semigroup a => a -> a -> a
(<>) Text
t NixLikeContextValue
nlcv HashMap Text NixLikeContextValue
hm

fromNixLikeContext :: NixLikeContext -> S.HashSet StringContext
fromNixLikeContext :: NixLikeContext -> HashSet StringContext
fromNixLikeContext =
  [StringContext] -> HashSet StringContext
forall a. (Eq a, Hashable a) => [a] -> HashSet a
S.fromList ([StringContext] -> HashSet StringContext)
-> (NixLikeContext -> [StringContext])
-> NixLikeContext
-> HashSet StringContext
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[StringContext]] -> [StringContext]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[StringContext]] -> [StringContext])
-> (NixLikeContext -> [[StringContext]])
-> NixLikeContext
-> [StringContext]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, NixLikeContextValue) -> [StringContext])
-> [(Text, NixLikeContextValue)] -> [[StringContext]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, NixLikeContextValue) -> [StringContext]
toStringContexts ([(Text, NixLikeContextValue)] -> [[StringContext]])
-> (NixLikeContext -> [(Text, NixLikeContextValue)])
-> NixLikeContext
-> [[StringContext]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap Text NixLikeContextValue -> [(Text, NixLikeContextValue)]
forall k v. HashMap k v -> [(k, v)]
M.toList (HashMap Text NixLikeContextValue -> [(Text, NixLikeContextValue)])
-> (NixLikeContext -> HashMap Text NixLikeContextValue)
-> NixLikeContext
-> [(Text, NixLikeContextValue)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NixLikeContext -> HashMap Text NixLikeContextValue
getNixLikeContext

principledGetContext :: NixString -> S.HashSet StringContext
principledGetContext :: NixString -> HashSet StringContext
principledGetContext = NixString -> HashSet StringContext
nsContext

-- | Combine two NixStrings using mappend
principledMempty :: NixString
principledMempty :: NixString
principledMempty = Text -> HashSet StringContext -> NixString
NixString "" HashSet StringContext
forall a. Monoid a => a
mempty

-- | Combine two NixStrings using mappend
principledStringMappend :: NixString -> NixString -> NixString
principledStringMappend :: NixString -> NixString -> NixString
principledStringMappend (NixString s1 :: Text
s1 t1 :: HashSet StringContext
t1) (NixString s2 :: Text
s2 t2 :: HashSet StringContext
t2) =
  Text -> HashSet StringContext -> NixString
NixString (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2) (HashSet StringContext
t1 HashSet StringContext
-> HashSet StringContext -> HashSet StringContext
forall a. Semigroup a => a -> a -> a
<> HashSet StringContext
t2)

-- | Combine two NixStrings using mappend
hackyStringMappend :: NixString -> NixString -> NixString
hackyStringMappend :: NixString -> NixString -> NixString
hackyStringMappend (NixString s1 :: Text
s1 t1 :: HashSet StringContext
t1) (NixString s2 :: Text
s2 t2 :: HashSet StringContext
t2) =
  Text -> HashSet StringContext -> NixString
NixString (Text
s1 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s2) (HashSet StringContext
t1 HashSet StringContext
-> HashSet StringContext -> HashSet StringContext
forall a. Semigroup a => a -> a -> a
<> HashSet StringContext
t2)

-- | Combine NixStrings with a separator
principledIntercalateNixString :: NixString -> [NixString] -> NixString
principledIntercalateNixString :: NixString -> [NixString] -> NixString
principledIntercalateNixString _   []   = NixString
principledMempty
principledIntercalateNixString _   [ns :: NixString
ns] = NixString
ns
principledIntercalateNixString sep :: NixString
sep nss :: [NixString]
nss  = Text -> HashSet StringContext -> NixString
NixString Text
contents HashSet StringContext
ctx
 where
  contents :: Text
contents = Text -> [Text] -> Text
Text.intercalate (NixString -> Text
nsContents NixString
sep) ((NixString -> Text) -> [NixString] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map NixString -> Text
nsContents [NixString]
nss)
  ctx :: HashSet StringContext
ctx      = [HashSet StringContext] -> HashSet StringContext
forall a. (Eq a, Hashable a) => [HashSet a] -> HashSet a
S.unions (NixString -> HashSet StringContext
nsContext NixString
sep HashSet StringContext
-> [HashSet StringContext] -> [HashSet StringContext]
forall a. a -> [a] -> [a]
: (NixString -> HashSet StringContext)
-> [NixString] -> [HashSet StringContext]
forall a b. (a -> b) -> [a] -> [b]
map NixString -> HashSet StringContext
nsContext [NixString]
nss)

-- | Combine NixStrings using mconcat
hackyStringMConcat :: [NixString] -> NixString
hackyStringMConcat :: [NixString] -> NixString
hackyStringMConcat = (NixString -> NixString -> NixString)
-> NixString -> [NixString] -> NixString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NixString -> NixString -> NixString
hackyStringMappend (Text -> HashSet StringContext -> NixString
NixString Text
forall a. Monoid a => a
mempty HashSet StringContext
forall a. Monoid a => a
mempty)

-- | Empty string with empty context.
principledStringMempty :: NixString
principledStringMempty :: NixString
principledStringMempty = Text -> HashSet StringContext -> NixString
NixString Text
forall a. Monoid a => a
mempty HashSet StringContext
forall a. Monoid a => a
mempty

-- | Combine NixStrings using mconcat
principledStringMConcat :: [NixString] -> NixString
principledStringMConcat :: [NixString] -> NixString
principledStringMConcat =
  (NixString -> NixString -> NixString)
-> NixString -> [NixString] -> NixString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NixString -> NixString -> NixString
principledStringMappend (Text -> HashSet StringContext -> NixString
NixString Text
forall a. Monoid a => a
mempty HashSet StringContext
forall a. Monoid a => a
mempty)

--instance Semigroup NixString where
  --NixString s1 t1 <> NixString s2 t2 = NixString (s1 <> s2) (t1 <> t2)

--instance Monoid NixString where
--  mempty = NixString mempty mempty
--  mappend = (<>)

-- | Extract the string contents from a NixString that has no context
hackyGetStringNoContext :: NixString -> Maybe Text
hackyGetStringNoContext :: NixString -> Maybe Text
hackyGetStringNoContext (NixString s :: Text
s c :: HashSet StringContext
c) | HashSet StringContext -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet StringContext
c    = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
                                        | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

-- | Extract the string contents from a NixString that has no context
principledGetStringNoContext :: NixString -> Maybe Text
principledGetStringNoContext :: NixString -> Maybe Text
principledGetStringNoContext (NixString s :: Text
s c :: HashSet StringContext
c) | HashSet StringContext -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet StringContext
c    = Text -> Maybe Text
forall a. a -> Maybe a
Just Text
s
                                             | Bool
otherwise = Maybe Text
forall a. Maybe a
Nothing

-- | Extract the string contents from a NixString even if the NixString has an associated context
principledStringIgnoreContext :: NixString -> Text
principledStringIgnoreContext :: NixString -> Text
principledStringIgnoreContext (NixString s :: Text
s _) = Text
s

-- | Extract the string contents from a NixString even if the NixString has an associated context
hackyStringIgnoreContext :: NixString -> Text
hackyStringIgnoreContext :: NixString -> Text
hackyStringIgnoreContext (NixString s :: Text
s _) = Text
s

-- | Returns True if the NixString has an associated context
stringHasContext :: NixString -> Bool
stringHasContext :: NixString -> Bool
stringHasContext (NixString _ c :: HashSet StringContext
c) = Bool -> Bool
not (HashSet StringContext -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null HashSet StringContext
c)

-- | Constructs a NixString without a context
hackyMakeNixStringWithoutContext :: Text -> NixString
hackyMakeNixStringWithoutContext :: Text -> NixString
hackyMakeNixStringWithoutContext = (Text -> HashSet StringContext -> NixString)
-> HashSet StringContext -> Text -> NixString
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashSet StringContext -> NixString
NixString HashSet StringContext
forall a. Monoid a => a
mempty

-- | Constructs a NixString without a context
principledMakeNixStringWithoutContext :: Text -> NixString
principledMakeNixStringWithoutContext :: Text -> NixString
principledMakeNixStringWithoutContext = (Text -> HashSet StringContext -> NixString)
-> HashSet StringContext -> Text -> NixString
forall a b c. (a -> b -> c) -> b -> a -> c
flip Text -> HashSet StringContext -> NixString
NixString HashSet StringContext
forall a. Monoid a => a
mempty

-- | Modify the string part of the NixString, leaving the context unchanged
principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
principledModifyNixContents f :: Text -> Text
f (NixString s :: Text
s c :: HashSet StringContext
c) = Text -> HashSet StringContext -> NixString
NixString (Text -> Text
f Text
s) HashSet StringContext
c

-- | Create a NixString using a singleton context
principledMakeNixStringWithSingletonContext
  :: Text -> StringContext -> NixString
principledMakeNixStringWithSingletonContext :: Text -> StringContext -> NixString
principledMakeNixStringWithSingletonContext s :: Text
s c :: StringContext
c = Text -> HashSet StringContext -> NixString
NixString Text
s (StringContext -> HashSet StringContext
forall a. Hashable a => a -> HashSet a
S.singleton StringContext
c)

-- | Create a NixString from a Text and context
principledMakeNixString :: Text -> S.HashSet StringContext -> NixString
principledMakeNixString :: Text -> HashSet StringContext -> NixString
principledMakeNixString s :: Text
s c :: HashSet StringContext
c = Text -> HashSet StringContext -> NixString
NixString Text
s HashSet StringContext
c

-- | A monad for accumulating string context while producing a result string.
newtype WithStringContextT m a = WithStringContextT (WriterT (S.HashSet StringContext) m a)
  deriving (a -> WithStringContextT m b -> WithStringContextT m a
(a -> b) -> WithStringContextT m a -> WithStringContextT m b
(forall a b.
 (a -> b) -> WithStringContextT m a -> WithStringContextT m b)
-> (forall a b.
    a -> WithStringContextT m b -> WithStringContextT m a)
-> Functor (WithStringContextT m)
forall a b. a -> WithStringContextT m b -> WithStringContextT m a
forall a b.
(a -> b) -> WithStringContextT m a -> WithStringContextT m b
forall (m :: * -> *) a b.
Functor m =>
a -> WithStringContextT m b -> WithStringContextT m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithStringContextT m a -> WithStringContextT m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> WithStringContextT m b -> WithStringContextT m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> WithStringContextT m b -> WithStringContextT m a
fmap :: (a -> b) -> WithStringContextT m a -> WithStringContextT m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> WithStringContextT m a -> WithStringContextT m b
Functor, Functor (WithStringContextT m)
a -> WithStringContextT m a
Functor (WithStringContextT m) =>
(forall a. a -> WithStringContextT m a)
-> (forall a b.
    WithStringContextT m (a -> b)
    -> WithStringContextT m a -> WithStringContextT m b)
-> (forall a b c.
    (a -> b -> c)
    -> WithStringContextT m a
    -> WithStringContextT m b
    -> WithStringContextT m c)
-> (forall a b.
    WithStringContextT m a
    -> WithStringContextT m b -> WithStringContextT m b)
-> (forall a b.
    WithStringContextT m a
    -> WithStringContextT m b -> WithStringContextT m a)
-> Applicative (WithStringContextT m)
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m a
WithStringContextT m (a -> b)
-> WithStringContextT m a -> WithStringContextT m b
(a -> b -> c)
-> WithStringContextT m a
-> WithStringContextT m b
-> WithStringContextT m c
forall a. a -> WithStringContextT m a
forall a b.
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m a
forall a b.
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
forall a b.
WithStringContextT m (a -> b)
-> WithStringContextT m a -> WithStringContextT m b
forall a b c.
(a -> b -> c)
-> WithStringContextT m a
-> WithStringContextT m b
-> WithStringContextT m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall (m :: * -> *).
Applicative m =>
Functor (WithStringContextT m)
forall (m :: * -> *) a.
Applicative m =>
a -> WithStringContextT m a
forall (m :: * -> *) a b.
Applicative m =>
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m a
forall (m :: * -> *) a b.
Applicative m =>
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
forall (m :: * -> *) a b.
Applicative m =>
WithStringContextT m (a -> b)
-> WithStringContextT m a -> WithStringContextT m b
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithStringContextT m a
-> WithStringContextT m b
-> WithStringContextT m c
<* :: WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m a
$c<* :: forall (m :: * -> *) a b.
Applicative m =>
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m a
*> :: WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
$c*> :: forall (m :: * -> *) a b.
Applicative m =>
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
liftA2 :: (a -> b -> c)
-> WithStringContextT m a
-> WithStringContextT m b
-> WithStringContextT m c
$cliftA2 :: forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> WithStringContextT m a
-> WithStringContextT m b
-> WithStringContextT m c
<*> :: WithStringContextT m (a -> b)
-> WithStringContextT m a -> WithStringContextT m b
$c<*> :: forall (m :: * -> *) a b.
Applicative m =>
WithStringContextT m (a -> b)
-> WithStringContextT m a -> WithStringContextT m b
pure :: a -> WithStringContextT m a
$cpure :: forall (m :: * -> *) a.
Applicative m =>
a -> WithStringContextT m a
$cp1Applicative :: forall (m :: * -> *).
Applicative m =>
Functor (WithStringContextT m)
Applicative, Applicative (WithStringContextT m)
a -> WithStringContextT m a
Applicative (WithStringContextT m) =>
(forall a b.
 WithStringContextT m a
 -> (a -> WithStringContextT m b) -> WithStringContextT m b)
-> (forall a b.
    WithStringContextT m a
    -> WithStringContextT m b -> WithStringContextT m b)
-> (forall a. a -> WithStringContextT m a)
-> Monad (WithStringContextT m)
WithStringContextT m a
-> (a -> WithStringContextT m b) -> WithStringContextT m b
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
forall a. a -> WithStringContextT m a
forall a b.
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
forall a b.
WithStringContextT m a
-> (a -> WithStringContextT m b) -> WithStringContextT m b
forall (m :: * -> *). Monad m => Applicative (WithStringContextT m)
forall (m :: * -> *) a. Monad m => a -> WithStringContextT m a
forall (m :: * -> *) a b.
Monad m =>
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
forall (m :: * -> *) a b.
Monad m =>
WithStringContextT m a
-> (a -> WithStringContextT m b) -> WithStringContextT m b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> WithStringContextT m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> WithStringContextT m a
>> :: WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
WithStringContextT m a
-> WithStringContextT m b -> WithStringContextT m b
>>= :: WithStringContextT m a
-> (a -> WithStringContextT m b) -> WithStringContextT m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
WithStringContextT m a
-> (a -> WithStringContextT m b) -> WithStringContextT m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (WithStringContextT m)
Monad, m a -> WithStringContextT m a
(forall (m :: * -> *) a. Monad m => m a -> WithStringContextT m a)
-> MonadTrans WithStringContextT
forall (m :: * -> *) a. Monad m => m a -> WithStringContextT m a
forall (t :: (* -> *) -> * -> *).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> WithStringContextT m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> WithStringContextT m a
MonadTrans, MonadWriter (S.HashSet StringContext))

type WithStringContext = WithStringContextT Identity

-- | Add 'StringContext's into the resulting set.
addStringContext
  :: Monad m => S.HashSet StringContext -> WithStringContextT m ()
addStringContext :: HashSet StringContext -> WithStringContextT m ()
addStringContext = WriterT (HashSet StringContext) m () -> WithStringContextT m ()
forall (m :: * -> *) a.
WriterT (HashSet StringContext) m a -> WithStringContextT m a
WithStringContextT (WriterT (HashSet StringContext) m () -> WithStringContextT m ())
-> (HashSet StringContext -> WriterT (HashSet StringContext) m ())
-> HashSet StringContext
-> WithStringContextT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet StringContext -> WriterT (HashSet StringContext) m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell

-- | Add a 'StringContext' into the resulting set.
addSingletonStringContext :: Monad m => StringContext -> WithStringContextT m ()
addSingletonStringContext :: StringContext -> WithStringContextT m ()
addSingletonStringContext = WriterT (HashSet StringContext) m () -> WithStringContextT m ()
forall (m :: * -> *) a.
WriterT (HashSet StringContext) m a -> WithStringContextT m a
WithStringContextT (WriterT (HashSet StringContext) m () -> WithStringContextT m ())
-> (StringContext -> WriterT (HashSet StringContext) m ())
-> StringContext
-> WithStringContextT m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashSet StringContext -> WriterT (HashSet StringContext) m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (HashSet StringContext -> WriterT (HashSet StringContext) m ())
-> (StringContext -> HashSet StringContext)
-> StringContext
-> WriterT (HashSet StringContext) m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StringContext -> HashSet StringContext
forall a. Hashable a => a -> HashSet a
S.singleton

-- | Get the contents of a 'NixString' and write its context into the resulting set.
extractNixString :: Monad m => NixString -> WithStringContextT m Text
extractNixString :: NixString -> WithStringContextT m Text
extractNixString (NixString s :: Text
s c :: HashSet StringContext
c) = WriterT (HashSet StringContext) m Text -> WithStringContextT m Text
forall (m :: * -> *) a.
WriterT (HashSet StringContext) m a -> WithStringContextT m a
WithStringContextT (WriterT (HashSet StringContext) m Text
 -> WithStringContextT m Text)
-> WriterT (HashSet StringContext) m Text
-> WithStringContextT m Text
forall a b. (a -> b) -> a -> b
$ HashSet StringContext -> WriterT (HashSet StringContext) m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell HashSet StringContext
c WriterT (HashSet StringContext) m ()
-> WriterT (HashSet StringContext) m Text
-> WriterT (HashSet StringContext) m Text
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> WriterT (HashSet StringContext) m Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
s

-- | Run an action producing a string with a context and put those into a 'NixString'.
runWithStringContextT :: Monad m => WithStringContextT m Text -> m NixString
runWithStringContextT :: WithStringContextT m Text -> m NixString
runWithStringContextT (WithStringContextT m :: WriterT (HashSet StringContext) m Text
m) =
  (Text -> HashSet StringContext -> NixString)
-> (Text, HashSet StringContext) -> NixString
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> HashSet StringContext -> NixString
NixString ((Text, HashSet StringContext) -> NixString)
-> m (Text, HashSet StringContext) -> m NixString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WriterT (HashSet StringContext) m Text
-> m (Text, HashSet StringContext)
forall w (m :: * -> *) a. WriterT w m a -> m (a, w)
runWriterT WriterT (HashSet StringContext) m Text
m

-- | Run an action producing a string with a context and put those into a 'NixString'.
runWithStringContext :: WithStringContextT Identity Text -> NixString
runWithStringContext :: WithStringContextT Identity Text -> NixString
runWithStringContext = Identity NixString -> NixString
forall a. Identity a -> a
runIdentity (Identity NixString -> NixString)
-> (WithStringContextT Identity Text -> Identity NixString)
-> WithStringContextT Identity Text
-> NixString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WithStringContextT Identity Text -> Identity NixString
forall (m :: * -> *).
Monad m =>
WithStringContextT m Text -> m NixString
runWithStringContextT