]> Git — Sourcephile - haskell/symantic-plaintext.git/blob - src/Symantic/Plaintext/Classes.hs
wip
[haskell/symantic-plaintext.git] / src / Symantic / Plaintext / Classes.hs
1 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
2 {-# LANGUAGE UndecidableInstances #-}
3
4 module Symantic.Plaintext.Classes (
5 module Symantic.Plaintext.Classes,
6 Emptyable (..),
7 Inferable (..),
8 ProductFunctor (..),
9 Repeatable (..),
10 Voidable (..),
11 bool,
12 char,
13 int,
14 natural,
15 string,
16 ) where
17
18 import Data.Bool hiding (bool)
19 import Data.Char (Char)
20 import Data.Foldable (Foldable)
21 import Data.Foldable qualified as Fold
22 import Data.Function (($), (.))
23 import Data.Functor qualified as Fct
24 import Data.Int (Int)
25 import Data.Maybe (Maybe (..))
26 import Data.Ord (Ord (..))
27 import Data.Traversable (Traversable)
28 import Numeric.Natural (Natural)
29 import Symantic.Classes (
30 Emptyable (..),
31 Inferable (..),
32 ProductFunctor (..),
33 Repeatable (..),
34 Voidable (..),
35 bool,
36 char,
37 int,
38 natural,
39 string,
40 )
41 import Symantic.Derive
42 import System.Console.ANSI qualified as ANSI
43 import Prelude (fromIntegral, pred)
44
45 concat ::
46 Emptyable repr =>
47 ProductFunctor repr =>
48 Foldable f =>
49 f (repr ()) ->
50 repr ()
51 concat = Fold.foldr (.>) empty
52
53 -- * Class 'Repeatable'
54 many :: Repeatable repr => repr a -> repr [a]
55 many = many0
56 some :: Repeatable repr => repr a -> repr [a]
57 some = many1
58
59 -- * Class 'Spaceable'
60 class
61 ( ProductFunctor repr
62 , Emptyable repr
63 ) =>
64 Spaceable repr
65 where
66 space :: repr ()
67
68 -- | @'spaces' ind = 'replicate' ind 'space'@
69 spaces :: Column -> repr ()
70
71 default space :: FromDerived Spaceable repr => repr ()
72 default spaces :: Column -> repr ()
73 spaces i = replicate (fromIntegral i) space
74 space = liftDerived space
75
76 -- | @x '<+>' y = x '<>' 'space' '<>' y@
77 (<+>) :: repr a -> repr b -> repr (a, b)
78 x <+> y = x <.> space .> y
79
80 (+>) :: repr () -> repr a -> repr a
81 x +> y = x .> space .> y
82 (<+) :: repr a -> repr () -> repr a
83 x <+ y = x <. space <. y
84
85 type Column = Natural
86
87 -- * Class 'Newlineable'
88 class Newlineable repr where
89 newline :: repr ()
90 default newline :: FromDerived Newlineable repr => repr ()
91 newline = liftDerived newline
92
93 unlines ::
94 Emptyable repr =>
95 ProductFunctor repr =>
96 Foldable f =>
97 f (repr ()) ->
98 repr ()
99 unlines = Fold.foldr (\x acc -> x .> newline .> acc) empty
100 unlines_ :: Listable repr => repr a -> repr [a]
101 unlines_ = intercalate_ newline
102
103 -- | @x '</>' y = x '<>' 'newline' '<>' y@
104 (</>) :: ProductFunctor repr => repr a -> repr b -> repr (a, b)
105 x </> y = x <.> newline .> y
106
107 catV ::
108 ProductFunctor repr =>
109 Emptyable repr =>
110 Foldable f =>
111 f (repr ()) ->
112 repr ()
113 catV = intercalate newline
114 infixr 6 <+>
115 infixr 6 </>
116
117 intercalate ::
118 Foldable f =>
119 Emptyable repr =>
120 ProductFunctor repr =>
121 repr () ->
122 f (repr ()) ->
123 repr ()
124 intercalate sep rs
125 | Fold.null rs = empty
126 | otherwise = Fold.foldr1 (\x y -> x .> sep .> y) rs
127
128 replicate ::
129 Emptyable repr =>
130 ProductFunctor repr =>
131 Int ->
132 repr () ->
133 repr ()
134 replicate cnt t
135 | cnt <= 0 = empty
136 | otherwise = t .> replicate (pred cnt) t
137
138 between ::
139 ProductFunctor repr =>
140 repr () ->
141 repr () ->
142 repr a ->
143 repr a
144 between o c x = o .> x <. c
145 parens
146 , braces
147 , brackets
148 , angles ::
149 ProductFunctor repr =>
150 Voidable repr =>
151 Inferable Char repr =>
152 repr a ->
153 repr a
154 parens = between (void '(' infer) (void ')' infer)
155 braces = between (void '{' infer) (void '}' infer)
156 brackets = between (void '[' infer) (void ']' infer)
157 angles = between (void '<' infer) (void '>' infer)
158
159 -- * Class 'Decorable'
160 class Decorable repr where
161 bold :: repr a -> repr a
162 underline :: repr a -> repr a
163 italic :: repr a -> repr a
164 default bold :: FromDerived1 Decorable repr => repr a -> repr a
165 default underline :: FromDerived1 Decorable repr => repr a -> repr a
166 default italic :: FromDerived1 Decorable repr => repr a -> repr a
167 bold = liftDerived1 bold
168 underline = liftDerived1 underline
169 italic = liftDerived1 italic
170
171 -- * Class 'Colorable16'
172 class Colorable16 repr where
173 reverse :: repr a -> repr a
174
175 -- Foreground colors
176 -- Dull
177 black :: repr a -> repr a
178 red :: repr a -> repr a
179 green :: repr a -> repr a
180 yellow :: repr a -> repr a
181 blue :: repr a -> repr a
182 magenta :: repr a -> repr a
183 cyan :: repr a -> repr a
184 white :: repr a -> repr a
185
186 -- Vivid
187 blacker :: repr a -> repr a
188 redder :: repr a -> repr a
189 greener :: repr a -> repr a
190 yellower :: repr a -> repr a
191 bluer :: repr a -> repr a
192 magentaer :: repr a -> repr a
193 cyaner :: repr a -> repr a
194 whiter :: repr a -> repr a
195
196 -- Background colors
197 -- Dull
198 onBlack :: repr a -> repr a
199 onRed :: repr a -> repr a
200 onGreen :: repr a -> repr a
201 onYellow :: repr a -> repr a
202 onBlue :: repr a -> repr a
203 onMagenta :: repr a -> repr a
204 onCyan :: repr a -> repr a
205 onWhite :: repr a -> repr a
206
207 -- Vivid
208 onBlacker :: repr a -> repr a
209 onRedder :: repr a -> repr a
210 onGreener :: repr a -> repr a
211 onYellower :: repr a -> repr a
212 onBluer :: repr a -> repr a
213 onMagentaer :: repr a -> repr a
214 onCyaner :: repr a -> repr a
215 onWhiter :: repr a -> repr a
216
217 default reverse :: FromDerived1 Colorable16 repr => repr a -> repr a
218 default black :: FromDerived1 Colorable16 repr => repr a -> repr a
219 default red :: FromDerived1 Colorable16 repr => repr a -> repr a
220 default green :: FromDerived1 Colorable16 repr => repr a -> repr a
221 default yellow :: FromDerived1 Colorable16 repr => repr a -> repr a
222 default blue :: FromDerived1 Colorable16 repr => repr a -> repr a
223 default magenta :: FromDerived1 Colorable16 repr => repr a -> repr a
224 default cyan :: FromDerived1 Colorable16 repr => repr a -> repr a
225 default white :: FromDerived1 Colorable16 repr => repr a -> repr a
226 default blacker :: FromDerived1 Colorable16 repr => repr a -> repr a
227 default redder :: FromDerived1 Colorable16 repr => repr a -> repr a
228 default greener :: FromDerived1 Colorable16 repr => repr a -> repr a
229 default yellower :: FromDerived1 Colorable16 repr => repr a -> repr a
230 default bluer :: FromDerived1 Colorable16 repr => repr a -> repr a
231 default magentaer :: FromDerived1 Colorable16 repr => repr a -> repr a
232 default cyaner :: FromDerived1 Colorable16 repr => repr a -> repr a
233 default whiter :: FromDerived1 Colorable16 repr => repr a -> repr a
234 default onBlack :: FromDerived1 Colorable16 repr => repr a -> repr a
235 default onRed :: FromDerived1 Colorable16 repr => repr a -> repr a
236 default onGreen :: FromDerived1 Colorable16 repr => repr a -> repr a
237 default onYellow :: FromDerived1 Colorable16 repr => repr a -> repr a
238 default onBlue :: FromDerived1 Colorable16 repr => repr a -> repr a
239 default onMagenta :: FromDerived1 Colorable16 repr => repr a -> repr a
240 default onCyan :: FromDerived1 Colorable16 repr => repr a -> repr a
241 default onWhite :: FromDerived1 Colorable16 repr => repr a -> repr a
242 default onBlacker :: FromDerived1 Colorable16 repr => repr a -> repr a
243 default onRedder :: FromDerived1 Colorable16 repr => repr a -> repr a
244 default onGreener :: FromDerived1 Colorable16 repr => repr a -> repr a
245 default onYellower :: FromDerived1 Colorable16 repr => repr a -> repr a
246 default onBluer :: FromDerived1 Colorable16 repr => repr a -> repr a
247 default onMagentaer :: FromDerived1 Colorable16 repr => repr a -> repr a
248 default onCyaner :: FromDerived1 Colorable16 repr => repr a -> repr a
249 default onWhiter :: FromDerived1 Colorable16 repr => repr a -> repr a
250
251 reverse = liftDerived1 reverse
252 black = liftDerived1 black
253 red = liftDerived1 red
254 green = liftDerived1 green
255 yellow = liftDerived1 yellow
256 blue = liftDerived1 blue
257 magenta = liftDerived1 magenta
258 cyan = liftDerived1 cyan
259 white = liftDerived1 white
260 blacker = liftDerived1 blacker
261 redder = liftDerived1 redder
262 greener = liftDerived1 greener
263 yellower = liftDerived1 yellower
264 bluer = liftDerived1 bluer
265 magentaer = liftDerived1 magentaer
266 cyaner = liftDerived1 cyaner
267 whiter = liftDerived1 whiter
268 onBlack = liftDerived1 onBlack
269 onRed = liftDerived1 onRed
270 onGreen = liftDerived1 onGreen
271 onYellow = liftDerived1 onYellow
272 onBlue = liftDerived1 onBlue
273 onMagenta = liftDerived1 onMagenta
274 onCyan = liftDerived1 onCyan
275 onWhite = liftDerived1 onWhite
276 onBlacker = liftDerived1 onBlacker
277 onRedder = liftDerived1 onRedder
278 onGreener = liftDerived1 onGreener
279 onYellower = liftDerived1 onYellower
280 onBluer = liftDerived1 onBluer
281 onMagentaer = liftDerived1 onMagentaer
282 onCyaner = liftDerived1 onCyaner
283 onWhiter = liftDerived1 onWhiter
284
285 type SGR = ANSI.SGR
286
287 -- * Class 'Indentable'
288 class Spaceable repr => Indentable repr where
289 -- | @('align' fmt)@ make @fmt@ uses current 'Column' as 'Indent' level.
290 align :: repr a -> repr a
291
292 -- | @('setIndent' p ind fmt)@ make @fmt@ uses @ind@ as 'Indent' level. Using @p@ as 'Indent' text.
293 setIndent :: repr () -> Indent -> repr a -> repr a
294
295 -- | @('incrIndent' p ind fmt)@ make @fmt@ uses current 'Indent' plus @ind@ as 'Indent' level. Appending @p@ to the current 'Indent' text.
296 incrIndent :: repr () -> Indent -> repr a -> repr a
297
298 hang :: Indent -> repr a -> repr a
299 hang ind = align . incrIndent (spaces ind) ind
300
301 -- | @('fill' w fmt)@ write @fmt@, then if @fmt@ is not wider than @w@, write the difference with 'spaces'.
302 fill :: Width -> repr a -> repr a
303
304 fillOrBreak :: Width -> repr a -> repr a
305
306 default align :: FromDerived1 Indentable repr => repr a -> repr a
307 default incrIndent :: FromDerived2 Indentable repr => repr () -> Indent -> repr a -> repr a
308 default setIndent :: FromDerived2 Indentable repr => repr () -> Indent -> repr a -> repr a
309 default fill :: FromDerived1 Indentable repr => Width -> repr a -> repr a
310 default fillOrBreak :: FromDerived1 Indentable repr => Width -> repr a -> repr a
311
312 align = liftDerived1 align
313 setIndent p i = liftDerived2 (`setIndent` i) p
314 incrIndent p i = liftDerived2 (`incrIndent` i) p
315 fill = liftDerived1 . fill
316 fillOrBreak = liftDerived1 . fillOrBreak
317
318 type Indent = Column
319 type Width = Natural
320
321 -- * Class 'Listable'
322 class Listable repr where
323 ul :: Traversable f => f (repr ()) -> repr ()
324 ol :: Traversable f => f (repr ()) -> repr ()
325 default ul ::
326 FromDerived Listable repr =>
327 Derivable repr =>
328 Traversable f =>
329 f (repr ()) ->
330 repr ()
331 default ol ::
332 FromDerived Listable repr =>
333 Derivable repr =>
334 Traversable f =>
335 f (repr ()) ->
336 repr ()
337 ul xs = liftDerived $ ul $ derive Fct.<$> xs
338 ol xs = liftDerived $ ol $ derive Fct.<$> xs
339 unorderedList :: repr a -> repr [a]
340 orderedList :: repr a -> repr [a]
341 list_ :: repr () -> repr () -> repr () -> repr a -> repr [a]
342 default unorderedList :: FromDerived1 Listable repr => repr a -> repr [a]
343 default orderedList :: FromDerived1 Listable repr => repr a -> repr [a]
344 default list_ :: FromDerived4 Listable repr => repr () -> repr () -> repr () -> repr a -> repr [a]
345 unorderedList = liftDerived1 unorderedList
346 orderedList = liftDerived1 orderedList
347 list_ = liftDerived4 list_
348 intercalate_ :: repr () -> repr a -> repr [a]
349 default intercalate_ ::
350 FromDerived2 Listable repr =>
351 repr () ->
352 repr a ->
353 repr [a]
354 intercalate_ = liftDerived2 intercalate_
355 braceList ::
356 Voidable repr =>
357 Inferable Char repr =>
358 repr a ->
359 repr [a]
360 braceList = list_ (void '{' infer) (void ',' infer) (void '}' infer)
361 bracketList ::
362 Voidable repr =>
363 Inferable Char repr =>
364 repr a ->
365 repr [a]
366 bracketList = list_ (void '[' infer) (void ',' infer) (void ']' infer)
367 parenList ::
368 Voidable repr =>
369 Inferable Char repr =>
370 repr a ->
371 repr [a]
372 parenList = list_ (void '(' infer) (void ',' infer) (void ')' infer)
373 angleList ::
374 Voidable repr =>
375 Inferable Char repr =>
376 repr a ->
377 repr [a]
378 angleList = list_ (void '<' infer) (void ',' infer) (void '>' infer)
379
380 -- * Class 'Wrappable'
381 class Wrappable repr where
382 setWidth :: Maybe Width -> repr a -> repr a
383
384 -- getWidth :: (Maybe Width -> repr a) -> repr a
385 breakpoint :: repr ()
386 breakspace :: repr ()
387 breakalt :: repr a -> repr a -> repr a
388 endline :: repr ()
389 default breakpoint :: FromDerived Wrappable repr => repr ()
390 default breakspace :: FromDerived Wrappable repr => repr ()
391 default breakalt :: FromDerived2 Wrappable repr => repr a -> repr a -> repr a
392 default endline :: FromDerived Wrappable repr => repr ()
393 breakpoint = liftDerived breakpoint
394 breakspace = liftDerived breakspace
395 breakalt = liftDerived2 breakalt
396 endline = liftDerived endline
397 unwords ::
398 ProductFunctor repr =>
399 Listable repr =>
400 Emptyable repr =>
401 Foldable f =>
402 f (repr ()) ->
403 repr ()
404 unwords_ :: Listable repr => repr a -> repr [a]
405 unwords = intercalate breakspace
406 unwords_ = intercalate_ breakspace
407
408 -- * Class 'Justifiable'
409 class Justifiable repr where
410 justify :: repr a -> repr a