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