From c605c0b51011f794256df1b7b3ddeb305bb91902 Mon Sep 17 00:00:00 2001 From: Gregor Kleen Date: Mon, 18 Jan 2016 11:35:25 +0000 Subject: Switched word seperator to juxtaposition --- spec/src/Thermoprint/Printout.hs | 40 ++++++++++++++++++++-------------------- spec/thermoprint-spec.cabal | 8 ++++++-- spec/thermoprint-spec.nix | 2 +- 3 files changed, 27 insertions(+), 23 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 , 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) diff --git a/spec/thermoprint-spec.cabal b/spec/thermoprint-spec.cabal index a7c7c90..5624a3b 100644 --- a/spec/thermoprint-spec.cabal +++ b/spec/thermoprint-spec.cabal @@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/ name: thermoprint-spec -version: 1.0.0 +version: 2.0.0 synopsis: A specification of the API and the payload datatypes and associated utilities -- description: homepage: http://dirty-haskell.org/tags/thermoprint.html @@ -56,9 +56,13 @@ Test-Suite tests main-is: Spec.hs ghc-options: -threaded -with-rtsopts=-N extensions: StandaloneDeriving + , OverloadedStrings + , OverloadedLists build-depends: base >=4.8.1 && <5 , thermoprint-spec -any , hspec >=2.2.1 && <3 , QuickCheck >=2.8.1 && <3 , quickcheck-instances >=0.3.11 && <4 - , aeson >=0.9.0 && <1 \ No newline at end of file + , aeson >=0.9.0 && <1 + , containers >=0.5.6 && <1 + , text >=1.2.1 && <2 \ No newline at end of file diff --git a/spec/thermoprint-spec.nix b/spec/thermoprint-spec.nix index d20a8e6..0e548a6 100644 --- a/spec/thermoprint-spec.nix +++ b/spec/thermoprint-spec.nix @@ -5,7 +5,7 @@ }: mkDerivation { pname = "thermoprint-spec"; - version = "1.0.0"; + version = "2.0.0"; src = ./.; libraryHaskellDepends = [ aeson base base64-bytestring bbcode bytestring Cabal -- cgit v1.2.3