{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE UndecidableInstances #-}
module Symantic.Document.Lang where

import Control.Applicative (Applicative(..))
import Data.Bool
import Data.Char (Char)
import Data.Eq (Eq(..))
import Data.Foldable (Foldable)
import Data.Function ((.), ($), id, const)
import Data.Functor (Functor(..), (<$>))
import Data.Int (Int)
import Data.Kind (Type)
import Data.Maybe (Maybe(..))
import Data.Monoid (Monoid(..))
import Data.Ord (Ord(..))
import Data.Semigroup (Semigroup(..))
import Data.String (String, IsString(..))
import Data.Text (Text)
import Data.Traversable (Traversable)
import Numeric.Natural (Natural)
import Prelude (Integer, fromIntegral, pred)
import Text.Show (Show(..))
import qualified Data.Foldable as Fold
import qualified Data.List as List
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified System.Console.ANSI as ANSI

-- * Helper types
type Column = Natural
type Indent = Column
type Width = Natural
type SGR = ANSI.SGR

-- ** Type 'Line'
newtype Line d = Line d
 deriving (Line d -> Line d -> Bool
(Line d -> Line d -> Bool)
-> (Line d -> Line d -> Bool) -> Eq (Line d)
forall d. Eq d => Line d -> Line d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Line d -> Line d -> Bool
$c/= :: forall d. Eq d => Line d -> Line d -> Bool
== :: Line d -> Line d -> Bool
$c== :: forall d. Eq d => Line d -> Line d -> Bool
Eq,Int -> Line d -> ShowS
[Line d] -> ShowS
Line d -> String
(Int -> Line d -> ShowS)
-> (Line d -> String) -> ([Line d] -> ShowS) -> Show (Line d)
forall d. Show d => Int -> Line d -> ShowS
forall d. Show d => [Line d] -> ShowS
forall d. Show d => Line d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Line d] -> ShowS
$cshowList :: forall d. Show d => [Line d] -> ShowS
show :: Line d -> String
$cshow :: forall d. Show d => Line d -> String
showsPrec :: Int -> Line d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Line d -> ShowS
Show)
unLine :: Line d -> d
unLine :: Line d -> d
unLine (Line d
d) = d
d

-- ** Type 'Word'
newtype Word d = Word d
 deriving (Word d -> Word d -> Bool
(Word d -> Word d -> Bool)
-> (Word d -> Word d -> Bool) -> Eq (Word d)
forall d. Eq d => Word d -> Word d -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Word d -> Word d -> Bool
$c/= :: forall d. Eq d => Word d -> Word d -> Bool
== :: Word d -> Word d -> Bool
$c== :: forall d. Eq d => Word d -> Word d -> Bool
Eq,Int -> Word d -> ShowS
[Word d] -> ShowS
Word d -> String
(Int -> Word d -> ShowS)
-> (Word d -> String) -> ([Word d] -> ShowS) -> Show (Word d)
forall d. Show d => Int -> Word d -> ShowS
forall d. Show d => [Word d] -> ShowS
forall d. Show d => Word d -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Word d] -> ShowS
$cshowList :: forall d. Show d => [Word d] -> ShowS
show :: Word d -> String
$cshow :: forall d. Show d => Word d -> String
showsPrec :: Int -> Word d -> ShowS
$cshowsPrec :: forall d. Show d => Int -> Word d -> ShowS
Show,b -> Word d -> Word d
NonEmpty (Word d) -> Word d
Word d -> Word d -> Word d
(Word d -> Word d -> Word d)
-> (NonEmpty (Word d) -> Word d)
-> (forall b. Integral b => b -> Word d -> Word d)
-> Semigroup (Word d)
forall b. Integral b => b -> Word d -> Word d
forall d. Semigroup d => NonEmpty (Word d) -> Word d
forall d. Semigroup d => Word d -> Word d -> Word d
forall d b. (Semigroup d, Integral b) => b -> Word d -> Word d
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Word d -> Word d
$cstimes :: forall d b. (Semigroup d, Integral b) => b -> Word d -> Word d
sconcat :: NonEmpty (Word d) -> Word d
$csconcat :: forall d. Semigroup d => NonEmpty (Word d) -> Word d
<> :: Word d -> Word d -> Word d
$c<> :: forall d. Semigroup d => Word d -> Word d -> Word d
Semigroup)
unWord :: Word d -> d
unWord :: Word d -> d
unWord (Word d
d) = d
d
instance From [SGR] d => From [SGR] (Word d) where
	from :: [SGR] -> Word d
from = d -> Word d
forall d. d -> Word d
Word (d -> Word d) -> ([SGR] -> d) -> [SGR] -> Word d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> d
forall a d. From a d => a -> d
from

-- * Class 'From'
class From a d where
	from :: a -> d
	default from :: From String d => Show a => a -> d
	from = String -> d
forall a d. From a d => a -> d
from (String -> d) -> (a -> String) -> a -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
instance From (Line String) d => From Int d where
	from :: Int -> d
