aboutsummaryrefslogtreecommitdiff
path: root/spec/src/Thermoprint/Printout.hs
diff options
context:
space:
mode:
authorGregor Kleen <gkleen@yggdrasil.li>2016-01-18 11:35:25 +0000
committerGregor Kleen <gkleen@yggdrasil.li>2016-01-18 11:35:25 +0000
commitc605c0b51011f794256df1b7b3ddeb305bb91902 (patch)
tree2eb8342abca119a5f0894e9e7e45a18f35fa8710 /spec/src/Thermoprint/Printout.hs
parent67025bbbed585e1245cc3f895c6f6fdf5fe35d6d (diff)
downloadthermoprint-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/Thermoprint/Printout.hs')
-rw-r--r--spec/src/Thermoprint/Printout.hs40
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
34import Test.QuickCheck (forAll, Property) 34import Test.QuickCheck (forAll, Property)
35 35
36 36
37import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map) 37import qualified Data.Text.Lazy as TL (split, null, pack, groupBy, filter, intercalate, map, head, length)
38import qualified Data.Text as T (pack) 38import qualified Data.Text as T (pack)
39import Data.Char (isSpace) 39import 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
95We don't export all constructors and instead encourage the use of 'text'. 95We don't export all constructors and instead encourage the use of 'text'.
96-} 96-}
97data Line = Word Text 97data 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
102instance Monoid Block where 102instance 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
116instance Monoid Line where 116instance 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
131text :: Text -> Either Block Line 131text :: 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
174prop_text :: Text -> Bool 174prop_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
207scale' = scale (round . sqrt . fromInteger . toInteger) 207scale' = scale (round . sqrt . fromInteger . toInteger)