0cb3946ee7
M main/Main.hs M main/Repl.hs M src/Nix/Builtins.hs M src/Nix/Convert.hs M src/Nix/Effects.hs M src/Nix/Effects/Basic.hs M src/Nix/Eval.hs M src/Nix/Exec.hs M src/Nix/Expr/Types.hs M src/Nix/Json.hs M src/Nix/Lint.hs M src/Nix/Normal.hs M src/Nix/Options/Parser.hs M src/Nix/Parser.hs M src/Nix/Scope.hs M src/Nix/String.hs M src/Nix/TH.hs M src/Nix/Thunk/Basic.hs M src/Nix/Utils.hs M src/Nix/Value.hs M src/Nix/Value/Equal.hs M src/Nix/XML.hs M tests/EvalTests.hs M tests/Main.hs M tests/NixLanguageTests.hs M tests/ParserTests.hs M tests/TestCommon.hs
237 lines
8.8 KiB
Haskell
237 lines
8.8 KiB
Haskell
{-# 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 (Show, Eq, Ord, Generic)
|
|
|
|
instance Hashable ContextFlavor
|
|
|
|
-- | A 'StringContext' ...
|
|
data StringContext =
|
|
StringContext { scPath :: !Text
|
|
, scFlavor :: !ContextFlavor
|
|
} deriving (Eq, Ord, Show, Generic)
|
|
|
|
instance Hashable StringContext
|
|
|
|
data NixString = NixString
|
|
{ nsContents :: !Text
|
|
, nsContext :: !(S.HashSet StringContext)
|
|
} deriving (Eq, Ord, Show, Generic)
|
|
|
|
instance Hashable NixString
|
|
|
|
newtype NixLikeContext = NixLikeContext
|
|
{ getNixLikeContext :: M.HashMap Text NixLikeContextValue
|
|
} deriving (Eq, Ord, Show, Generic)
|
|
|
|
data NixLikeContextValue = NixLikeContextValue
|
|
{ nlcvPath :: !Bool
|
|
, nlcvAllOutputs :: !Bool
|
|
, nlcvOutputs :: ![Text]
|
|
} deriving (Show, Eq, Ord, Generic)
|
|
|
|
instance Semigroup NixLikeContextValue where
|
|
a <> b = NixLikeContextValue
|
|
{ nlcvPath = nlcvPath a || nlcvPath b
|
|
, nlcvAllOutputs = nlcvAllOutputs a || nlcvAllOutputs b
|
|
, nlcvOutputs = nlcvOutputs a <> nlcvOutputs b
|
|
}
|
|
|
|
instance Monoid NixLikeContextValue where
|
|
mempty = NixLikeContextValue False False []
|
|
|
|
toStringContexts :: (Text, NixLikeContextValue) -> [StringContext]
|
|
toStringContexts (path, nlcv) = case nlcv of
|
|
NixLikeContextValue True _ _ -> StringContext path DirectPath
|
|
: toStringContexts (path, nlcv { nlcvPath = False })
|
|
NixLikeContextValue _ True _ -> StringContext path AllOutputs
|
|
: toStringContexts (path, nlcv { nlcvAllOutputs = False })
|
|
NixLikeContextValue _ _ ls | not (null ls) ->
|
|
map (StringContext path . DerivationOutput) ls
|
|
_ -> []
|
|
|
|
toNixLikeContextValue :: StringContext -> (Text, NixLikeContextValue)
|
|
toNixLikeContextValue sc = (,) (scPath sc) $ case scFlavor sc of
|
|
DirectPath -> NixLikeContextValue True False []
|
|
AllOutputs -> NixLikeContextValue False True []
|
|
DerivationOutput t -> NixLikeContextValue False False [t]
|
|
|
|
toNixLikeContext :: S.HashSet StringContext -> NixLikeContext
|
|
toNixLikeContext stringContext = NixLikeContext
|
|
$ S.foldr go mempty stringContext
|
|
where
|
|
go sc hm =
|
|
let (t, nlcv) = toNixLikeContextValue sc in M.insertWith (<>) t nlcv hm
|
|
|
|
fromNixLikeContext :: NixLikeContext -> S.HashSet StringContext
|
|
fromNixLikeContext =
|
|
S.fromList . join . map toStringContexts . M.toList . getNixLikeContext
|
|
|
|
principledGetContext :: NixString -> S.HashSet StringContext
|
|
principledGetContext = nsContext
|
|
|
|
-- | Combine two NixStrings using mappend
|
|
principledMempty :: NixString
|
|
principledMempty = NixString "" mempty
|
|
|
|
-- | Combine two NixStrings using mappend
|
|
principledStringMappend :: NixString -> NixString -> NixString
|
|
principledStringMappend (NixString s1 t1) (NixString s2 t2) =
|
|
NixString (s1 <> s2) (t1 <> t2)
|
|
|
|
-- | Combine two NixStrings using mappend
|
|
hackyStringMappend :: NixString -> NixString -> NixString
|
|
hackyStringMappend (NixString s1 t1) (NixString s2 t2) =
|
|
NixString (s1 <> s2) (t1 <> t2)
|
|
|
|
-- | Combine NixStrings with a separator
|
|
principledIntercalateNixString :: NixString -> [NixString] -> NixString
|
|
principledIntercalateNixString _ [] = principledMempty
|
|
principledIntercalateNixString _ [ns] = ns
|
|
principledIntercalateNixString sep nss = NixString contents ctx
|
|
where
|
|
contents = Text.intercalate (nsContents sep) (map nsContents nss)
|
|
ctx = S.unions (nsContext sep : map nsContext nss)
|
|
|
|
-- | Combine NixStrings using mconcat
|
|
hackyStringMConcat :: [NixString] -> NixString
|
|
hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)
|
|
|
|
-- | Empty string with empty context.
|
|
principledStringMempty :: NixString
|
|
principledStringMempty = NixString mempty mempty
|
|
|
|
-- | Combine NixStrings using mconcat
|
|
principledStringMConcat :: [NixString] -> NixString
|
|
principledStringMConcat =
|
|
foldr principledStringMappend (NixString mempty 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 s c) | null c = Just s
|
|
| otherwise = Nothing
|
|
|
|
-- | Extract the string contents from a NixString that has no context
|
|
principledGetStringNoContext :: NixString -> Maybe Text
|
|
principledGetStringNoContext (NixString s c) | null c = Just s
|
|
| otherwise = Nothing
|
|
|
|
-- | Extract the string contents from a NixString even if the NixString has an associated context
|
|
principledStringIgnoreContext :: NixString -> Text
|
|
principledStringIgnoreContext (NixString s _) = s
|
|
|
|
-- | Extract the string contents from a NixString even if the NixString has an associated context
|
|
hackyStringIgnoreContext :: NixString -> Text
|
|
hackyStringIgnoreContext (NixString s _) = s
|
|
|
|
-- | Returns True if the NixString has an associated context
|
|
stringHasContext :: NixString -> Bool
|
|
stringHasContext (NixString _ c) = not (null c)
|
|
|
|
-- | Constructs a NixString without a context
|
|
hackyMakeNixStringWithoutContext :: Text -> NixString
|
|
hackyMakeNixStringWithoutContext = flip NixString mempty
|
|
|
|
-- | Constructs a NixString without a context
|
|
principledMakeNixStringWithoutContext :: Text -> NixString
|
|
principledMakeNixStringWithoutContext = flip NixString mempty
|
|
|
|
-- | Modify the string part of the NixString, leaving the context unchanged
|
|
principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
|
|
principledModifyNixContents f (NixString s c) = NixString (f s) c
|
|
|
|
-- | Create a NixString using a singleton context
|
|
principledMakeNixStringWithSingletonContext
|
|
:: Text -> StringContext -> NixString
|
|
principledMakeNixStringWithSingletonContext s c = NixString s (S.singleton c)
|
|
|
|
-- | Create a NixString from a Text and context
|
|
principledMakeNixString :: Text -> S.HashSet StringContext -> NixString
|
|
principledMakeNixString s c = NixString s c
|
|
|
|
-- | A monad for accumulating string context while producing a result string.
|
|
newtype WithStringContextT m a = WithStringContextT (WriterT (S.HashSet StringContext) m a)
|
|
deriving (Functor, Applicative, Monad, 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 = WithStringContextT . tell
|
|
|
|
-- | Add a 'StringContext' into the resulting set.
|
|
addSingletonStringContext :: Monad m => StringContext -> WithStringContextT m ()
|
|
addSingletonStringContext = WithStringContextT . tell . 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 s c) = WithStringContextT $ tell c >> pure 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) =
|
|
uncurry NixString <$> runWriterT m
|
|
|
|
-- | Run an action producing a string with a context and put those into a 'NixString'.
|
|
runWithStringContext :: WithStringContextT Identity Text -> NixString
|
|
runWithStringContext = runIdentity . runWithStringContextT
|