from = Line String -> d
forall a d. From a d => a -> d
from (Line String -> d) -> (Int -> Line String) -> Int -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Line String
forall d. d -> Line d
Line (String -> Line String) -> (Int -> String) -> Int -> Line String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show
instance From (Line String) d => From Integer d where
	from :: Integer -> d
from = Line String -> d
forall a d. From a d => a -> d
from (Line String -> d) -> (Integer -> Line String) -> Integer -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Line String
forall d. d -> Line d
Line (String -> Line String)
-> (Integer -> String) -> Integer -> Line String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> String
forall a. Show a => a -> String
show
instance From (Line String) d => From Natural d where
	from :: Natural -> d
from = Line String -> d
forall a d. From a d => a -> d
from (Line String -> d) -> (Natural -> Line String) -> Natural -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Line String
forall d. d -> Line d
Line (String -> Line String)
-> (Natural -> String) -> Natural -> Line String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> String
forall a. Show a => a -> String
show

-- String
instance From Char String where
	from :: Char -> String
from = Char -> String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
instance From String String where
	from :: ShowS
from = ShowS
forall a. a -> a
id
instance From Text String where
	from :: Text -> String
from = Text -> String
Text.unpack
instance From TL.Text String where
	from :: Text -> String
from = Text -> String
TL.unpack
instance From d String => From (Line d) String where
	from :: Line d -> String
from = d -> String
forall a d. From a d => a -> d
from (d -> String) -> (Line d -> d) -> Line d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line d -> d
forall d. Line d -> d
unLine
instance From d String => From (Word d) String where
	from :: Word d -> String
from = d -> String
forall a d. From a d => a -> d
from (d -> String) -> (Word d -> d) -> Word d -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word d -> d
forall d. Word d -> d
unWord
instance From [SGR] String where
	from :: [SGR] -> String
from = [SGR] -> String
ANSI.setSGRCode

-- Text
instance From Char Text where
	from :: Char -> Text
from = Char -> Text
Text.singleton
instance From String Text where
	from :: String -> Text
from = String -> Text
Text.pack
instance From Text Text where
	from :: Text -> Text
from = Text -> Text
forall a. a -> a
id
instance From TL.Text Text where
	from :: Text -> Text
from = Text -> Text
TL.toStrict
instance From d Text => From (Line d) Text where
	from :: Line d -> Text
from = d -> Text
forall a d. From a d => a -> d
from (d -> Text) -> (Line d -> d) -> Line d -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line d -> d
forall d. Line d -> d
unLine
instance From d Text => From (Word d) Text where
	from :: Word d -> Text
from = d -> Text
forall a d. From a d => a -> d
from (d -> Text) -> (Word d -> d) -> Word d -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word d -> d
forall d. Word d -> d
unWord
instance From [SGR] Text where
	from :: [SGR] -> Text
from = String -> Text
forall a d. From a d => a -> d
from (String -> Text) -> ([SGR] -> String) -> [SGR] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> String
ANSI.setSGRCode

-- TL.Text
instance From Char TL.Text where
	from :: Char -> Text
from = Char -> Text
TL.singleton
instance From String TL.Text where
	from :: String -> Text
from = String -> Text
TL.pack
instance From Text TL.Text where
	from :: Text -> Text
from = Text -> Text
TL.fromStrict
instance From TL.Text TL.Text where
	from :: Text -> Text
from = Text -> Text
forall a. a -> a
id
instance From d TL.Text => From (Line d) TL.Text where
	from :: Line d -> Text
from = d -> Text
forall a d. From a d => a -> d
from (d -> Text) -> (Line d -> d) -> Line d -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line d -> d
forall d. Line d -> d
unLine
instance From d TL.Text => From (Word d) TL.Text where
	from :: Word d -> Text
from = d -> Text
forall a d. From a d => a -> d
from (d -> Text) -> (Word d -> d) -> Word d -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word d -> d
forall d. Word d -> d
unWord
instance From [SGR] TL.Text where
	from :: [SGR] -> Text
from = String -> Text
forall a d. From a d => a -> d
from (String -> Text) -> ([SGR] -> String) -> [SGR] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> String
ANSI.setSGRCode

-- TLB.Builder
instance From Char TLB.Builder where
	from :: Char -> Builder
from = Char -> Builder
TLB.singleton
instance From String TLB.Builder where
	from :: String -> Builder
from = String -> Builder
forall a. IsString a => String -> a
fromString
instance From Text TLB.Builder where
	from :: Text -> Builder
from = Text -> Builder
TLB.fromText
instance From TL.Text TLB.Builder where
	from :: Text -> Builder
from = Text -> Builder
TLB.fromLazyText
instance From TLB.Builder TLB.Builder where
	from :: Builder -> Builder
from = Builder -> Builder
forall a. a -> a
id
instance From d TLB.Builder => From (Line d) TLB.Builder where
	from :: Line d -> Builder
