diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,16 @@ +# Change Log + +## 1.2.0.0 - 2020-01-26 +### Added +- `/<>/` - Default inherit operator +### Changed +- Removed support for GHC < 7.10.0 +- Now supports latest (as of 2020-01) GHC versions + +## 1.1.0 - 2017-01-24 +### Changed +- Now supports a wider range of versions for `text`, `bytestring` and `base` + - Stackage LTS >= 2.0, GHC >= 7.8.4 + +## 1.0.0 - 2016-10-07 +### Initial release diff --git a/escape-artist.cabal b/escape-artist.cabal --- a/escape-artist.cabal +++ b/escape-artist.cabal @@ -1,5 +1,5 @@ name: escape-artist -version: 1.1.0 +version: 1.2.0.0 synopsis: ANSI Escape Sequence Text Decoration Made Easy description: A library for text decoration with ANSI escape sequences made easy. Decorate your terminal text expressively. @@ -36,9 +36,6 @@ toEscapable a = FgRed $ show a @ . - NOTE: For GHC < 7.10 you will also need to explicitly derive 'Typeable' for custom data types - implementing 'ToEscapable'. See the section Explicitly Derived Typeable in the documentation. - . Comprehensive Documentation . See comprehensive documentation with many examples here: @@ -50,10 +47,12 @@ license-file: LICENSE author: Ryan Daniels maintainer: rd.github@gmail.com -copyright: 2016 Ryan Daniels +copyright: 2016-2019 Ryan Daniels category: Text build-type: Simple -cabal-version: >= 1.10 +cabal-version: >= 1.22 +extra-source-files: + CHANGELOG.md library hs-source-dirs: src @@ -61,12 +60,12 @@ , Text.EscapeArtist.Internal , Text.EscapeArtist.Internal.Constants default-extensions: CPP, ExistentialQuantification, ExtendedDefaultRules, FlexibleInstances, NoMonomorphismRestriction - if impl(ghc < 7.10.0) - default-extensions: DeriveDataTypeable, StandaloneDeriving - build-depends: base >= 4.7.0.2 && < 5 + build-depends: base >= 4.8.0.0 && < 5 , bytestring >= 0.10.4.0 && < 0.11 , text >= 1.2.0.4 && < 1.3 - ghc-options: -Wall + if impl(ghc < 7.10.0) + build-depends: unsupported-ghc-version > 1 && < 1 + ghc-options: -Wall -Wno-type-defaults default-language: Haskell2010 test-suite escape-artist-spec-test @@ -75,31 +74,31 @@ other-modules: Text.EscapeArtistSpec , Text.EscapeArtistSpec.TestData main-is: Spec.hs - build-depends: base >= 4.7.0.2 && < 5 + build-depends: base >= 4.8.0.0 && < 5 , bytestring >= 0.10.4.0 && < 0.11 , escape-artist - , hspec >= 2.2.4 && < 2.3 + , hspec >= 2.2.4 && < 2.8 , silently >= 1.2.5 && < 1.3 , text >= 1.2.0.4 && < 1.3 - , QuickCheck >= 2.9.2 && < 2.10 + , QuickCheck >= 2.9.2 && < 2.14 + if impl(ghc < 7.10.0) + build-depends: unsupported-ghc-version > 1 && < 1 ghc-options: -threaded -rtsopts -with-rtsopts=-N default-extensions: CPP, ExistentialQuantification, ExtendedDefaultRules, FlexibleInstances, NoMonomorphismRestriction - if impl(ghc < 7.10.0) - default-extensions: DeriveDataTypeable, StandaloneDeriving default-language: Haskell2010 test-suite escape-artist-visual-test type: exitcode-stdio-1.0 hs-source-dirs: test main-is: VisualTest.hs - build-depends: base >= 4.7.0.2 && < 5 + if impl(ghc < 7.10.0) + build-depends: unsupported-ghc-version > 1 && < 1 + build-depends: base >= 4.8.0.0 && < 5 , bytestring >= 0.10.4.0 && < 0.11 , escape-artist , text >= 1.2.0.4 && < 1.3 ghc-options: -threaded -rtsopts -with-rtsopts=-N default-extensions: CPP, ExtendedDefaultRules, NoMonomorphismRestriction - if impl(ghc < 7.10.0) - default-extensions: DeriveDataTypeable, StandaloneDeriving default-language: Haskell2010 source-repository head diff --git a/src/Text/EscapeArtist.hs b/src/Text/EscapeArtist.hs --- a/src/Text/EscapeArtist.hs +++ b/src/Text/EscapeArtist.hs @@ -45,15 +45,11 @@ See the documentation on 'ToEscapable' below for a more advanced example. -For GHC < 7.10 you will also need to explicitly derive 'Data.Typeable.Typeable' for custom data types -implementing 'ToEscapable'. See the section __/Explicitly Derived Typeable/__ in the -. - Comprehensive documentation with many examples here: -} -module Text.EscapeArtist (Escapable(..), ToEscapable(..), putEscLn, putEsc, escToString, (^$)) where +module Text.EscapeArtist (Escapable(..), ToEscapable(..), putEscLn, putEsc, escToString, (^$), (/<>/)) where import Text.EscapeArtist.Internal hiding (Atom, Sum) diff --git a/src/Text/EscapeArtist/Internal.hs b/src/Text/EscapeArtist/Internal.hs --- a/src/Text/EscapeArtist/Internal.hs +++ b/src/Text/EscapeArtist/Internal.hs @@ -1,12 +1,7 @@ {-# OPTIONS_HADDOCK hide #-} -module Text.EscapeArtist.Internal (Escapable(..), ToEscapable(..), putEscLn, putEsc, escToString, (^$)) where - -#if ! MIN_VERSION_base(4,8,0) -import Data.Monoid (Monoid, mappend, mconcat, mempty) -#endif +module Text.EscapeArtist.Internal (Escapable(..), ToEscapable(..), putEscLn, putEsc, escToString, (^$), (/<>/)) where -import Control.Applicative ((<|>)) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as BSC import qualified Data.ByteString.Lazy as BSL @@ -75,10 +70,6 @@ | Sum [Escapable] | Atom String -#if ! MIN_VERSION_base(4,8,0) -deriving instance Typeable Escapable -#endif - instance Show Escapable where show (FgBlack a) = "FgBlack (" ++ show a ++ ")" show (FgRed a) = "FgRed (" ++ show a ++ ")" @@ -115,66 +106,46 @@ show (Sum a) = "Sum " ++ show a show (Atom a) = "Atom " ++ show a -tryCast :: forall a b. (Typeable a, Typeable b) => a -> (b -> String) -> Maybe String -tryCast a f = case cast a of - (Just s) -> Just $ f s - _ -> Nothing - -tryString, tryChar, tryBS, tryBSL, tryT, tryTL :: Typeable a => a -> Maybe String - -tryString a = tryCast a id -tryChar a = tryCast a (\b -> [b :: Char] ) -tryBS a = tryCast a (\b -> BSC.unpack b) -tryBSL a = tryCast a (\b -> BSLC.unpack b) -tryT a = tryCast a (\b -> T.unpack b) -tryTL a = tryCast a (\b -> TL.unpack b) - -toCompStr :: forall a. (Show a, Typeable a) => a -> String -toCompStr a = case options of - (Just s) -> s - _ -> show a - where options = tryString a - <|> tryChar a - <|> tryBS a - <|> tryBSL a - <|> tryT a - <|> tryTL a +extEq :: forall a b. (Eq a, Eq b, Typeable a, Typeable b) => a -> b -> Bool +extEq x y = case cast x of + Nothing -> False + Just x' -> x' == y instance Eq Escapable where - (FgBlack a) == (FgBlack b) = toCompStr a == toCompStr b - (FgRed a) == (FgRed b) = toCompStr a == toCompStr b - (FgGreen a) == (FgGreen b) = toCompStr a == toCompStr b - (FgYellow a) == (FgYellow b) = toCompStr a == toCompStr b - (FgBlue a) == (FgBlue b) = toCompStr a == toCompStr b - (FgMagenta a) == (FgMagenta b) = toCompStr a == toCompStr b - (FgCyan a) == (FgCyan b) = toCompStr a == toCompStr b - (FgWhite a) == (FgWhite b) = toCompStr a == toCompStr b + (FgBlack a) == (FgBlack b) = extEq a b + (FgRed a) == (FgRed b) = extEq a b + (FgGreen a) == (FgGreen b) = extEq a b + (FgYellow a) == (FgYellow b) = extEq a b + (FgBlue a) == (FgBlue b) = extEq a b + (FgMagenta a) == (FgMagenta b) = extEq a b + (FgCyan a) == (FgCyan b) = extEq a b + (FgWhite a) == (FgWhite b) = extEq a b - (BgBlack a) == (BgBlack b) = toCompStr a == toCompStr b - (BgRed a) == (BgRed b) = toCompStr a == toCompStr b - (BgGreen a) == (BgGreen b) = toCompStr a == toCompStr b - (BgYellow a) == (BgYellow b) = toCompStr a == toCompStr b - (BgBlue a) == (BgBlue b) = toCompStr a == toCompStr b - (BgMagenta a) == (BgMagenta b) = toCompStr a == toCompStr b - (BgCyan a) == (BgCyan b) = toCompStr a == toCompStr b - (BgWhite a) == (BgWhite b) = toCompStr a == toCompStr b + (BgBlack a) == (BgBlack b) = extEq a b + (BgRed a) == (BgRed b) = extEq a b + (BgGreen a) == (BgGreen b) = extEq a b + (BgYellow a) == (BgYellow b) = extEq a b + (BgBlue a) == (BgBlue b) = extEq a b + (BgMagenta a) == (BgMagenta b) = extEq a b + (BgCyan a) == (BgCyan b) = extEq a b + (BgWhite a) == (BgWhite b) = extEq a b - (FgDefault a) == (FgDefault b) = toCompStr a == toCompStr b - (BgDefault a) == (BgDefault b) = toCompStr a == toCompStr b - (Inherit a) == (Inherit b) = toCompStr a == toCompStr b - (Default a) == (Default b) = toCompStr a == toCompStr b + (FgDefault a) == (FgDefault b) = extEq a b + (BgDefault a) == (BgDefault b) = extEq a b + (Inherit a) == (Inherit b) = extEq a b + (Default a) == (Default b) = extEq a b - (Blink a) == (Blink b) = toCompStr a == toCompStr b - (BlinkOff a) == (BlinkOff b) = toCompStr a == toCompStr b - (Bright a) == (Bright b) = toCompStr a == toCompStr b - (BrightOff a) == (BrightOff b) = toCompStr a == toCompStr b - (Underline a) == (Underline b) = toCompStr a == toCompStr b - (UnderlineOff a) == (UnderlineOff b) = toCompStr a == toCompStr b - (Inverse a) == (Inverse b) = toCompStr a == toCompStr b - (InverseOff a) == (InverseOff b) = toCompStr a == toCompStr b + (Blink a) == (Blink b) = extEq a b + (BlinkOff a) == (BlinkOff b) = extEq a b + (Bright a) == (Bright b) = extEq a b + (BrightOff a) == (BrightOff b) = extEq a b + (Underline a) == (Underline b) = extEq a b + (UnderlineOff a) == (UnderlineOff b) = extEq a b + (Inverse a) == (Inverse b) = extEq a b + (InverseOff a) == (InverseOff b) = extEq a b - (Sum a) == (Sum b) = toCompStr a == toCompStr b - (Atom a) == (Atom b) = toCompStr a == toCompStr b + (Sum a) == (Sum b) = extEq a b + (Atom a) == (Atom b) = extEq a b _ == _ = False {-| @@ -230,13 +201,9 @@ putEscLn mkStatusOK @ -/Note:/ For GHC < 7.10 you will also need to explicitly derive 'Data.Typeable.Typeable' for custom data types -implementing 'ToEscapable'. See the section __/Explicitly Derived Typeable/__ in the -. - <> -} -class (Show a, Typeable a) => ToEscapable a where +class (Show a, Typeable a, Eq a) => ToEscapable a where -- | Convert the given type to an Escapable toEscapable :: a -> Escapable @@ -343,14 +310,51 @@ escToStrEncl pref suff (Sum a) = concatMap (recur pref suff) a escToStrEncl pref suff (Atom a) = concat [pref, a, suff] +#if MIN_VERSION_base(4,11,0) +instance Semigroup Escapable where + (<>) (Sum []) b = b + (<>) a (Sum []) = a + (<>) (Sum as) (Sum bs) = Sum $ as ++ bs + (<>) (Sum as) b = Sum $ as ++ [b] + (<>) a (Sum bs) = Sum $ a : bs + (<>) a b = Sum [a, b] +#endif + instance Monoid Escapable where mempty = Sum [] +#if ! MIN_VERSION_base(4,11,0) mappend (Sum []) b = b mappend a (Sum []) = a mappend (Sum as) (Sum bs) = Sum $ mconcat [as, bs ] mappend (Sum as) b = Sum $ mconcat [as, [b]] mappend a (Sum bs) = Sum $ mconcat [[a], bs ] mappend a b = Sum [a, b] +#endif + +defInherit :: forall a. (ToEscapable a, Typeable a) => a -> Escapable +defInherit a = case cast a of + Nothing -> Inherit a + Just a' -> a' + +infixr 6 /<>/ + +-- | The same as '<>', except that any argument that is not of type 'Escapable' will be wrapped in 'Inherit' +-- before being combined with the other argument via '<>'. For example: +-- +-- @ +-- BgRed $ Inherit 4 <> BgCyan " " <> Inherit 5 <> BgGreen " " <> Inherit 9 +-- @ +-- +-- can simply be written as: +-- +-- @ +-- BgRed $ 4 \/<>\/ BgCyan " " \/<>\/ 5 \/<>\/ BgGreen " " \/<>\/ 9 +-- @ +-- +-- In this example, 'Inherit' can be omitted. +-- +(/<>/) :: forall a b. (ToEscapable a, ToEscapable b) => a -> b -> Escapable +(/<>/) a b = defInherit a <> defInherit b -- | Convert any instance of 'ToEscapable' to a 'String' and output it to the terminal followed by a newline putEscLn :: (ToEscapable a) => a -> IO () diff --git a/test/Text/EscapeArtistSpec.hs b/test/Text/EscapeArtistSpec.hs --- a/test/Text/EscapeArtistSpec.hs +++ b/test/Text/EscapeArtistSpec.hs @@ -49,10 +49,16 @@ it "gets processed before <>" $ do (FgRed ^$ Underline 5 <> FgBlue 3 <> FgYellow 9) `shouldBe` (Sum [FgRed (Underline 5), FgBlue 3, FgYellow 9]) + describe "/<>/" $ do + it "produces the same result as <>" $ do + (FgRed "A" /<>/ FgBlue 10) `shouldBe` (FgRed "A" <> FgBlue 10) + it "wraps non-Escapable values in Inherit" $ do + (5 /<>/ FgRed "A" /<>/ 'C') `shouldBe` (Sum [Inherit 5, FgRed "A", Inherit 'C']) + describe "Eq Escapable" $ do - it "considers escapables equal when constructors and strings of contained values are same" $ forM_ eqTestCases $ do + it "considers escapables equal when constructors and contained values are same" $ forM_ eqTestCases $ do \(a, b) -> a `shouldBe` b - it "considers escapables not equal when constructors or strings of contained values are not same" $ forM_ notEqTestCases $ do + it "considers escapables not equal when constructors or contained values are not same" $ forM_ notEqTestCases $ do \(a, b) -> a `shouldNotBe` b describe "Monoid Escapable" $ do diff --git a/test/Text/EscapeArtistSpec/TestData.hs b/test/Text/EscapeArtistSpec/TestData.hs --- a/test/Text/EscapeArtistSpec/TestData.hs +++ b/test/Text/EscapeArtistSpec/TestData.hs @@ -120,7 +120,7 @@ -- Other types of ToEscapable tests -data SomeToEscapable = A deriving (Show) +data SomeToEscapable = A deriving (Eq, Show) #if ! MIN_VERSION_base(4,8,0) deriving instance Typeable SomeToEscapable @@ -246,7 +246,7 @@ ++ fnConsSameValSame 6 -- This case hadles different values which are the -- same when strings - ++ zip (fnCVRep (3.5 :: Float)) (fnCVRep (3.5 :: Double)) + ++ zip (fnCVRep (3.5 :: Float)) (fnCVRep (3.5 :: Float)) ++ [(Atom "6", Atom "6")] ++ [(Sum [FgRed 6], Sum [FgRed 6])]