diff options
author | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-18 11:35:25 +0000 |
---|---|---|
committer | Gregor Kleen <gkleen@yggdrasil.li> | 2016-01-18 11:35:25 +0000 |
commit | c605c0b51011f794256df1b7b3ddeb305bb91902 (patch) | |
tree | 2eb8342abca119a5f0894e9e7e45a18f35fa8710 /spec/src | |
parent | 67025bbbed585e1245cc3f895c6f6fdf5fe35d6d (diff) | |
download | thermoprint-c605c0b51011f794256df1b7b3ddeb305bb91902.tar thermoprint-c605c0b51011f794256df1b7b3ddeb305bb91902.tar.gz thermoprint-c605c0b51011f794256df1b7b3ddeb305bb91902.tar.bz2 thermoprint-c605c0b51011f794256df1b7b3ddeb305bb91902.tar.xz thermoprint-c605c0b51011f794256df1b7b3ddeb305bb91902.zip |
Switched word seperator to juxtaposition
Diffstat (limited to 'spec/src')
-rw-r--r-- | spec/src/Thermoprint/Printout.hs | 40 |
1 files changed, 20 insertions, 20 deletions
diff --git a/spec/src/Thermoprint/Printout.hs b/spec/src/Thermoprint/Printout.hs index 44ec5e1..1106d2f 100644 --- a/spec/src/Thermoprint/Printout.hs +++ b/spec/src/Thermoprint/Printout.hs | |||
@@ -9,7 +9,7 @@ module Thermoprint.Printout | |||
9 | , Chunk(..) | 9 | , Chunk(..) |
10 | , Block(..) | 10 | , Block(..) |
11 | , Line( HSpace | 11 | , Line( HSpace |
12 | , SpaceSep | 12 | , JuxtaPos |
13 | ) | 13 | ) |
14 | , text, cotext | 14 | , text, cotext |
15 | , prop_text | 15 | , prop_text |
@@ -34,7 +34,7 @@ import Test.QuickCheck.Instances | |||
34 | import Test.QuickCheck (forAll, Property) | 34 | import Test.QuickCheck (forAll, Property) |
35 | 35 | ||
36 | 36 | ||
37 | import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map) | 37 | import qualified Data.Text.Lazy as TL (split, null, pack, groupBy, filter, intercalate, map, head, length) |
38 | import qualified Data.Text as T (pack) | 38 | import qualified Data.Text as T (pack) |
39 | import Data.Char (isSpace) | 39 | import Data.Char (isSpace) |
40 | 40 | ||
@@ -90,13 +90,13 @@ data Block = Line Line -- ^ a single 'Line' of text | |||
90 | 90 | ||
91 | * a single word | 91 | * a single word |
92 | * horizontal space equivalent to the width of 'Integer' `em`. | 92 | * horizontal space equivalent to the width of 'Integer' `em`. |
93 | * a sequence of words seperated by spaces | 93 | * a sequence of 'Line' fragments juxtaposed without seperation |
94 | 94 | ||
95 | We don't export all constructors and instead encourage the use of 'text'. | 95 | We don't export all constructors and instead encourage the use of 'text'. |
96 | -} | 96 | -} |
97 | data Line = Word Text | 97 | data Line = Word Text |
98 | | HSpace Integer | 98 | | HSpace Integer |
99 | | SpaceSep (Seq Line) | 99 | | JuxtaPos (Seq Line) |
100 | deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON) | 100 | deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON) |
101 | 101 | ||
102 | instance Monoid Block where | 102 | instance Monoid Block where |
@@ -114,18 +114,18 @@ instance Monoid Block where | |||
114 | x `mappend` y = NewlSep $ Seq.fromList [x, y] | 114 | x `mappend` y = NewlSep $ Seq.fromList [x, y] |
115 | 115 | ||
116 | instance Monoid Line where | 116 | instance Monoid Line where |
117 | mempty = SpaceSep mempty | 117 | mempty = JuxtaPos mempty |
118 | x@(SpaceSep xs) `mappend` y@(SpaceSep ys) | 118 | x@(JuxtaPos xs) `mappend` y@(JuxtaPos ys) |
119 | | Seq.null xs = y | 119 | | Seq.null xs = y |
120 | | Seq.null ys = x | 120 | | Seq.null ys = x |
121 | | otherwise = SpaceSep (xs <> ys) | 121 | | otherwise = JuxtaPos (xs <> ys) |
122 | (SpaceSep xs) `mappend` y | 122 | (JuxtaPos xs) `mappend` y |
123 | | Seq.null xs = y | 123 | | Seq.null xs = y |
124 | | otherwise = SpaceSep (xs |> y) | 124 | | otherwise = JuxtaPos (xs |> y) |
125 | x `mappend` (SpaceSep ys) | 125 | x `mappend` (JuxtaPos ys) |
126 | | Seq.null ys = x | 126 | | Seq.null ys = x |
127 | | otherwise = SpaceSep (x <| ys) | 127 | | otherwise = JuxtaPos (x <| ys) |
128 | x `mappend` y = SpaceSep $ Seq.fromList [x, y] | 128 | x `mappend` y = JuxtaPos $ Seq.fromList [x, y] |
129 | 129 | ||
130 | 130 | ||
131 | text :: Text -> Either Block Line | 131 | text :: Text -> Either Block Line |
@@ -144,16 +144,16 @@ text t = case splitLines t of | |||
144 | $ TL.split (== '\n') t | 144 | $ TL.split (== '\n') t |
145 | splitWords :: Text -> [Line] | 145 | splitWords :: Text -> [Line] |
146 | splitWords t = map toLine | 146 | splitWords t = map toLine |
147 | . groupBy ((==) `on` TL.null) | 147 | . TL.groupBy ((==) `on` isSpace) |
148 | $ TL.split isSpace t | 148 | $ t |
149 | toBlock [] = mempty | 149 | toBlock [] = mempty |
150 | toBlock xs@(x:_) | 150 | toBlock xs@(x:_) |
151 | | TL.null x = VSpace $ genericLength xs - 1 | 151 | | TL.null x = VSpace $ genericLength xs - 1 |
152 | | otherwise = mconcat . map (Line . mconcat . splitWords) $ xs | 152 | | otherwise = mconcat . map (Line . mconcat . splitWords) $ xs |
153 | toLine [] = mempty | 153 | toLine xs |
154 | toLine xs@(x:_) | 154 | | TL.null xs = mempty |
155 | | TL.null x = HSpace $ genericLength xs - 1 | 155 | | isSpace $ TL.head xs = HSpace . toInteger $ TL.length xs |
156 | | otherwise = mconcat . map Word $ xs | 156 | | otherwise = Word xs |
157 | list :: b -> (a -> [a] -> b) -> [a] -> b | 157 | list :: b -> (a -> [a] -> b) -> [a] -> b |
158 | list c _ [] = c | 158 | list c _ [] = c |
159 | list _ f (x:xs) = f x xs | 159 | list _ f (x:xs) = f x xs |
@@ -169,7 +169,7 @@ cotext (Line x) = cotext' x | |||
169 | where | 169 | where |
170 | cotext' (Word x) = x | 170 | cotext' (Word x) = x |
171 | cotext' (HSpace n) = TL.pack . genericReplicate n $ ' ' | 171 | cotext' (HSpace n) = TL.pack . genericReplicate n $ ' ' |
172 | cotext' (SpaceSep xs) = TL.intercalate " " . map cotext' . toList $ xs | 172 | cotext' (JuxtaPos xs) = mconcat . map cotext' . toList $ xs |
173 | 173 | ||
174 | prop_text :: Text -> Bool | 174 | prop_text :: Text -> Bool |
175 | -- ^ prop> (`cotext` . either id Line . `text` $ x) == x | 175 | -- ^ prop> (`cotext` . either id Line . `text` $ x) == x |
@@ -201,7 +201,7 @@ instance Arbitrary Line where | |||
201 | shrink = genericShrink | 201 | shrink = genericShrink |
202 | arbitrary = oneof [ Word . TL.filter (not . isSpace) <$> arbitrary -- 'isSpace '\n' == True' | 202 | arbitrary = oneof [ Word . TL.filter (not . isSpace) <$> arbitrary -- 'isSpace '\n' == True' |
203 | , HSpace . getNonNegative <$> arbitrary | 203 | , HSpace . getNonNegative <$> arbitrary |
204 | , SpaceSep <$> scale' arbitrary | 204 | , JuxtaPos <$> scale' arbitrary |
205 | ] | 205 | ] |
206 | 206 | ||
207 | scale' = scale (round . sqrt . fromInteger . toInteger) | 207 | scale' = scale (round . sqrt . fromInteger . toInteger) |