from = d -> Builder
forall a d. From a d => a -> d
from (d -> Builder) -> (Line d -> d) -> Line d -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line d -> d
forall d. Line d -> d
unLine
instance From d TLB.Builder => From (Word d) TLB.Builder where
	from :: Word d -> Builder
from = d -> Builder
forall a d. From a d => a -> d
from (d -> Builder) -> (Word d -> d) -> Word d -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word d -> d
forall d. Word d -> d
unWord
instance From [SGR] TLB.Builder where
	from :: [SGR] -> Builder
from = String -> Builder
forall a d. From a d => a -> d
from (String -> Builder) -> ([SGR] -> String) -> [SGR] -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [SGR] -> String
ANSI.setSGRCode

runTextBuilder :: TLB.Builder -> TL.Text
runTextBuilder :: Builder -> Text
runTextBuilder = Builder -> Text
TLB.toLazyText

-- * Class 'Lengthable'
class Lengthable d where
	width :: d -> Column
	nullWidth :: d -> Bool
	nullWidth d
d = d -> Natural
forall d. Lengthable d => d -> Natural
width d
d Natural -> Natural -> Bool
forall a. Eq a => a -> a -> Bool
== Natural
0
instance Lengthable Char where
	width :: Char -> Natural
width Char
_ = Natural
1
	nullWidth :: Char -> Bool
nullWidth = Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
False
instance Lengthable String where
	width :: String -> Natural
width = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> (String -> Int) -> String -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length
	nullWidth :: String -> Bool
nullWidth = String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Fold.null
instance Lengthable Text.Text where
	width :: Text -> Natural
width = Int -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Natural) -> (Text -> Int) -> Text -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
Text.length
	nullWidth :: Text -> Bool
nullWidth = Text -> Bool
Text.null
instance Lengthable TL.Text where
	width :: Text -> Natural
width = Int64 -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Natural) -> (Text -> Int64) -> Text -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int64
TL.length
	nullWidth :: Text -> Bool
nullWidth = Text -> Bool
TL.null
instance Lengthable d => Lengthable (Line d) where
	width :: Line d -> Natural
width = Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Line d -> Natural) -> Line d -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Natural
forall d. Lengthable d => d -> Natural
width (d -> Natural) -> (Line d -> d) -> Line d -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line d -> d
forall d. Line d -> d
unLine
	nullWidth :: Line d -> Bool
nullWidth = d -> Bool
forall d. Lengthable d => d -> Bool
nullWidth (d -> Bool) -> (Line d -> d) -> Line d -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Line d -> d
forall d. Line d -> d
unLine
instance Lengthable d => Lengthable (Word d) where
	width :: Word d -> Natural
width = Natural -> Natural
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Natural -> Natural) -> (Word d -> Natural) -> Word d -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Natural
forall d. Lengthable d => d -> Natural
width (d -> Natural) -> (Word d -> d) -> Word d -> Natural
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word d -> d
forall d. Word d -> d
unWord
	nullWidth :: Word d -> Bool
nullWidth = d -> Bool
forall d. Lengthable d => d -> Bool
nullWidth (d -> Bool) -> (Word d -> d) -> Word d -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word d -> d
forall d. Word d -> d
unWord

-- * Class 'Spaceable'
class Monoid d => Spaceable d where
	newline :: d
	space   :: d
	default newline :: Spaceable (UnTrans d) => Trans d => d
	default space   :: Spaceable (UnTrans d) => Trans d => d
	newline = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans UnTrans d
forall d. Spaceable d => d
newline
	space   = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans UnTrans d
forall d. Spaceable d => d
space
	
	-- | @'spaces' ind = 'replicate' ind 'space'@
	spaces :: Column -> d
	default spaces :: Monoid d => Column -> d
	spaces Natural
i = Int -> d -> d
forall d. Monoid d => Int -> d -> d
replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
i) d
forall d. Spaceable d => d
space
	unlines :: Foldable f => f (Line d) -> d
	unlines = (Line d -> d -> d) -> d -> f (Line d) -> d
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr (\(Line d
x) d
acc -> d
xd -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
forall d. Spaceable d => d
newlined -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
acc) d
forall a. Monoid a => a
mempty
	unwords :: Foldable f => Functor f => f (Word d) -> d
	unwords = d -> f d -> d
forall (f :: * -> *) d. (Foldable f, Monoid d) => d -> f d -> d
intercalate d
forall d. Spaceable d => d
space (f d -> d) -> (f (Word d) -> f d) -> f (Word d) -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word d -> d
forall d. Word d -> d
unWord (Word d -> d) -> f (Word d) -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
	-- | Like 'unlines' but without the trailing 'newline'.
	catLines :: Foldable f => Functor f => f (Line d) -> d
	catLines = f d -> d
forall d (f :: * -> *). (Spaceable d, Foldable f) => f d -> d
catV (f d -> d) -> (f (Line d) -> f d) -> f (Line d) -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Line d -> d
forall d. Line d -> d
unLine (Line d -> d) -> f (Line d) -> f d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>)
	-- | @x '<+>' y = x '<>' 'space' '<>' y@
	(<+>) :: d -> d -> d
	-- | @x '</>' y = x '<>' 'newline' '<>' y@
	(</>) :: d -> d -> d
	d
