symantic-document 1.4.0.20190710 → 1.5.0.20190711

raw patch · 5 files changed

+78/−239 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Symantic/Document.hs +0/−2
• Symantic/Document/AnsiText.hs +0/−232
• Symantic/Document/Plain.hs +70/−0
• symantic-document.cabal +1/−2
• test/HUnit.hs +7/−3

@@ -1,8 +1,6 @@ module Symantic.Document  ( module Symantic.Document.API  , module Symantic.Document.Plain- , module Symantic.Document.AnsiText  ) where import Symantic.Document.API import Symantic.Document.Plain-import Symantic.Document.AnsiText

@@ -1,232 +0,0 @@-{-# LANGUAGE UndecidableInstances #-}-module Symantic.Document.AnsiText where--import Control.Applicative (Applicative(..), liftA2)-import Control.Monad (Monad(..), sequence)-import Control.Monad.Trans.Reader-import Data.Bool-import Data.Char (Char)-import Data.Function (($), (.), id)-import Data.Functor ((<$>))-import Data.Functor.Identity (Identity(..))-import Data.Monoid (Monoid(..))-import Data.Semigroup (Semigroup(..))-import Data.String (String, IsString(..))-import Data.Text (Text)-import System.Console.ANSI-import Text.Show (Show(..))-import qualified Data.List as List-import qualified Data.Text.Lazy as TL--import Symantic.Document.API---- * Type 'AnsiText'-newtype AnsiText d = AnsiText { unAnsiText :: Reader [SGR] d }-instance Show d => Show (AnsiText d) where-	show (AnsiText d) = show $ runReader d []--ansiText :: AnsiText d -> AnsiText d-ansiText = id--runAnsiText :: AnsiText d -> d-runAnsiText (AnsiText d) = (`runReader` []) d--instance From Char d => From Char (AnsiText d) where-	from = AnsiText . return . from-instance From String d => From String (AnsiText d) where-	from = AnsiText . return . from-instance From Text d => From Text (AnsiText d) where-	from = AnsiText . return . from-instance From TL.Text d => From TL.Text (AnsiText d) where-	from = AnsiText . return . from-instance From s (AnsiText d) => From (Line s) (AnsiText d) where-	from = from . unLine-instance From s (AnsiText d) => From (Word s) (AnsiText d) where-	from = from . unWord-instance From String d => IsString (AnsiText d) where-	fromString = from-instance Semigroup d => Semigroup (AnsiText d) where-	AnsiText x <> AnsiText y = AnsiText $ liftA2 (<>) x y-instance Monoid d => Monoid (AnsiText d) where-	mempty = AnsiText (return mempty)-	mappend = (<>)-instance Lengthable d => Lengthable (AnsiText d) where-	-- NOTE: AnsiText's Reader can be run with an empty value-	-- because all 'SGR' are ignored anyway.-	width (AnsiText ds) = width $ runReader ds mempty-	nullWidth (AnsiText ds) = nullWidth $ runReader ds mempty-instance Spaceable d => Spaceable (AnsiText d) where-	newline = AnsiText $ return newline-	space   = AnsiText $ return space-	spaces  = AnsiText . return . spaces-instance (Semigroup d, From [SGR] d) => Colorable16 (AnsiText d) where-	reverse     = ansiTextSGR $ SetSwapForegroundBackground True-	black       = ansiTextSGR $ SetColor Foreground Dull  Black-	red         = ansiTextSGR $ SetColor Foreground Dull  Red-	green       = ansiTextSGR $ SetColor Foreground Dull  Green-	yellow      = ansiTextSGR $ SetColor Foreground Dull  Yellow-	blue        = ansiTextSGR $ SetColor Foreground Dull  Blue-	magenta     = ansiTextSGR $ SetColor Foreground Dull  Magenta-	cyan        = ansiTextSGR $ SetColor Foreground Dull  Cyan-	white       = ansiTextSGR $ SetColor Foreground Dull  White-	blacker     = ansiTextSGR $ SetColor Foreground Vivid Black-	redder      = ansiTextSGR $ SetColor Foreground Vivid Red-	greener     = ansiTextSGR $ SetColor Foreground Vivid Green-	yellower    = ansiTextSGR $ SetColor Foreground Vivid Yellow-	bluer       = ansiTextSGR $ SetColor Foreground Vivid Blue-	magentaer   = ansiTextSGR $ SetColor Foreground Vivid Magenta-	cyaner      = ansiTextSGR $ SetColor Foreground Vivid Cyan-	whiter      = ansiTextSGR $ SetColor Foreground Vivid White-	onBlack     = ansiTextSGR $ SetColor Background Dull  Black-	onRed       = ansiTextSGR $ SetColor Background Dull  Red-	onGreen     = ansiTextSGR $ SetColor Background Dull  Green-	onYellow    = ansiTextSGR $ SetColor Background Dull  Yellow-	onBlue      = ansiTextSGR $ SetColor Background Dull  Blue-	onMagenta   = ansiTextSGR $ SetColor Background Dull  Magenta-	onCyan      = ansiTextSGR $ SetColor Background Dull  Cyan-	onWhite     = ansiTextSGR $ SetColor Background Dull  White-	onBlacker   = ansiTextSGR $ SetColor Background Vivid Black-	onRedder    = ansiTextSGR $ SetColor Background Vivid Red-	onGreener   = ansiTextSGR $ SetColor Background Vivid Green-	onYellower  = ansiTextSGR $ SetColor Background Vivid Yellow-	onBluer     = ansiTextSGR $ SetColor Background Vivid Blue-	onMagentaer = ansiTextSGR $ SetColor Background Vivid Magenta-	onCyaner    = ansiTextSGR $ SetColor Background Vivid Cyan-	onWhiter    = ansiTextSGR $ SetColor Background Vivid White-instance (Semigroup d, From [SGR] d) => Decorable (AnsiText d) where-	bold      = ansiTextSGR $ SetConsoleIntensity BoldIntensity-	underline = ansiTextSGR $ SetUnderlining SingleUnderline-	italic    = ansiTextSGR $ SetItalicized True-instance Justifiable d => Justifiable (AnsiText d) where-	justify (AnsiText d) = AnsiText $ justify <$> d-instance Indentable d => Indentable (AnsiText d) where-	align (AnsiText d) = AnsiText $ align <$> d-	setIndent p i (AnsiText d) = AnsiText $ ReaderT $ \inh ->-		Identity $-		setIndent-		 (unAnsiText p`runReader`inh) i-		 (runReader d inh)-	incrIndent p i (AnsiText d) = AnsiText $ ReaderT $ \inh ->-		Identity $-		incrIndent-		 (unAnsiText p`runReader`inh) i-		 (runReader d inh)-	fill w (AnsiText d)        = AnsiText $ fill w <$> d-	fillOrBreak w (AnsiText d) = AnsiText $ fillOrBreak w <$> d-instance Listable d => Listable (AnsiText d) where-	ul ds = AnsiText $ (ul <$>) $ sequence $ unAnsiText <$> ds-	ol ds = AnsiText $ (ol <$>) $ sequence $ unAnsiText <$> ds-instance Wrappable d => Wrappable (AnsiText d) where-	setWidth w (AnsiText d) = AnsiText $ setWidth w <$> d-	breakpoint = AnsiText $ return breakpoint-	breakspace = AnsiText $ return breakspace-	endline    = AnsiText $ return endline-	breakalt (AnsiText x) (AnsiText y) = AnsiText $ liftA2 breakalt x y--ansiTextSGR ::- Semigroup d => From [SGR] d =>- SGR -> AnsiText d -> AnsiText d-ansiTextSGR newSGR (AnsiText d) = AnsiText $ do-	oldSGR <- ask-	(\m -> from [newSGR] <> m <> from (Reset:List.reverse oldSGR))-	 <$> local (newSGR :) d---- * Type 'PlainText'--- | Drop 'Colorable16' and 'Decorable'.-newtype PlainText d = PlainText { unPlainText :: d }- deriving (Show)--plainText :: PlainText d -> PlainText d-plainText = id--runPlainText :: PlainText d -> d-runPlainText (PlainText d) = d--instance From Char d => From Char (PlainText d) where-	from = PlainText . from-instance From String d => From String (PlainText d) where-	from = PlainText . from-instance From Text d => From Text (PlainText d) where-	from = PlainText . from-instance From TL.Text d => From TL.Text (PlainText d) where-	from = PlainText . from-instance From s (PlainText d) => From (Line s) (PlainText d) where-	from = from . unLine-instance From s (PlainText d) => From (Word s) (PlainText d) where-	from = from . unWord-instance From String d => IsString (PlainText d) where-	fromString = from-instance Semigroup d => Semigroup (PlainText d) where-	PlainText x <> PlainText y = PlainText $ (<>) x y-instance Monoid d => Monoid (PlainText d) where-	mempty = PlainText mempty-	mappend = (<>)-instance Lengthable d => Lengthable (PlainText d) where-	-- NOTE: PlainText's Reader can be run with an empty value-	-- because all 'SGR' are ignored anyway.-	width (PlainText ds) = width ds-	nullWidth (PlainText ds) = nullWidth ds-instance Spaceable d => Spaceable (PlainText d) where-	newline = PlainText $ newline-	space   = PlainText $ space-	spaces  = PlainText . spaces-instance Semigroup d => Colorable16 (PlainText d) where-	reverse     = plainTextSGR-	black       = plainTextSGR-	red         = plainTextSGR-	green       = plainTextSGR-	yellow      = plainTextSGR-	blue        = plainTextSGR-	magenta     = plainTextSGR-	cyan        = plainTextSGR-	white       = plainTextSGR-	blacker     = plainTextSGR-	redder      = plainTextSGR-	greener     = plainTextSGR-	yellower    = plainTextSGR-	bluer       = plainTextSGR-	magentaer   = plainTextSGR-	cyaner      = plainTextSGR-	whiter      = plainTextSGR-	onBlack     = plainTextSGR-	onRed       = plainTextSGR-	onGreen     = plainTextSGR-	onYellow    = plainTextSGR-	onBlue      = plainTextSGR-	onMagenta   = plainTextSGR-	onCyan      = plainTextSGR-	onWhite     = plainTextSGR-	onBlacker   = plainTextSGR-	onRedder    = plainTextSGR-	onGreener   = plainTextSGR-	onYellower  = plainTextSGR-	onBluer     = plainTextSGR-	onMagentaer = plainTextSGR-	onCyaner    = plainTextSGR-	onWhiter    = plainTextSGR-instance Semigroup d => Decorable (PlainText d) where-	bold      = plainTextSGR-	underline = plainTextSGR-	italic    = plainTextSGR-instance Justifiable d => Justifiable (PlainText d) where-	justify (PlainText d) = PlainText $ justify d-instance Indentable d => Indentable (PlainText d) where-	align (PlainText d)          = PlainText $ align d-	setIndent  p i (PlainText d) = PlainText $ setIndent  (runPlainText p) i d-	incrIndent p i (PlainText d) = PlainText $ incrIndent (runPlainText p) i d-	fill w (PlainText d)         = PlainText $ fill w d-	fillOrBreak w (PlainText d)  = PlainText $ fillOrBreak w d-instance Listable d => Listable (PlainText d) where-	ul ds = PlainText $ ul $ unPlainText <$> ds-	ol ds = PlainText $ ol $ unPlainText <$> ds-instance Wrappable d => Wrappable (PlainText d) where-	setWidth w (PlainText d) = PlainText $ setWidth w d-	breakpoint = PlainText breakpoint-	breakspace = PlainText breakspace-	endline    = PlainText endline-	breakalt (PlainText x) (PlainText y) = PlainText $ breakalt x y--plainTextSGR ::- Semigroup d =>- PlainText d -> PlainText d-plainTextSGR (PlainText d) = PlainText d

@@ -84,6 +84,7 @@  , plainInh_justify   :: !Bool  , plainInh_indent    :: !Indent  , plainInh_indenting :: !(Plain d)+ , plainInh_sgr       :: ![SGR]  }  defPlainInh :: Spaceable d => PlainInh d@@ -92,6 +93,7 @@  , plainInh_justify   = False  , plainInh_indent    = 0  , plainInh_indenting = mempty+ , plainInh_sgr       = []  }  -- ** Type 'PlainFit'@@ -451,6 +453,7 @@ 		then k (id, st {plainState_buffer = PlainChunk_Ignored (from sgr) : plainState_buffer st}) 		else k ((from sgr <>), st) +-- * Justifying justifyLinePlain ::  Spaceable d =>  PlainInh d -> PlainState d -> d@@ -555,3 +558,70 @@ 		 _ -> runPlainChunk w <> go ws lls 	go (w:ws) [] = runPlainChunk w <> go ws [] 	go [] _ls = mempty++-- * Escaping+instance (Semigroup d, From [SGR] d) => Colorable16 (Plain d) where+	reverse     = plainSGR $ SetSwapForegroundBackground True+	black       = plainSGR $ SetColor Foreground Dull  Black+	red         = plainSGR $ SetColor Foreground Dull  Red+	green       = plainSGR $ SetColor Foreground Dull  Green+	yellow      = plainSGR $ SetColor Foreground Dull  Yellow+	blue        = plainSGR $ SetColor Foreground Dull  Blue+	magenta     = plainSGR $ SetColor Foreground Dull  Magenta+	cyan        = plainSGR $ SetColor Foreground Dull  Cyan+	white       = plainSGR $ SetColor Foreground Dull  White+	blacker     = plainSGR $ SetColor Foreground Vivid Black+	redder      = plainSGR $ SetColor Foreground Vivid Red+	greener     = plainSGR $ SetColor Foreground Vivid Green+	yellower    = plainSGR $ SetColor Foreground Vivid Yellow+	bluer       = plainSGR $ SetColor Foreground Vivid Blue+	magentaer   = plainSGR $ SetColor Foreground Vivid Magenta+	cyaner      = plainSGR $ SetColor Foreground Vivid Cyan+	whiter      = plainSGR $ SetColor Foreground Vivid White+	onBlack     = plainSGR $ SetColor Background Dull  Black+	onRed       = plainSGR $ SetColor Background Dull  Red+	onGreen     = plainSGR $ SetColor Background Dull  Green+	onYellow    = plainSGR $ SetColor Background Dull  Yellow+	onBlue      = plainSGR $ SetColor Background Dull  Blue+	onMagenta   = plainSGR $ SetColor Background Dull  Magenta+	onCyan      = plainSGR $ SetColor Background Dull  Cyan+	onWhite     = plainSGR $ SetColor Background Dull  White+	onBlacker   = plainSGR $ SetColor Background Vivid Black+	onRedder    = plainSGR $ SetColor Background Vivid Red+	onGreener   = plainSGR $ SetColor Background Vivid Green+	onYellower  = plainSGR $ SetColor Background Vivid Yellow+	onBluer     = plainSGR $ SetColor Background Vivid Blue+	onMagentaer = plainSGR $ SetColor Background Vivid Magenta+	onCyaner    = plainSGR $ SetColor Background Vivid Cyan+	onWhiter    = plainSGR $ SetColor Background Vivid White+instance (Semigroup d, From [SGR] d) => Decorable (Plain d) where+	bold      = plainSGR $ SetConsoleIntensity BoldIntensity+	underline = plainSGR $ SetUnderlining SingleUnderline+	italic    = plainSGR $ SetItalicized True++plainSGR ::+ Semigroup d =>+ From [SGR] d =>+ SGR -> Plain d -> Plain d+plainSGR newSGR p = before <> middle <> after+	where+	before = Plain $ \inh st k ->+		let d = from [newSGR] in+		if plainInh_justify inh+		then k (id, st+		 { plainState_buffer =+			PlainChunk_Ignored d :+			plainState_buffer st+		 })+		else k ((d <>), st)+	middle = Plain $ \inh ->+		unPlain p inh{plainInh_sgr=newSGR:plainInh_sgr inh}+	after = Plain $ \inh st k ->+		let d = from $ Reset : List.reverse (plainInh_sgr inh) in+		if plainInh_justify inh+		then k (id, st+		 { plainState_buffer =+			PlainChunk_Ignored d :+			plainState_buffer st+		 })+		else k ((d <>), st)

