From c605c0b51011f794256df1b7b3ddeb305bb91902 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <gkleen@yggdrasil.li>
Date: Mon, 18 Jan 2016 11:35:25 +0000
Subject: Switched word seperator to juxtaposition

---
 spec/src/Thermoprint/Printout.hs | 40 ++++++++++++++++++++--------------------
 1 file changed, 20 insertions(+), 20 deletions(-)

(limited to 'spec/src')

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
        , Chunk(..)
        , Block(..)
        , Line( HSpace
-             , SpaceSep
+             , JuxtaPos
              )
        , text, cotext
        , prop_text
@@ -34,7 +34,7 @@ import Test.QuickCheck.Instances
 import Test.QuickCheck (forAll, Property)
 
 
-import qualified Data.Text.Lazy as TL (split, null, pack, filter, intercalate, map)
+import qualified Data.Text.Lazy as TL (split, null, pack, groupBy, filter, intercalate, map, head, length)
 import qualified Data.Text as T (pack)
 import Data.Char (isSpace)
 
@@ -90,13 +90,13 @@ data Block = Line Line -- ^ a single 'Line' of text
 
   * a single word
   * horizontal space equivalent to the width of 'Integer' `em`.
-  * a sequence of words seperated by spaces
+  * a sequence of 'Line' fragments juxtaposed without seperation
 
 We don't export all constructors and instead encourage the use of 'text'.
 -} 
 data Line = Word Text
           | HSpace Integer
-          | SpaceSep (Seq Line)
+          | JuxtaPos (Seq Line)
           deriving (Generic, NFData, Show, CoArbitrary, FromJSON, ToJSON)
 
 instance Monoid Block where
@@ -114,18 +114,18 @@ instance Monoid Block where
   x `mappend` y = NewlSep $ Seq.fromList [x, y]
 
 instance Monoid Line where
-  mempty = SpaceSep mempty
-  x@(SpaceSep xs) `mappend` y@(SpaceSep ys)
+  mempty = JuxtaPos mempty
+  x@(JuxtaPos xs) `mappend` y@(JuxtaPos ys)
     | Seq.null xs = y
     | Seq.null ys = x
-    | otherwise = SpaceSep (xs <> ys)
-  (SpaceSep xs) `mappend` y
+    | otherwise = JuxtaPos (xs <> ys)
+  (JuxtaPos xs) `mappend` y
     | Seq.null xs = y
-    | otherwise = SpaceSep (xs |> y)
-  x `mappend` (SpaceSep ys)
+    | otherwise = JuxtaPos (xs |> y)
+  x `mappend` (JuxtaPos ys)
     | Seq.null ys = x
-    | otherwise = SpaceSep (x <| ys)
-  x `mappend` y = SpaceSep $ Seq.fromList [x, y]
+    | otherwise = JuxtaPos (x <| ys)
+  x `mappend` y = JuxtaPos $ Seq.fromList [x, y]
 
 
 text :: Text -> Either Block Line
@@ -144,16 +144,16 @@ text t = case splitLines t of
                    $ TL.split (== '\n') t
     splitWords :: Text -> [Line]
     splitWords t = map toLine
-                   . groupBy ((==) `on` TL.null)
-                   $ TL.split isSpace t
+                   . TL.groupBy ((==) `on` isSpace)
+                   $ t
     toBlock [] = mempty
     toBlock xs@(x:_)
       | TL.null x = VSpace $ genericLength xs - 1
       | otherwise = mconcat . map (Line . mconcat . splitWords) $ xs
-    toLine [] = mempty
-    toLine xs@(x:_)
-      | TL.null x = HSpace $ genericLength xs - 1
-      | otherwise = mconcat . map Word $ xs
+    toLine xs
+      | TL.null xs           = mempty
+      | isSpace $ TL.head xs = HSpace . toInteger $ TL.length xs
+      | otherwise            = Word xs
     list :: b -> (a -> [a] -> b) -> [a] -> b
     list c _ [] = c
     list _ f (x:xs) = f x xs
@@ -169,7 +169,7 @@ cotext (Line x) = cotext' x
   where            
     cotext' (Word x) = x
     cotext' (HSpace n) = TL.pack . genericReplicate n $ ' '
-    cotext' (SpaceSep xs) = TL.intercalate " " . map cotext' . toList $ xs
+    cotext' (JuxtaPos xs) = mconcat . map cotext' . toList $ xs
 
 prop_text :: Text -> Bool
 -- ^ prop> (`cotext` . either id Line . `text` $ x) == x
@@ -201,7 +201,7 @@ instance Arbitrary Line where
   shrink = genericShrink
   arbitrary = oneof [ Word . TL.filter (not . isSpace) <$> arbitrary -- 'isSpace '\n' == True'
                     , HSpace . getNonNegative <$> arbitrary
-                    , SpaceSep <$> scale' arbitrary
+                    , JuxtaPos <$> scale' arbitrary
                     ]
 
 scale' = scale (round . sqrt . fromInteger . toInteger)
-- 
cgit v1.2.3