x <+> d
y = d
x d -> d -> d
forall a. Semigroup a => a -> a -> a
<> d
forall d. Spaceable d => d
space d -> d -> d
forall a. Semigroup a => a -> a -> a
<> d
y
	d
x </> d
y = d
x d -> d -> d
forall a. Semigroup a => a -> a -> a
<> d
forall d. Spaceable d => d
newline d -> d -> d
forall a. Semigroup a => a -> a -> a
<> d
y
	catH :: Foldable f => f d -> d
	catV :: Foldable f => f d -> d
	catH = (d -> d -> d) -> d -> f d -> d
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
Fold.foldr d -> d -> d
forall a. Semigroup a => a -> a -> a
(<>) d
forall a. Monoid a => a
mempty
	catV = d -> f d -> d
forall (f :: * -> *) d. (Foldable f, Monoid d) => d -> f d -> d
intercalate d
forall d. Spaceable d => d
newline
infixr 6 <+>
infixr 6 </>
instance Spaceable String where
	newline :: String
newline  = String
"\n"
	space :: String
space    = String
" "
	spaces :: Natural -> String
spaces Natural
n = Int -> Char -> String
forall a. Int -> a -> [a]
List.replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) Char
' '
instance Spaceable Text where
	newline :: Text
newline  = Text
"\n"
	space :: Text
space    = Text
" "
	spaces :: Natural -> Text
spaces Natural
n = Int -> Text -> Text
Text.replicate (Natural -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) Text
" "
instance Spaceable TL.Text where
	newline :: Text
newline  = Text
"\n"
	space :: Text
space    = Text
" "
	spaces :: Natural -> Text
spaces Natural
n = Int64 -> Text -> Text
TL.replicate (Natural -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n) Text
" "
instance Spaceable TLB.Builder where
	newline :: Builder
newline  = Char -> Builder
TLB.singleton Char
'\n'
	space :: Builder
space    = Char -> Builder
TLB.singleton Char
' '
	spaces :: Natural -> Builder
spaces   = Text -> Builder
TLB.fromText (Text -> Builder) -> (Natural -> Text) -> Natural -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> Text
forall d. Spaceable d => Natural -> d
spaces

intercalate :: (Foldable f, Monoid d) => d -> f d -> d
intercalate :: d -> f d -> d
intercalate d
sep f d
ds = if f d -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
Fold.null f d
ds then d
forall a. Monoid a => a
mempty else (d -> d -> d) -> f d -> d
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
Fold.foldr1 (\d
x d
y -> d
xd -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
sepd -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
y) f d
ds

replicate :: Monoid d => Int -> d -> d
replicate :: Int -> d -> d
replicate Int
cnt d
t | Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0  = d
forall a. Monoid a => a
mempty
                | Bool
otherwise = d
t d -> d -> d
forall a. Monoid a => a -> a -> a
`mappend` Int -> d -> d
forall d. Monoid d => Int -> d -> d
replicate (Int -> Int
forall a. Enum a => a -> a
pred Int
cnt) d
t

between :: Semigroup d => d -> d -> d -> d
between :: d -> d -> d -> d
between d
o d
c d
d = d
od -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
dd -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
c
parens :: Semigroup d => From (Word Char) d => d -> d
parens :: d -> d
parens = d -> d -> d -> d
forall d. Semigroup d => d -> d -> d -> d
between (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'(')) (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
')'))
braces :: Semigroup d => From (Word Char) d => d -> d
braces :: d -> d
braces = d -> d -> d -> d
forall d. Semigroup d => d -> d -> d -> d
between (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'{')) (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'}'))
brackets :: Semigroup d => From (Word Char) d => d -> d
brackets :: d -> d
brackets = d -> d -> d -> d
forall d. Semigroup d => d -> d -> d -> d
between (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'[')) (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
']'))
angles :: Semigroup d => From (Word Char) d => d -> d
angles :: d -> d
angles = d -> d -> d -> d
forall d. Semigroup d => d -> d -> d -> d
between (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'<')) (Word Char -> d
forall a d. From a d => a -> d
from (Char -> Word Char
forall d. d -> Word d
Word Char
'>'))

-- * Class 'Splitable'
class (Lengthable d, Monoid d) => Splitable d where
	tail  :: d -> Maybe d
	break :: (Char -> Bool) -> d -> (d, d)
	span :: (Char -> Bool) -> d -> (d, d)
	span Char -> Bool
