diff options
| -rw-r--r-- | spec/src/Thermoprint/Printout.hs | 40 | ||||
| -rw-r--r-- | spec/thermoprint-spec.cabal | 8 | ||||
| -rw-r--r-- | 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 | |||
| 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) |
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 @@ | |||
| 2 | -- documentation, see http://haskell.org/cabal/users-guide/ | 2 | -- documentation, see http://haskell.org/cabal/users-guide/ |
| 3 | 3 | ||
| 4 | name: thermoprint-spec | 4 | name: thermoprint-spec |
| 5 | version: 1.0.0 | 5 | version: 2.0.0 |
| 6 | synopsis: A specification of the API and the payload datatypes and associated utilities | 6 | synopsis: A specification of the API and the payload datatypes and associated utilities |
| 7 | -- description: | 7 | -- description: |
| 8 | homepage: http://dirty-haskell.org/tags/thermoprint.html | 8 | homepage: http://dirty-haskell.org/tags/thermoprint.html |
| @@ -56,9 +56,13 @@ Test-Suite tests | |||
| 56 | main-is: Spec.hs | 56 | main-is: Spec.hs |
| 57 | ghc-options: -threaded -with-rtsopts=-N | 57 | ghc-options: -threaded -with-rtsopts=-N |
| 58 | extensions: StandaloneDeriving | 58 | extensions: StandaloneDeriving |
| 59 | , OverloadedStrings | ||
| 60 | , OverloadedLists | ||
| 59 | build-depends: base >=4.8.1 && <5 | 61 | build-depends: base >=4.8.1 && <5 |
| 60 | , thermoprint-spec -any | 62 | , thermoprint-spec -any |
| 61 | , hspec >=2.2.1 && <3 | 63 | , hspec >=2.2.1 && <3 |
| 62 | , QuickCheck >=2.8.1 && <3 | 64 | , QuickCheck >=2.8.1 && <3 |
| 63 | , quickcheck-instances >=0.3.11 && <4 | 65 | , quickcheck-instances >=0.3.11 && <4 |
| 64 | , aeson >=0.9.0 && <1 \ No newline at end of file | 66 | , aeson >=0.9.0 && <1 |
| 67 | , containers >=0.5.6 && <1 | ||
| 68 | , 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 @@ | |||
| 5 | }: | 5 | }: |
| 6 | mkDerivation { | 6 | mkDerivation { |
| 7 | pname = "thermoprint-spec"; | 7 | pname = "thermoprint-spec"; |
| 8 | version = "1.0.0"; | 8 | version = "2.0.0"; |
| 9 | src = ./.; | 9 | src = ./.; |
| 10 | libraryHaskellDepends = [ | 10 | libraryHaskellDepends = [ |
| 11 | aeson base base64-bytestring bbcode bytestring Cabal | 11 | aeson base base64-bytestring bbcode bytestring Cabal |