@@ -2,7 +2,7 @@ -- PVP:  +-+------- breaking API changes --       | | +----- non-breaking API additions --       | | | +--- code changes with no API change-version: 1.4.0.20190710+version: 1.5.0.20190711 category: Text synopsis: Document symantics. description: Symantics for generating documents.@@ -30,7 +30,6 @@   exposed-modules:     Symantic.Document     Symantic.Document.API-    Symantic.Document.AnsiText     Symantic.Document.Plain   default-language: Haskell2010   default-extensions:

@@ -19,7 +19,6 @@  import Symantic.Document.API import Symantic.Document.Plain-import Symantic.Document.AnsiText  -- * Tests hunits :: TestTree@@ -191,6 +190,11 @@  , 10 `maxWidth` spaces 2<>align(breakalt "fits" "over"<>newline<>"12345678901")    ==> "  fits\n\        \  12345678901"+ -- handle escaping correctly over custom indenting+ , 10 `maxWidth` setIndent (blue "X") 1 (red ("12"<>green "4\n5" <> "6"))+   ==> "\ESC[31m12\ESC[32m4\n\ESC[34mX\ESC[0;31;32m5\ESC[0;31m6\ESC[0m"+ , 10 `maxWidth` setIndent (blue "X") 1 (justify (red ("1 2 3 4"<>green " 5 6 " <> "7 ") <> "8"))+   ==> "\ESC[31m1 2  3 4\ESC[32m 5\n\ESC[34mX\ESC[0;31;32m6 \ESC[0;31m7 \ESC[0m8"  -- breakspace backtracking is bounded by the removable indentation  -- (hence it can actually wrap a few words in reasonable time).  , 80 `maxWidth`@@ -300,9 +304,9 @@   \amet, venenatis ornare, ultrices ut, nisi."                                         ] 	where-	(==>) :: IsString d => d ~ String => AnsiText (Plain d) -> d -> Assertion; infix 0 ==>+	(==>) :: IsString d => d ~ String => Plain d -> d -> Assertion; infix 0 ==> 	p ==> exp = got @?= exp-		where got = runPlain $ runAnsiText p+		where got = runPlain p  testList :: String -> [Assertion] -> TestTree testList n as = testGroup n $ List.zipWith testCase (show <$> [1::Int ..]) as