]> Git — Sourcephile - haskell/symantic-plaintext.git/blob - src/Symantic/Plaintext/Output.hs
3de457d3d319bfebd6dd70cd5008e4e0069f58d5
[haskell/symantic-plaintext.git] / src / Symantic / Plaintext / Output.hs
1 {-# LANGUAGE DeriveFunctor #-}
2 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
3
4 module Symantic.Plaintext.Output where
5
6 import Data.Bool
7 import Data.Char (Char)
8 import Data.Eq (Eq (..))
9 import Data.Foldable qualified as Fold
10 import Data.Function (id, ($), (.))
11 import Data.Function qualified as Fun
12 import Data.Functor (Functor, (<$>))
13 import Data.List qualified as List
14 import Data.Maybe (Maybe (..))
15 import Data.Monoid (Monoid (..))
16 import Data.Semigroup (Semigroup (..))
17 import Data.Semigroup qualified as SG
18 import Data.String (IsString (..), String)
19 import Data.Text qualified as T
20 import Data.Text.Lazy qualified as TL
21 import Data.Text.Lazy.Builder qualified as TLB
22 import Prelude (fromIntegral)
23
24 import Symantic.Plaintext.Classes
25
26 -- * Class 'Outputable'
27 class
28 ( IsString o
29 , Convertible Char o
30 , Convertible String o
31 , Convertible T.Text o
32 , Convertible TL.Text o
33 , Monoid o
34 ) =>
35 Outputable o
36 where
37 char :: Char -> o
38 nl :: o
39 repeatedChar :: Width -> Char -> o
40 instance Outputable String where
41 char = (: [])
42 nl = "\n"
43 repeatedChar w c = fromString (List.replicate (fromIntegral w) c)
44 instance Outputable T.Text where
45 char = T.singleton
46 nl = "\n"
47 repeatedChar w = T.replicate (fromIntegral w) . T.singleton
48 instance Outputable TL.Text where
49 char = TL.singleton
50 nl = "\n"
51 repeatedChar w = TL.replicate (fromIntegral w) . TL.singleton
52
53 -- * Class 'Lengthable'
54 class Lengthable o where
55 length :: o -> Column
56 isEmpty :: o -> Bool
57 isEmpty x = length x == 0
58 instance Lengthable Char where
59 length _ = 1
60 isEmpty = Fun.const False
61 instance Lengthable String where
62 length = fromIntegral . List.length
63 isEmpty = Fold.null
64 instance Lengthable T.Text where
65 length = fromIntegral . T.length
66 isEmpty = T.null
67 instance Lengthable TL.Text where
68 length = fromIntegral . TL.length
69 isEmpty = TL.null
70
71 -- * Class 'Splitable'
72 class (Lengthable o, Monoid o) => Splitable o where
73 tail :: o -> Maybe (o)
74 break :: (Char -> Bool) -> o -> (o, o)
75 span :: (Char -> Bool) -> o -> (o, o)
76 span f = break (not . f)
77
78 splitOnChar :: (Char -> Bool) -> o -> [o]
79 splitOnChar f d0 =
80 if isEmpty d0 then [] else go d0
81 where
82 go o =
83 let (l, r) = f `break` o
84 in l : case tail r of
85 Nothing -> []
86 Just rt
87 | isEmpty rt -> [mempty]
88 | otherwise -> go rt
89 splitOnCharNoEmpty :: (Char -> Bool) -> o -> [o]
90 splitOnCharNoEmpty f x =
91 let (l, r) = f `break` x
92 in [l | not (isEmpty l)]
93 SG.<> case tail r of
94 Nothing -> []
95 Just rt -> splitOnCharNoEmpty f rt
96 instance Splitable String where
97 tail [] = Nothing
98 tail s = Just $ List.tail s
99 break = List.break
100 instance Splitable T.Text where
101 tail "" = Nothing
102 tail s = Just $ T.tail s
103 break = T.break
104 instance Splitable TL.Text where
105 tail "" = Nothing
106 tail s = Just $ TL.tail s
107 break = TL.break
108
109 -- ** Type 'Line'
110 newtype Line o = Line {unLine :: o}
111 deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)
112
113 lines :: Splitable o => o -> [Line o]
114 linesNoEmpty :: Splitable o => o -> [Line o]
115 lines = (Line <$>) . splitOnChar (== '\n')
116 linesNoEmpty = (Line <$>) . splitOnCharNoEmpty (== '\n')
117
118 -- ** Type 'Word'
119 newtype Word o = Word {unWord :: o}
120 deriving (Functor, Semigroup, Monoid, Lengthable, Splitable)
121
122 words :: Splitable o => Line o -> [Word o]
123 wordsNoEmpty :: Splitable o => Line o -> [Word o]
124 words = (Word <$>) . splitOnChar (== ' ') . unLine
125 wordsNoEmpty = (Word <$>) . splitOnCharNoEmpty (== ' ') . unLine
126
127 -- * Class 'Convertible'
128 class Convertible i o where
129 convert :: i -> o
130 instance Convertible Char String where
131 convert = (: [])
132 instance Convertible String String where
133 convert = id
134 instance Convertible T.Text String where
135 convert = T.unpack
136 instance Convertible TL.Text String where
137 convert = TL.unpack
138 instance Convertible Char T.Text where
139 convert = T.singleton
140 instance Convertible String T.Text where
141 convert = T.pack
142 instance Convertible T.Text T.Text where
143 convert = id
144 instance Convertible TL.Text T.Text where
145 convert = TL.toStrict
146 instance Convertible Char TL.Text where
147 convert = TL.singleton
148 instance Convertible String TL.Text where
149 convert = TL.pack
150 instance Convertible T.Text TL.Text where
151 convert = TL.fromStrict
152 instance Convertible TL.Text TL.Text where
153 convert = id
154 instance Convertible Char TLB.Builder where
155 convert = TLB.singleton
156 instance Convertible String TLB.Builder where
157 convert = fromString
158 instance Convertible T.Text TLB.Builder where
159 convert = TLB.fromText
160 instance Convertible TL.Text TLB.Builder where
161 convert = TLB.fromLazyText
162 instance Convertible TLB.Builder TLB.Builder where
163 convert = id
164 instance Convertible i o => Convertible (Word i) (Word o) where
165 convert = Word . convert . unWord
166 instance Convertible i o => Convertible (Line i) (Line o) where
167 convert = Line . convert . unLine