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) |
