diff options
| -rw-r--r-- | blessings.cabal | 13 | ||||
| -rw-r--r-- | src/Blessings.hs | 26 | ||||
| -rw-r--r-- | src/Blessings/Internal.hs | 3 | ||||
| -rw-r--r-- | src/Blessings/String.hs | 2 | ||||
| -rw-r--r-- | src/Blessings/Text.hs | 2 | ||||
| -rw-r--r-- | test/Spec.hs | 25 |
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 |