f = (Char -> Bool) -> d -> (d, d)
forall d. Splitable d => (Char -> Bool) -> d -> (d, d)
break (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
f)
	lines :: d -> [Line d]
	words :: d -> [Word d]
	linesNoEmpty :: d -> [Line d]
	wordsNoEmpty :: d -> [Word d]
	lines = (d -> Line d
forall d. d -> Line d
Line (d -> Line d) -> [d] -> [Line d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([d] -> [Line d]) -> (d -> [d]) -> d -> [Line d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> d -> [d]
forall d. Splitable d => (Char -> Bool) -> d -> [d]
splitOnChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
	words = (d -> Word d
forall d. d -> Word d
Word (d -> Word d) -> [d] -> [Word d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([d] -> [Word d]) -> (d -> [d]) -> d -> [Word d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> d -> [d]
forall d. Splitable d => (Char -> Bool) -> d -> [d]
splitOnChar (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
	linesNoEmpty = (d -> Line d
forall d. d -> Line d
Line (d -> Line d) -> [d] -> [Line d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([d] -> [Line d]) -> (d -> [d]) -> d -> [Line d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> d -> [d]
forall d. Splitable d => (Char -> Bool) -> d -> [d]
splitOnCharNoEmpty (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n')
	wordsNoEmpty = (d -> Word d
forall d. d -> Word d
Word (d -> Word d) -> [d] -> [Word d]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>) ([d] -> [Word d]) -> (d -> [d]) -> d -> [Word d]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> d -> [d]
forall d. Splitable d => (Char -> Bool) -> d -> [d]
splitOnCharNoEmpty (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
	
	splitOnChar :: (Char -> Bool) -> d -> [d]
	splitOnChar Char -> Bool
f d
d0 =
		if d -> Bool
forall d. Lengthable d => d -> Bool
nullWidth d
d0 then [] else d -> [d]
go d
d0
		where
		go :: d -> [d]
go d
d =
			let (d
l,d
r) = Char -> Bool
f(Char -> Bool) -> d -> (d, d)
forall d. Splitable d => (Char -> Bool) -> d -> (d, d)
`break`d
d in
			d
l d -> [d] -> [d]
forall a. a -> [a] -> [a]
: case d -> Maybe d
forall d. Splitable d => d -> Maybe d
tail d
r of
			 Maybe d
Nothing -> []
			 Just d
rt | d -> Bool
forall d. Lengthable d => d -> Bool
nullWidth d
rt -> [d
forall a. Monoid a => a
mempty]
			         | Bool
otherwise -> d -> [d]
go d
rt
	splitOnCharNoEmpty :: (Char -> Bool) -> d -> [d]
	splitOnCharNoEmpty Char -> Bool
f d
d =
		let (d
l,d
r) = Char -> Bool
f(Char -> Bool) -> d -> (d, d)
forall d. Splitable d => (Char -> Bool) -> d -> (d, d)
`break`d
d in
		(if d -> Bool
forall d. Lengthable d => d -> Bool
nullWidth d
l then [] else [d
l]) [d] -> [d] -> [d]
forall a. Semigroup a => a -> a -> a
<>
		case d -> Maybe d
forall d. Splitable d => d -> Maybe d
tail d
r of
		 Maybe d
Nothing -> []
		 Just d
rt -> (Char -> Bool) -> d -> [d]
forall d. Splitable d => (Char -> Bool) -> d -> [d]
splitOnCharNoEmpty Char -> Bool
f d
rt
instance Splitable String where
	tail :: String -> Maybe String
tail [] = Maybe String
forall a. Maybe a
Nothing
	tail String
s = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
List.tail String
s
	break :: (Char -> Bool) -> String -> (String, String)
break = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
List.break
instance Splitable Text.Text where
	tail :: Text -> Maybe Text
tail Text
"" = Maybe Text
forall a. Maybe a
Nothing
	tail Text
s = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
Text.tail Text
s
	break :: (Char -> Bool) -> Text -> (Text, Text)
break = (Char -> Bool) -> Text -> (Text, Text)
Text.break
instance Splitable TL.Text where
	tail :: Text -> Maybe Text
tail Text
"" = Maybe Text
forall a. Maybe a
Nothing
	tail Text
s = Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
TL.tail Text
s
	break :: (Char -> Bool) -> Text -> (Text, Text)
break = (Char -> Bool) -> Text -> (Text, Text)
TL.break

-- * Class 'Decorable'
class Decorable d where
	bold      :: d -> d
	underline :: d -> d
	italic    :: d -> d
	default bold      :: Decorable (UnTrans d) => Trans d => d -> d
	default underline :: Decorable (UnTrans d) => Trans d => d -> d
	default italic    :: Decorable (UnTrans d) => Trans d => d -> d
	bold      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Decorable d => d -> d
bold
	underline = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Decorable d => d -> d
underline
	italic    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Decorable d => d -> d
italic

-- * Class 'Colorable16'
class Colorable16 d where
	reverse :: d -> d
	
	-- Foreground colors
	-- Dull
	black   :: d -> d
	red     :: d -> d
	green   :: d -> d
	yellow  :: d -> d
	blue    :: d -> d
	magenta :: d -> d
	cyan    :: d -> d
	white   :: d -> d
	
	-- Vivid
	blacker   :: d -> d
	redder    :: d -> d
	greener   :: d -> d
	yellower  :: d -> d
	bluer     :: d -> d
	magentaer :: d -> d
	cyaner    :: d -> d
	whiter    :: d -> d
	
	-- Background colors
	-- Dull
	onBlack   :: d -> d
	onRed     :: d -> d
	onGreen   :: d -> d
	onYellow  :: d -> d
	onBlue    :: d -> d
	onMagenta :: d -> d
	onCyan    :: d -> d
	onWhite   :: d -> d
	
	-- Vivid
	onBlacker   :: d -> d
	onRedder    :: d -> d
	onGreener   :: d -> d
	onYellower  :: d -> d
	onBluer     :: d -> d
	onMagentaer :: d -> d
	onCyaner    :: d -> d
	onWhiter    :: d -> d
	
	default reverse     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default black       :: Colorable16 (UnTrans d) => Trans d => d -> d
	default red         :: Colorable16 (UnTrans d) => Trans d => d -> d
	default green       :: Colorable16 (UnTrans d) => Trans d => d -> d
	default yellow      :: Colorable16 (UnTrans d) => Trans d => d -> d
	default blue        :: Colorable16 (UnTrans d) => Trans d => d -> d
	default magenta     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default cyan        :: Colorable16 (UnTrans d) => Trans d => d -> d
	default white       :: Colorable16 (UnTrans d) => Trans d => d -> d
	default blacker     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default redder      :: Colorable16 (UnTrans d) => Trans d => d -> d
	default greener     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default yellower    :: Colorable16 (UnTrans d) => Trans d => d -> d
	default bluer       :: Colorable16 (UnTrans d) => Trans d => d -> d
	default magentaer   :: Colorable16 (UnTrans d) => Trans d => d -> d
	default cyaner      :: Colorable16 (UnTrans d) => Trans d => d -> d
	default whiter      :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onBlack     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onRed       :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onGreen     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onYellow    :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onBlue      :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onMagenta   :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onCyan      :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onWhite     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onBlacker   :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onRedder    :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onGreener   :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onYellower  :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onBluer     :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onMagentaer :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onCyaner    :: Colorable16 (UnTrans d) => Trans d => d -> d
	default onWhiter    :: Colorable16 (UnTrans d) => Trans d => d -> d
	
	reverse     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
reverse
	black       = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
black
	red         = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
red
	green       = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
green
	yellow      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
yellow
	blue        = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
blue
	magenta     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
magenta
	cyan        = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
cyan
	white       = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
white
	blacker     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
blacker
	redder      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
redder
	greener     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
greener
	yellower    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
yellower
	bluer       = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
bluer
	magentaer   = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
magentaer
	cyaner      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
cyaner
	whiter      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
whiter
	onBlack     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onBlack
	onRed       = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onRed
	onGreen     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onGreen
	onYellow    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onYellow
	onBlue      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onBlue
	onMagenta   = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onMagenta
	onCyan      = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onCyan
	onWhite     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onWhite
	onBlacker   = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onBlacker
	onRedder    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onRedder
	onGreener   = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onGreener
	onYellower  = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onYellower
	onBluer     = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onBluer
	onMagentaer = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onMagentaer
	onCyaner    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onCyaner
	onWhiter    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Colorable16 d => d -> d
onWhiter

-- | For debugging purposes.
instance Colorable16 String where
	reverse :: ShowS
reverse     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"reverse"
	black :: ShowS
black       = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"black"
	red :: ShowS
red         = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"red"
	green :: ShowS
green       = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"green"
	yellow :: ShowS
yellow      = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"yellow"
	blue :: ShowS
blue        = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"blue"
	magenta :: ShowS
magenta     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"magenta"
	cyan :: ShowS
cyan        = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"cyan"
	white :: ShowS
white       = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"white"
	blacker :: ShowS
blacker     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"blacker"
	redder :: ShowS
redder      = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"redder"
	greener :: ShowS
greener     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"greener"
	yellower :: ShowS
yellower    = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"yellower"
	bluer :: ShowS
bluer       = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"bluer"
	magentaer :: ShowS
magentaer   = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"magentaer"
	cyaner :: ShowS
cyaner      = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"cyaner"
	whiter :: ShowS
whiter      = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"whiter"
	onBlack :: ShowS
onBlack     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onBlack"
	onRed :: ShowS
onRed       = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onRed"
	onGreen :: ShowS
onGreen     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onGreen"
	onYellow :: ShowS
onYellow    = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onYellow"
	onBlue :: ShowS
onBlue      = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onBlue"
	onMagenta :: ShowS
onMagenta   = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onMagenta"
	onCyan :: ShowS
onCyan      = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onCyan"
	onWhite :: ShowS
onWhite     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onWhite"
	onBlacker :: ShowS
onBlacker   = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onBlacker"
	onRedder :: ShowS
onRedder    = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onRedder"
	onGreener :: ShowS
onGreener   = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onGreener"
	onYellower :: ShowS
onYellower  = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onYellower"
	onBluer :: ShowS
onBluer     = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onBluer"
	onMagentaer :: ShowS
onMagentaer = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onMagentaer"
	onCyaner :: ShowS
onCyaner    = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onCyaner"
	onWhiter :: ShowS
onWhiter    = String -> ShowS
forall d. (Semigroup d, From String d) => String -> d -> d
xmlSGR String
"onWhiter"

-- | For debugging purposes.
xmlSGR :: Semigroup d => From String d => String -> d -> d
xmlSGR :: String -> d -> d
xmlSGR String
newSGR d
s = String -> d
forall a d. From a d => a -> d
from (String
"<"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
newSGRString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
">")d -> d -> d
forall a. Semigroup a => a -> a -> a
<>d
sd -> d -> d
forall a. Semigroup a => a -> a -> a
<>String -> d
forall a d. From a d => a -> d
from (String
"</"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
newSGRString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
">")

-- * Class 'Indentable'
class Spaceable d => Indentable d where
	-- | @('align' d)@ make @d@ uses current 'Column' as 'Indent' level.
	align :: d -> d
	-- | @('setIndent' p ind d)@ make @d@ uses @ind@ as 'Indent' level.
	-- Using @p@ as 'Indent' text.
	setIndent :: d -> Indent -> d -> d
	-- | @('incrIndent' p ind d)@ make @d@ uses current 'Indent' plus @ind@ as 'Indent' level.
	-- Appending @p@ to the current 'Indent' text.
	incrIndent :: d -> Indent -> d -> d
	hang :: Indent -> d -> d
	hang Natural
ind = d -> d
forall d. Indentable d => d -> d
align (d -> d) -> (d -> d) -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Natural -> d -> d
forall d. Indentable d => d -> Natural -> d -> d
incrIndent (Natural -> d
forall d. Spaceable d => Natural -> d
spaces Natural
ind) Natural
ind
	-- | @('fill' w d)@ write @d@,
	-- then if @d@ is not wider than @w@,
	-- write the difference with 'spaces'.
	fill :: Width -> d -> d
	-- | @('fillOrBreak' w d)@ write @d@,
	-- then if @d@ is not wider than @w@, write the difference with 'spaces'
	-- otherwise write a 'newline' indented to to the start 'Column' of @d@ plus @w@.
	fillOrBreak :: Width -> d -> d
	
	default align         :: Indentable (UnTrans d) => Trans d => d -> d
	default incrIndent    :: Indentable (UnTrans d) => Trans d => d -> Indent -> d -> d
	default setIndent     :: Indentable (UnTrans d) => Trans d => d -> Indent -> d -> d
	default fill          :: Indentable (UnTrans d) => Trans d => Width -> d -> d
	default fillOrBreak   :: Indentable (UnTrans d) => Trans d => Width -> d -> d
	
	align          = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 UnTrans d -> UnTrans d
forall d. Indentable d => d -> d
align
	setIndent  d
p Natural
i = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans d -> d) -> (d -> UnTrans d) -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnTrans d -> Natural -> UnTrans d -> UnTrans d
forall d. Indentable d => d -> Natural -> d -> d
setIndent  (d -> UnTrans d
forall repr. Trans repr => repr -> UnTrans repr
unTrans d
p) Natural
i (UnTrans d -> UnTrans d) -> (d -> UnTrans d) -> d -> UnTrans d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> UnTrans d
forall repr. Trans repr => repr -> UnTrans repr
unTrans
	incrIndent d
p Natural
i = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans d -> d) -> (d -> UnTrans d) -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnTrans d -> Natural -> UnTrans d -> UnTrans d
forall d. Indentable d => d -> Natural -> d -> d
incrIndent (d -> UnTrans d
forall repr. Trans repr => repr -> UnTrans repr
unTrans d
p) Natural
i (UnTrans d -> UnTrans d) -> (d -> UnTrans d) -> d -> UnTrans d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> UnTrans d
forall repr. Trans repr => repr -> UnTrans repr
unTrans
	fill           = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 ((UnTrans d -> UnTrans d) -> d -> d)
-> (Natural -> UnTrans d -> UnTrans d) -> Natural -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> UnTrans d -> UnTrans d
forall d. Indentable d => Natural -> d -> d
fill
	fillOrBreak    = (UnTrans d -> UnTrans d) -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr) -> repr -> repr
noTrans1 ((UnTrans d -> UnTrans d) -> d -> d)
-> (Natural -> UnTrans d -> UnTrans d) -> Natural -> d -> d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Natural -> UnTrans d -> UnTrans d
forall d. Indentable d => Natural -> d -> d
fillOrBreak

class Listable d where
	ul :: Traversable f => f d -> d
	ol :: Traversable f => f d -> d
	default ul ::
	 Listable (UnTrans d) => Trans d =>
	 Traversable f => f d -> d
	default ol ::
	 Listable (UnTrans d) => Trans d =>
	 Traversable f => f d -> d
	ul f d
ds = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans d -> d) -> UnTrans d -> d
forall a b. (a -> b) -> a -> b
$ f (UnTrans d) -> UnTrans d
forall d (f :: * -> *). (Listable d, Traversable f) => f d -> d
ul (f (UnTrans d) -> UnTrans d) -> f (UnTrans d) -> UnTrans d
forall a b. (a -> b) -> a -> b
$ d -> UnTrans d
forall repr. Trans repr => repr -> UnTrans repr
unTrans (d -> UnTrans d) -> f d -> f (UnTrans d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f d
ds
	ol f d
ds = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans d -> d) -> UnTrans d -> d
forall a b. (a -> b) -> a -> b
$ f (UnTrans d) -> UnTrans d
forall d (f :: * -> *). (Listable d, Traversable f) => f d -> d
ol (f (UnTrans d) -> UnTrans d) -> f (UnTrans d) -> UnTrans d
forall a b. (a -> b) -> a -> b
$ d -> UnTrans d
forall repr. Trans repr => repr -> UnTrans repr
unTrans (d -> UnTrans d) -> f d -> f (UnTrans d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f d
ds

-- * Class 'Wrappable'
class Wrappable d where
	setWidth :: Maybe Width -> d -> d
	-- getWidth :: (Maybe Width -> d) -> d
	breakpoint :: d
	breakspace :: d
	breakalt   :: d -> d -> d
	endline    :: d
	default breakpoint :: Wrappable (UnTrans d) => Trans d => d
	default breakspace :: Wrappable (UnTrans d) => Trans d => d
	default breakalt   :: Wrappable (UnTrans d) => Trans d => d -> d -> d
	default endline    :: Wrappable (UnTrans d) => Trans d => d
	breakpoint = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans UnTrans d
forall d. Wrappable d => d
breakpoint
	breakspace = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans UnTrans d
forall d. Wrappable d => d
breakspace
	breakalt   = (UnTrans d -> UnTrans d -> UnTrans d) -> d -> d -> d
forall repr.
Trans repr =>
(UnTrans repr -> UnTrans repr -> UnTrans repr)
-> repr -> repr -> repr
noTrans2 UnTrans d -> UnTrans d -> UnTrans d
forall d. Wrappable d => d -> d -> d
breakalt
	endline    = UnTrans d -> d
forall repr. Trans repr => UnTrans repr -> repr
noTrans UnTrans d
forall d. Wrappable d => d
endline

-- * Class 'Justifiable'
class Justifiable d where
	justify :: d -> d

-- * Class 'Trans'
class Trans repr where
	-- | Return the underlying @repr@ of the transformer.
	type UnTrans repr :: Type
	
	-- | Lift a repr to the transformer's.
	noTrans :: UnTrans repr -> repr
	-- | Unlift a repr from the transformer's.
	unTrans :: repr -> UnTrans repr
	
	-- | Identity transformation for a unary symantic method.
	noTrans1 :: (UnTrans repr -> UnTrans repr) -> (repr -> repr)
	noTrans1 UnTrans repr -> UnTrans repr
f = UnTrans repr -> repr
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans repr -> repr) -> (repr -> UnTrans repr) -> repr -> repr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. UnTrans repr -> UnTrans repr
f (UnTrans repr -> UnTrans repr)
-> (repr -> UnTrans repr) -> repr -> UnTrans repr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. repr -> UnTrans repr
forall repr. Trans repr => repr -> UnTrans repr
unTrans
	
	-- | Identity transformation for a binary symantic method.
	noTrans2
	 :: (UnTrans repr -> UnTrans repr -> UnTrans repr)
	 -> (repr -> repr -> repr)
	noTrans2 UnTrans repr -> UnTrans repr -> UnTrans repr
f repr
a repr
b = UnTrans repr -> repr
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans repr -> UnTrans repr -> UnTrans repr
f (repr -> UnTrans repr
forall repr. Trans repr => repr -> UnTrans repr
unTrans repr
a) (repr -> UnTrans repr
forall repr. Trans repr => repr -> UnTrans repr
unTrans repr
b))
	
	-- | Identity transformation for a ternary symantic method.
	noTrans3
	 :: (UnTrans repr -> UnTrans repr -> UnTrans repr -> UnTrans repr)
	 -> (repr -> repr -> repr -> repr)
	noTrans3 UnTrans repr -> UnTrans repr -> UnTrans repr -> UnTrans repr
f repr
a repr
b repr
c = UnTrans repr -> repr
forall repr. Trans repr => UnTrans repr -> repr
noTrans (UnTrans repr -> UnTrans repr -> UnTrans repr -> UnTrans repr
f (repr -> UnTrans repr
forall repr. Trans repr => repr -> UnTrans repr
unTrans repr
a) (repr -> UnTrans repr
forall repr. Trans repr => repr -> UnTrans repr
unTrans repr
b) (repr -> UnTrans repr
forall repr. Trans repr => repr -> UnTrans repr
unTrans repr
c))