/
String.hs
176 lines (141 loc) · 6.72 KB
/
String.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}
module Nix.String (
NixString
, principledGetContext
, principledMakeNixString
, principledMempty
, StringContext(..)
, ContextFlavor(..)
, 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.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
| 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
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 >> 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
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