summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorKierán Meinhardt <kieran.meinhardt@gmail.com>2019-01-29 23:03:22 +0100
committerKierán Meinhardt <kieran.meinhardt@gmail.com>2019-02-05 20:52:24 +0100
commitfa87fc922cd4c34b46baa32be762dda495ef6a2b (patch)
treebcd0600a8ba714278a74d210232f2363475d2d06
parente75d0cf94582a5aa6dde781b8428ffff45cf7e76 (diff)
Blessings: add test
~ change SGR type to Word8 + add hspec with QuickCheck
-rw-r--r--blessings.cabal13
-rw-r--r--src/Blessings.hs26
-rw-r--r--src/Blessings/Internal.hs3
-rw-r--r--src/Blessings/String.hs2
-rw-r--r--src/Blessings/Text.hs2
-rw-r--r--test/Spec.hs25
6 files changed, 55 insertions, 16 deletions
diff --git a/blessings.cabal b/blessings.cabal
index e5b0c7d..4b1570a 100644
--- a/blessings.cabal
+++ b/blessings.cabal
@@ -1,6 +1,6 @@
author: tv
build-type: Simple
-cabal-version: >= 1.2
+cabal-version: >= 1.8
license: MIT
name: blessings
version: 2.1.0
@@ -17,6 +17,17 @@ library
ghc-options: -O2 -Wall
hs-source-dirs: src
+test-suite test-blessings
+ build-depends:
+ base,
+ blessings,
+ hspec,
+ QuickCheck
+ ghc-options: -Wall
+ hs-source-dirs: test
+ main-is: Spec.hs
+ type: exitcode-stdio-1.0
+
source-repository head
location: https://cgit.krebsco.de/blessings
type: git
diff --git a/src/Blessings.hs b/src/Blessings.hs
index 302b8bc..26a0666 100644
--- a/src/Blessings.hs
+++ b/src/Blessings.hs
@@ -7,15 +7,17 @@ module Blessings
, module Blessings
) where
-import qualified Prelude
import Blessings.Internal as Export (Blessable)
import qualified Blessings.Internal as Bless
-import Prelude hiding (length,drop,take)
import Control.Applicative
-import Data.String
import Data.Ix (inRange)
+import Data.List (genericDrop)
+import Data.String
+import Data.Word (Word8)
+import qualified Prelude
+import Prelude hiding (drop, length, take)
-type Ps = Int
+type Ps = Word8
type Pm = [Ps]
data Blessings a
@@ -114,7 +116,7 @@ instance IsPm Blink where
toPm NoBlink = [25]
fromPm = rec . filterPm sgrColor
where
- rec xs = case filter (`elem` ([5,25] :: [Int])) xs of
+ rec xs = case filter (`elem` ([5,25] :: [Word8])) xs of
[] -> Nothing
xs' -> case last xs' of
5 -> Just Blink
@@ -130,7 +132,7 @@ instance IsPm Bold where
toPm NoBold = [22]
fromPm = rec . filterPm sgrColor
where
- rec xs = case filter (`elem` ([1,22] :: [Int])) xs of
+ rec xs = case filter (`elem` ([1,22] :: [Word8])) xs of
[] -> Nothing
xs' -> case last xs' of
1 -> Just Bold
@@ -146,7 +148,7 @@ instance IsPm Underline where
toPm NoUnderline = [24]
fromPm = rec . filterPm sgrColor
where
- rec xs = case filter (`elem` ([4,24] :: [Int])) xs of
+ rec xs = case filter (`elem` ([4,24] :: [Word8])) xs of
[] -> Nothing
xs' -> case last xs' of
1 -> Just Underline
@@ -184,15 +186,15 @@ fromSGRPm SGRPm{..} = rec Nothing
-- that look like the (shorter) sequences we're searching.
-- E.g. we could find [1] (bold) in any extended color sequence.
-- TODO Can we combine this whole from*Pm with Scanner?
-filterPm :: (Pm -> Maybe Int) -> Pm -> Pm
+filterPm :: (Pm -> Maybe Word8) -> Pm -> Pm
filterPm f = rec []
where
rec ys xs@(xhead:xtail) = maybe (rec (ys ++ [xhead]) xtail)
- (rec ys . flip Prelude.drop xs)
+ (rec ys . flip genericDrop xs)
(f xs)
rec ys _ = ys
-sgrColor, sgrFColor, sgrBColor :: Pm -> Maybe Int
+sgrColor, sgrFColor, sgrBColor :: Pm -> Maybe Word8
sgrColor xs = sgrFColor xs <|> sgrBColor xs
@@ -248,7 +250,7 @@ render _ Empty y = y
renderSGR :: (Blessable a) => Pm -> a
renderSGR [] = mempty
renderSGR pm =
- ("\ESC["<>) . (<>"m") . Bless.intercalate ";" . map Bless.fromInt $ pm
+ ("\ESC["<>) . (<>"m") . Bless.intercalate ";" . map Bless.fromWord8 $ pm
stripSGR :: Blessings a -> Blessings a
@@ -300,4 +302,4 @@ instance Blessable a => Blessable (Blessings a) where
[t] -> t
(t:ts) -> t <> i <> Bless.intercalate i ts
- fromInt = Plain . Bless.fromInt
+ fromWord8 = Plain . Bless.fromWord8
diff --git a/src/Blessings/Internal.hs b/src/Blessings/Internal.hs
index c96a587..0ed5556 100644
--- a/src/Blessings/Internal.hs
+++ b/src/Blessings/Internal.hs
@@ -1,6 +1,7 @@
module Blessings.Internal where
import Data.String (IsString)
+import Data.Word (Word8)
class (IsString a, Monoid a) => Blessable a where
@@ -8,4 +9,4 @@ class (IsString a, Monoid a) => Blessable a where
drop :: Int -> a -> a
take :: Int -> a -> a
intercalate :: a -> [a] -> a
- fromInt :: Int -> a
+ fromWord8 :: Word8 -> a
diff --git a/src/Blessings/String.hs b/src/Blessings/String.hs
index c2c7273..005cd7b 100644
--- a/src/Blessings/String.hs
+++ b/src/Blessings/String.hs
@@ -15,4 +15,4 @@ instance Blessable String where
drop = L.drop
take = L.take
intercalate = L.intercalate
- fromInt = show
+ fromWord8 = show
diff --git a/src/Blessings/Text.hs b/src/Blessings/Text.hs
index 64d261b..1f82c22 100644
--- a/src/Blessings/Text.hs
+++ b/src/Blessings/Text.hs
@@ -15,4 +15,4 @@ instance Blessable Text where
drop = T.drop
take = T.take
intercalate = T.intercalate
- fromInt = T.pack . show
+ fromWord8 = T.pack . show
diff --git a/test/Spec.hs b/test/Spec.hs
new file mode 100644
index 0000000..298eb04
--- /dev/null
+++ b/test/Spec.hs
@@ -0,0 +1,25 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+import Test.QuickCheck
+import Test.Hspec
+import Blessings
+
+instance Arbitrary a => Arbitrary (Blessings a) where
+ arbitrary =
+ oneof
+ [ Plain <$> arbitrary
+ , pure Empty
+ , (<>) <$> arbitrary <*> arbitrary
+ , SGR <$> arbitrary <*> arbitrary
+ ]
+
+main :: IO ()
+main =
+ hspec $ do
+ describe "Blessings" $ do
+ it "obeys the Semigroup laws" $
+ property $ \(x :: Blessings String) y z ->
+ (x <> y) <> z == x <> (y <> z)
+
+ it "obeys the Monoid laws" $
+ property $ \(x :: Blessings String) ->
+ x <> mempty == x && x == mempty <> x