2018-05-13 20:13:30 +02:00
|
|
|
{-# LANGUAGE DeriveGeneric #-}
|
2018-12-07 00:02:59 +01:00
|
|
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
2018-11-17 22:08:02 +01:00
|
|
|
{-# LANGUAGE OverloadedStrings #-}
|
2018-09-16 22:30:24 +02:00
|
|
|
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
|
2019-03-17 22:47:38 +01:00
|
|
|
module Nix.String
|
|
|
|
( NixString
|
2018-11-21 07:21:53 +01:00
|
|
|
, principledGetContext
|
|
|
|
, principledMakeNixString
|
2018-11-17 22:08:02 +01:00
|
|
|
, principledMempty
|
|
|
|
, StringContext(..)
|
|
|
|
, ContextFlavor(..)
|
2018-09-16 02:04:54 +02:00
|
|
|
, stringHasContext
|
2018-11-17 22:08:02 +01:00
|
|
|
, principledIntercalateNixString
|
2018-11-18 00:24:51 +01:00
|
|
|
, hackyGetStringNoContext
|
|
|
|
, principledGetStringNoContext
|
2018-11-17 20:56:59 +01:00
|
|
|
, principledStringIgnoreContext
|
2018-09-09 17:01:09 +02:00
|
|
|
, hackyStringIgnoreContext
|
2018-09-16 02:04:54 +02:00
|
|
|
, hackyMakeNixStringWithoutContext
|
2018-11-17 22:08:02 +01:00
|
|
|
, principledMakeNixStringWithoutContext
|
|
|
|
, principledMakeNixStringWithSingletonContext
|
2018-11-17 22:23:41 +01:00
|
|
|
, principledModifyNixContents
|
2018-11-17 19:29:34 +01:00
|
|
|
, principledStringMappend
|
2018-11-17 22:45:11 +01:00
|
|
|
, principledStringMempty
|
2018-11-17 19:35:39 +01:00
|
|
|
, principledStringMConcat
|
2018-12-07 00:02:59 +01:00
|
|
|
, WithStringContext
|
2019-03-16 21:16:45 +01:00
|
|
|
, WithStringContextT(..)
|
2018-12-07 00:02:59 +01:00
|
|
|
, extractNixString
|
2018-12-13 00:54:17 +01:00
|
|
|
, addStringContext
|
|
|
|
, addSingletonStringContext
|
|
|
|
, runWithStringContextT
|
2018-12-07 00:02:59 +01:00
|
|
|
, runWithStringContext
|
2019-03-17 22:47:38 +01:00
|
|
|
)
|
|
|
|
where
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-12-07 00:02:59 +01:00
|
|
|
import Control.Monad.Writer
|
2018-12-13 00:54:17 +01:00
|
|
|
import Data.Functor.Identity
|
2019-03-17 22:47:38 +01:00
|
|
|
import qualified Data.HashSet as S
|
2018-05-13 20:13:30 +02:00
|
|
|
import Data.Hashable
|
2019-03-17 22:47:38 +01:00
|
|
|
import Data.Text ( Text )
|
|
|
|
import qualified Data.Text as Text
|
2018-05-13 20:13:30 +02:00
|
|
|
import GHC.Generics
|
|
|
|
|
2018-11-18 00:24:51 +01:00
|
|
|
-- {-# WARNING hackyGetStringNoContext, hackyStringIgnoreContext, hackyMakeNixStringWithoutContext "This NixString function needs to be replaced" #-}
|
2018-09-09 17:01:09 +02:00
|
|
|
|
2018-05-13 20:13:30 +02:00
|
|
|
-- | A 'ContextFlavor' describes the sum of possible derivations for string contexts
|
2018-11-17 22:08:02 +01:00
|
|
|
data ContextFlavor =
|
2018-05-13 20:13:30 +02:00
|
|
|
DirectPath
|
|
|
|
| DerivationOutput !Text
|
|
|
|
deriving (Show, Eq, Ord, Generic)
|
|
|
|
|
|
|
|
instance Hashable ContextFlavor
|
|
|
|
|
|
|
|
-- | A 'StringContext' ...
|
2018-11-17 22:08:02 +01:00
|
|
|
data StringContext =
|
2018-05-13 20:13:30 +02:00
|
|
|
StringContext { scPath :: !Text
|
|
|
|
, scFlavor :: !ContextFlavor
|
2018-11-17 22:08:02 +01:00
|
|
|
} deriving (Eq, Ord, Show, Generic)
|
2018-05-13 20:13:30 +02:00
|
|
|
|
|
|
|
instance Hashable StringContext
|
|
|
|
|
2018-11-17 22:08:02 +01:00
|
|
|
data NixString = NixString
|
2018-05-13 20:13:30 +02:00
|
|
|
{ nsContents :: !Text
|
|
|
|
, nsContext :: !(S.HashSet StringContext)
|
2018-11-17 22:08:02 +01:00
|
|
|
} deriving (Eq, Ord, Show, Generic)
|
2018-05-13 20:13:30 +02:00
|
|
|
|
|
|
|
instance Hashable NixString
|
|
|
|
|
2018-11-21 07:21:53 +01:00
|
|
|
principledGetContext :: NixString -> S.HashSet StringContext
|
|
|
|
principledGetContext = nsContext
|
|
|
|
|
2018-11-17 22:08:02 +01:00
|
|
|
-- | Combine two NixStrings using mappend
|
|
|
|
principledMempty :: NixString
|
|
|
|
principledMempty = NixString "" mempty
|
|
|
|
|
2018-11-17 19:04:08 +01:00
|
|
|
-- | Combine two NixStrings using mappend
|
|
|
|
principledStringMappend :: NixString -> NixString -> NixString
|
2019-03-17 22:47:38 +01:00
|
|
|
principledStringMappend (NixString s1 t1) (NixString s2 t2) =
|
|
|
|
NixString (s1 <> s2) (t1 <> t2)
|
2018-11-17 19:04:08 +01:00
|
|
|
|
|
|
|
-- | Combine two NixStrings using mappend
|
2018-09-16 20:02:02 +02:00
|
|
|
hackyStringMappend :: NixString -> NixString -> NixString
|
2019-03-17 22:47:38 +01:00
|
|
|
hackyStringMappend (NixString s1 t1) (NixString s2 t2) =
|
|
|
|
NixString (s1 <> s2) (t1 <> t2)
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-11-17 22:08:02 +01:00
|
|
|
-- | Combine NixStrings with a separator
|
|
|
|
principledIntercalateNixString :: NixString -> [NixString] -> NixString
|
2019-03-17 22:47:38 +01:00
|
|
|
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)
|
2018-11-17 22:08:02 +01:00
|
|
|
|
|
|
|
-- | Combine NixStrings using mconcat
|
2018-09-16 20:02:02 +02:00
|
|
|
hackyStringMConcat :: [NixString] -> NixString
|
2018-11-17 22:08:02 +01:00
|
|
|
hackyStringMConcat = foldr hackyStringMappend (NixString mempty mempty)
|
2018-09-16 20:02:02 +02:00
|
|
|
|
2018-11-17 22:45:11 +01:00
|
|
|
-- | Empty string with empty context.
|
|
|
|
principledStringMempty :: NixString
|
|
|
|
principledStringMempty = NixString mempty mempty
|
|
|
|
|
2018-11-17 19:35:39 +01:00
|
|
|
-- | Combine NixStrings using mconcat
|
|
|
|
principledStringMConcat :: [NixString] -> NixString
|
2019-03-17 22:47:38 +01:00
|
|
|
principledStringMConcat =
|
|
|
|
foldr principledStringMappend (NixString mempty mempty)
|
2018-09-16 20:02:02 +02:00
|
|
|
|
|
|
|
--instance Semigroup NixString where
|
|
|
|
--NixString s1 t1 <> NixString s2 t2 = NixString (s1 <> s2) (t1 <> t2)
|
|
|
|
|
|
|
|
--instance Monoid NixString where
|
|
|
|
-- mempty = NixString mempty mempty
|
|
|
|
-- mappend = (<>)
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-11-17 22:08:02 +01:00
|
|
|
-- | Extract the string contents from a NixString that has no context
|
2018-11-18 00:24:51 +01:00
|
|
|
hackyGetStringNoContext :: NixString -> Maybe Text
|
2019-03-17 22:47:38 +01:00
|
|
|
hackyGetStringNoContext (NixString s c) | null c = Just s
|
|
|
|
| otherwise = Nothing
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-11-17 23:09:26 +01:00
|
|
|
-- | Extract the string contents from a NixString that has no context
|
2018-11-18 00:24:51 +01:00
|
|
|
principledGetStringNoContext :: NixString -> Maybe Text
|
2019-03-17 22:47:38 +01:00
|
|
|
principledGetStringNoContext (NixString s c) | null c = Just s
|
|
|
|
| otherwise = Nothing
|
2018-11-17 23:09:26 +01:00
|
|
|
|
2018-11-17 22:08:02 +01:00
|
|
|
-- | Extract the string contents from a NixString even if the NixString has an associated context
|
2018-11-17 20:56:59 +01:00
|
|
|
principledStringIgnoreContext :: NixString -> Text
|
|
|
|
principledStringIgnoreContext (NixString s _) = s
|
|
|
|
|
2018-11-19 13:04:08 +01:00
|
|
|
-- | Extract the string contents from a NixString even if the NixString has an associated context
|
2018-09-09 17:01:09 +02:00
|
|
|
hackyStringIgnoreContext :: NixString -> Text
|
|
|
|
hackyStringIgnoreContext (NixString s _) = s
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-09-16 02:04:54 +02:00
|
|
|
-- | Returns True if the NixString has an associated context
|
|
|
|
stringHasContext :: NixString -> Bool
|
|
|
|
stringHasContext (NixString _ c) = not (null c)
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-09-16 02:04:54 +02:00
|
|
|
-- | Constructs a NixString without a context
|
|
|
|
hackyMakeNixStringWithoutContext :: Text -> NixString
|
2018-11-17 22:08:02 +01:00
|
|
|
hackyMakeNixStringWithoutContext = flip NixString mempty
|
|
|
|
|
|
|
|
-- | Constructs a NixString without a context
|
|
|
|
principledMakeNixStringWithoutContext :: Text -> NixString
|
|
|
|
principledMakeNixStringWithoutContext = flip NixString mempty
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-11-19 13:04:08 +01:00
|
|
|
-- | Modify the string part of the NixString, leaving the context unchanged
|
2018-11-17 22:23:41 +01:00
|
|
|
principledModifyNixContents :: (Text -> Text) -> NixString -> NixString
|
|
|
|
principledModifyNixContents f (NixString s c) = NixString (f s) c
|
2018-05-13 20:13:30 +02:00
|
|
|
|
2018-11-17 22:08:02 +01:00
|
|
|
-- | Create a NixString using a singleton context
|
2019-03-17 22:47:38 +01:00
|
|
|
principledMakeNixStringWithSingletonContext
|
|
|
|
:: Text -> StringContext -> NixString
|
2018-11-17 22:08:02 +01:00
|
|
|
principledMakeNixStringWithSingletonContext s c = NixString s (S.singleton c)
|
2018-12-07 00:02:59 +01:00
|
|
|
|
2018-11-24 21:22:02 +01:00
|
|
|
-- | Create a NixString from a Text and context
|
2018-11-21 07:21:53 +01:00
|
|
|
principledMakeNixString :: Text -> S.HashSet StringContext -> NixString
|
|
|
|
principledMakeNixString s c = NixString s c
|
2018-12-10 21:48:29 +01:00
|
|
|
|
2018-12-07 00:02:59 +01:00
|
|
|
-- | A monad for accumulating string context while producing a result string.
|
2018-12-13 00:54:17 +01:00
|
|
|
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.
|
2019-03-17 22:47:38 +01:00
|
|
|
addStringContext
|
|
|
|
:: Monad m => S.HashSet StringContext -> WithStringContextT m ()
|
2018-12-13 00:54:17 +01:00
|
|
|
addStringContext = WithStringContextT . tell
|
|
|
|
|
|
|
|
-- | Add a 'StringContext' into the resulting set.
|
|
|
|
addSingletonStringContext :: Monad m => StringContext -> WithStringContextT m ()
|
|
|
|
addSingletonStringContext = WithStringContextT . tell . S.singleton
|
2018-12-07 00:02:59 +01:00
|
|
|
|
|
|
|
-- | Get the contents of a 'NixString' and write its context into the resulting set.
|
2018-12-13 00:54:17 +01:00
|
|
|
extractNixString :: Monad m => NixString -> WithStringContextT m Text
|
|
|
|
extractNixString (NixString s c) = WithStringContextT $ tell c >> return s
|
|
|
|
|
|
|
|
-- | Run an action producing a string with a context and put those into a 'NixString'.
|
|
|
|
runWithStringContextT :: Monad m => WithStringContextT m Text -> m NixString
|
2019-03-17 22:47:38 +01:00
|
|
|
runWithStringContextT (WithStringContextT m) =
|
|
|
|
uncurry NixString <$> runWriterT m
|
2018-12-07 00:02:59 +01:00
|
|
|
|
|
|
|
-- | Run an action producing a string with a context and put those into a 'NixString'.
|
2018-12-13 00:54:17 +01:00
|
|
|
runWithStringContext :: WithStringContextT Identity Text -> NixString
|
|
|
|
runWithStringContext = runIdentity . runWithStringContextT
|