{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE DeriveDataTypeable #-}
module Text.DocLayout.ANSIFont
  ( Font(..)
  , baseFont
  , StyleReq(..)
  , Weight(..)
  , Shape(..)
  , Color8(..)
  , Underline(..)
  , Strikeout(..)
  , Foreground(..)
  , Background(..)
  , (~>)
  , renderFont
  , renderOSC8
  ) where

import Data.Data (Data)
import Data.String
import Data.Text (Text)

data Font = Font
  { Font -> Weight
ftWeight :: Weight,
    Font -> Shape
ftShape :: Shape,
    Font -> Underline
ftUnderline :: Underline,
    Font -> Strikeout
ftStrikeout :: Strikeout,
    Font -> Foreground
ftForeground :: Foreground,
    Font -> Background
ftBackground :: Background,
    Font -> Maybe Text
ftLink :: Maybe Text
  }
  deriving (Int -> Font -> ShowS
[Font] -> ShowS
Font -> String
(Int -> Font -> ShowS)
-> (Font -> String) -> ([Font] -> ShowS) -> Show Font
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Font -> ShowS
showsPrec :: Int -> Font -> ShowS
$cshow :: Font -> String
show :: Font -> String
$cshowList :: [Font] -> ShowS
showList :: [Font] -> ShowS
Show, Font -> Font -> Bool
(Font -> Font -> Bool) -> (Font -> Font -> Bool) -> Eq Font
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Font -> Font -> Bool
== :: Font -> Font -> Bool
$c/= :: Font -> Font -> Bool
/= :: Font -> Font -> Bool
Eq, ReadPrec [Font]
ReadPrec Font
Int -> ReadS Font
ReadS [Font]
(Int -> ReadS Font)
-> ReadS [Font] -> ReadPrec Font -> ReadPrec [Font] -> Read Font
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Font
readsPrec :: Int -> ReadS Font
$creadList :: ReadS [Font]
readList :: ReadS [Font]
$creadPrec :: ReadPrec Font
readPrec :: ReadPrec Font
$creadListPrec :: ReadPrec [Font]
readListPrec :: ReadPrec [Font]
Read, Typeable Font
Typeable Font =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Font -> c Font)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Font)
-> (Font -> Constr)
-> (Font -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Font))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Font))
-> ((forall b. Data b => b -> b) -> Font -> Font)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r)
-> (forall u. (forall d. Data d => d -> u) -> Font -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Font -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Font -> m Font)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Font -> m Font)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Font -> m Font)
-> Data Font
Font -> Constr
Font -> DataType
(forall b. Data b => b -> b) -> Font -> Font
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Font -> u
forall u. (forall d. Data d => d -> u) -> Font -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Font -> m Font
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Font -> m Font
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Font
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Font -> c Font
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Font)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Font)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Font -> c Font
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Font -> c Font
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Font
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Font
$ctoConstr :: Font -> Constr
toConstr :: Font -> Constr
$cdataTypeOf :: Font -> DataType
dataTypeOf :: Font -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Font)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Font)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Font)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Font)
$cgmapT :: (forall b. Data b => b -> b) -> Font -> Font
gmapT :: (forall b. Data b => b -> b) -> Font -> Font
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Font -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Font -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Font -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Font -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Font -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Font -> m Font
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Font -> m Font
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Font -> m Font
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Font -> m Font
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Font -> m Font
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Font -> m Font
Data, Eq Font
Eq Font =>
(Font -> Font -> Ordering)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Bool)
-> (Font -> Font -> Font)
-> (Font -> Font -> Font)
-> Ord Font
Font -> Font -> Bool
Font -> Font -> Ordering
Font -> Font -> Font
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Font -> Font -> Ordering
compare :: Font -> Font -> Ordering
$c< :: Font -> Font -> Bool
< :: Font -> Font -> Bool
$c<= :: Font -> Font -> Bool
<= :: Font -> Font -> Bool
$c> :: Font -> Font -> Bool
> :: Font -> Font -> Bool
$c>= :: Font -> Font -> Bool
>= :: Font -> Font -> Bool
$cmax :: Font -> Font -> Font
max :: Font -> Font -> Font
$cmin :: Font -> Font -> Font
min :: Font -> Font -> Font
Ord)

baseFont :: Font
baseFont :: Font
baseFont = Weight
-> Shape
-> Underline
-> Strikeout
-> Foreground
-> Background
-> Maybe Text
-> Font
Font Weight
Normal Shape
Roman Underline
ULNone Strikeout
Unstruck Foreground
FGDefault Background
BGDefault Maybe Text
forall a. Maybe a
Nothing

data Weight = Normal | Bold deriving (Int -> Weight -> ShowS
[Weight] -> ShowS
Weight -> String
(Int -> Weight -> ShowS)
-> (Weight -> String) -> ([Weight] -> ShowS) -> Show Weight
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Weight -> ShowS
showsPrec :: Int -> Weight -> ShowS
$cshow :: Weight -> String
show :: Weight -> String
$cshowList :: [Weight] -> ShowS
showList :: [Weight] -> ShowS
Show, Weight -> Weight -> Bool
(Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool) -> Eq Weight
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Weight -> Weight -> Bool
== :: Weight -> Weight -> Bool
$c/= :: Weight -> Weight -> Bool
/= :: Weight -> Weight -> Bool
Eq, ReadPrec [Weight]
ReadPrec Weight
Int -> ReadS Weight
ReadS [Weight]
(Int -> ReadS Weight)
-> ReadS [Weight]
-> ReadPrec Weight
-> ReadPrec [Weight]
-> Read Weight
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Weight
readsPrec :: Int -> ReadS Weight
$creadList :: ReadS [Weight]
readList :: ReadS [Weight]
$creadPrec :: ReadPrec Weight
readPrec :: ReadPrec Weight
$creadListPrec :: ReadPrec [Weight]
readListPrec :: ReadPrec [Weight]
Read, Typeable Weight
Typeable Weight =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Weight -> c Weight)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Weight)
-> (Weight -> Constr)
-> (Weight -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Weight))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight))
-> ((forall b. Data b => b -> b) -> Weight -> Weight)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Weight -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Weight -> r)
-> (forall u. (forall d. Data d => d -> u) -> Weight -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Weight -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Weight -> m Weight)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Weight -> m Weight)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Weight -> m Weight)
-> Data Weight
Weight -> Constr
Weight -> DataType
(forall b. Data b => b -> b) -> Weight -> Weight
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Weight -> u
forall u. (forall d. Data d => d -> u) -> Weight -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Weight)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Weight -> c Weight
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Weight
$ctoConstr :: Weight -> Constr
toConstr :: Weight -> Constr
$cdataTypeOf :: Weight -> DataType
dataTypeOf :: Weight -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Weight)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Weight)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Weight)
$cgmapT :: (forall b. Data b => b -> b) -> Weight -> Weight
gmapT :: (forall b. Data b => b -> b) -> Weight -> Weight
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Weight -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Weight -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Weight -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Weight -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Weight -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Weight -> m Weight
Data, Eq Weight
Eq Weight =>
(Weight -> Weight -> Ordering)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Bool)
-> (Weight -> Weight -> Weight)
-> (Weight -> Weight -> Weight)
-> Ord Weight
Weight -> Weight -> Bool
Weight -> Weight -> Ordering
Weight -> Weight -> Weight
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Weight -> Weight -> Ordering
compare :: Weight -> Weight -> Ordering
$c< :: Weight -> Weight -> Bool
< :: Weight -> Weight -> Bool
$c<= :: Weight -> Weight -> Bool
<= :: Weight -> Weight -> Bool
$c> :: Weight -> Weight -> Bool
> :: Weight -> Weight -> Bool
$c>= :: Weight -> Weight -> Bool
>= :: Weight -> Weight -> Bool
$cmax :: Weight -> Weight -> Weight
max :: Weight -> Weight -> Weight
$cmin :: Weight -> Weight -> Weight
min :: Weight -> Weight -> Weight
Ord)
data Shape = Roman | Italic deriving (Int -> Shape -> ShowS
[Shape] -> ShowS
Shape -> String
(Int -> Shape -> ShowS)
-> (Shape -> String) -> ([Shape] -> ShowS) -> Show Shape
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Shape -> ShowS
showsPrec :: Int -> Shape -> ShowS
$cshow :: Shape -> String
show :: Shape -> String
$cshowList :: [Shape] -> ShowS
showList :: [Shape] -> ShowS
Show, Shape -> Shape -> Bool
(Shape -> Shape -> Bool) -> (Shape -> Shape -> Bool) -> Eq Shape
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Shape -> Shape -> Bool
== :: Shape -> Shape -> Bool
$c/= :: Shape -> Shape -> Bool
/= :: Shape -> Shape -> Bool
Eq, ReadPrec [Shape]
ReadPrec Shape
Int -> ReadS Shape
ReadS [Shape]
(Int -> ReadS Shape)
-> ReadS [Shape]
-> ReadPrec Shape
-> ReadPrec [Shape]
-> Read Shape
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Shape
readsPrec :: Int -> ReadS Shape
$creadList :: ReadS [Shape]
readList :: ReadS [Shape]
$creadPrec :: ReadPrec Shape
readPrec :: ReadPrec Shape
$creadListPrec :: ReadPrec [Shape]
readListPrec :: ReadPrec [Shape]
Read, Typeable Shape
Typeable Shape =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Shape -> c Shape)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Shape)
-> (Shape -> Constr)
-> (Shape -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Shape))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Shape))
-> ((forall b. Data b => b -> b) -> Shape -> Shape)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r)
-> (forall u. (forall d. Data d => d -> u) -> Shape -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Shape -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Shape -> m Shape)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Shape -> m Shape)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Shape -> m Shape)
-> Data Shape
Shape -> Constr
Shape -> DataType
(forall b. Data b => b -> b) -> Shape -> Shape
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Shape -> u
forall u. (forall d. Data d => d -> u) -> Shape -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Shape
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Shape -> c Shape
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Shape)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Shape)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Shape -> c Shape
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Shape -> c Shape
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Shape
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Shape
$ctoConstr :: Shape -> Constr
toConstr :: Shape -> Constr
$cdataTypeOf :: Shape -> DataType
dataTypeOf :: Shape -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Shape)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Shape)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Shape)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Shape)
$cgmapT :: (forall b. Data b => b -> b) -> Shape -> Shape
gmapT :: (forall b. Data b => b -> b) -> Shape -> Shape
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Shape -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Shape -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Shape -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Shape -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Shape -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Shape -> m Shape
Data, Eq Shape
Eq Shape =>
(Shape -> Shape -> Ordering)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Bool)
-> (Shape -> Shape -> Shape)
-> (Shape -> Shape -> Shape)
-> Ord Shape
Shape -> Shape -> Bool
Shape -> Shape -> Ordering
Shape -> Shape -> Shape
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Shape -> Shape -> Ordering
compare :: Shape -> Shape -> Ordering
$c< :: Shape -> Shape -> Bool
< :: Shape -> Shape -> Bool
$c<= :: Shape -> Shape -> Bool
<= :: Shape -> Shape -> Bool
$c> :: Shape -> Shape -> Bool
> :: Shape -> Shape -> Bool
$c>= :: Shape -> Shape -> Bool
>= :: Shape -> Shape -> Bool
$cmax :: Shape -> Shape -> Shape
max :: Shape -> Shape -> Shape
$cmin :: Shape -> Shape -> Shape
min :: Shape -> Shape -> Shape
Ord)
data Color8 = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White deriving (Int -> Color8 -> ShowS
[Color8] -> ShowS
Color8 -> String
(Int -> Color8 -> ShowS)
-> (Color8 -> String) -> ([Color8] -> ShowS) -> Show Color8
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color8 -> ShowS
showsPrec :: Int -> Color8 -> ShowS
$cshow :: Color8 -> String
show :: Color8 -> String
$cshowList :: [Color8] -> ShowS
showList :: [Color8] -> ShowS
Show, Color8 -> Color8 -> Bool
(Color8 -> Color8 -> Bool)
-> (Color8 -> Color8 -> Bool) -> Eq Color8
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color8 -> Color8 -> Bool
== :: Color8 -> Color8 -> Bool
$c/= :: Color8 -> Color8 -> Bool
/= :: Color8 -> Color8 -> Bool
Eq, Int -> Color8
Color8 -> Int
Color8 -> [Color8]
Color8 -> Color8
Color8 -> Color8 -> [Color8]
Color8 -> Color8 -> Color8 -> [Color8]
(Color8 -> Color8)
-> (Color8 -> Color8)
-> (Int -> Color8)
-> (Color8 -> Int)
-> (Color8 -> [Color8])
-> (Color8 -> Color8 -> [Color8])
-> (Color8 -> Color8 -> [Color8])
-> (Color8 -> Color8 -> Color8 -> [Color8])
-> Enum Color8
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Color8 -> Color8
succ :: Color8 -> Color8
$cpred :: Color8 -> Color8
pred :: Color8 -> Color8
$ctoEnum :: Int -> Color8
toEnum :: Int -> Color8
$cfromEnum :: Color8 -> Int
fromEnum :: Color8 -> Int
$cenumFrom :: Color8 -> [Color8]
enumFrom :: Color8 -> [Color8]
$cenumFromThen :: Color8 -> Color8 -> [Color8]
enumFromThen :: Color8 -> Color8 -> [Color8]
$cenumFromTo :: Color8 -> Color8 -> [Color8]
enumFromTo :: Color8 -> Color8 -> [Color8]
$cenumFromThenTo :: Color8 -> Color8 -> Color8 -> [Color8]
enumFromThenTo :: Color8 -> Color8 -> Color8 -> [Color8]
Enum, ReadPrec [Color8]
ReadPrec Color8
Int -> ReadS Color8
ReadS [Color8]
(Int -> ReadS Color8)
-> ReadS [Color8]
-> ReadPrec Color8
-> ReadPrec [Color8]
-> Read Color8
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Color8
readsPrec :: Int -> ReadS Color8
$creadList :: ReadS [Color8]
readList :: ReadS [Color8]
$creadPrec :: ReadPrec Color8
readPrec :: ReadPrec Color8
$creadListPrec :: ReadPrec [Color8]
readListPrec :: ReadPrec [Color8]
Read, Typeable Color8
Typeable Color8 =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Color8 -> c Color8)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Color8)
-> (Color8 -> Constr)
-> (Color8 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Color8))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color8))
-> ((forall b. Data b => b -> b) -> Color8 -> Color8)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Color8 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Color8 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Color8 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Color8 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Color8 -> m Color8)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color8 -> m Color8)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Color8 -> m Color8)
-> Data Color8
Color8 -> Constr
Color8 -> DataType
(forall b. Data b => b -> b) -> Color8 -> Color8
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Color8 -> u
forall u. (forall d. Data d => d -> u) -> Color8 -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color8 -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color8 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color8
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color8 -> c Color8
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color8)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color8)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color8 -> c Color8
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Color8 -> c Color8
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color8
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Color8
$ctoConstr :: Color8 -> Constr
toConstr :: Color8 -> Constr
$cdataTypeOf :: Color8 -> DataType
dataTypeOf :: Color8 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color8)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Color8)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color8)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Color8)
$cgmapT :: (forall b. Data b => b -> b) -> Color8 -> Color8
gmapT :: (forall b. Data b => b -> b) -> Color8 -> Color8
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color8 -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Color8 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color8 -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Color8 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Color8 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Color8 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color8 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Color8 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Color8 -> m Color8
Data, Eq Color8
Eq Color8 =>
(Color8 -> Color8 -> Ordering)
-> (Color8 -> Color8 -> Bool)
-> (Color8 -> Color8 -> Bool)
-> (Color8 -> Color8 -> Bool)
-> (Color8 -> Color8 -> Bool)
-> (Color8 -> Color8 -> Color8)
-> (Color8 -> Color8 -> Color8)
-> Ord Color8
Color8 -> Color8 -> Bool
Color8 -> Color8 -> Ordering
Color8 -> Color8 -> Color8
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Color8 -> Color8 -> Ordering
compare :: Color8 -> Color8 -> Ordering
$c< :: Color8 -> Color8 -> Bool
< :: Color8 -> Color8 -> Bool
$c<= :: Color8 -> Color8 -> Bool
<= :: Color8 -> Color8 -> Bool
$c> :: Color8 -> Color8 -> Bool
> :: Color8 -> Color8 -> Bool
$c>= :: Color8 -> Color8 -> Bool
>= :: Color8 -> Color8 -> Bool
$cmax :: Color8 -> Color8 -> Color8
max :: Color8 -> Color8 -> Color8
$cmin :: Color8 -> Color8 -> Color8
min :: Color8 -> Color8 -> Color8
Ord)
data Underline = ULNone | ULSingle | ULDouble | ULCurly deriving (Int -> Underline -> ShowS
[Underline] -> ShowS
Underline -> String
(Int -> Underline -> ShowS)
-> (Underline -> String)
-> ([Underline] -> ShowS)
-> Show Underline
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Underline -> ShowS
showsPrec :: Int -> Underline -> ShowS
$cshow :: Underline -> String
show :: Underline -> String
$cshowList :: [Underline] -> ShowS
showList :: [Underline] -> ShowS
Show, Underline -> Underline -> Bool
(Underline -> Underline -> Bool)
-> (Underline -> Underline -> Bool) -> Eq Underline
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Underline -> Underline -> Bool
== :: Underline -> Underline -> Bool
$c/= :: Underline -> Underline -> Bool
/= :: Underline -> Underline -> Bool
Eq, ReadPrec [Underline]
ReadPrec Underline
Int -> ReadS Underline
ReadS [Underline]
(Int -> ReadS Underline)
-> ReadS [Underline]
-> ReadPrec Underline
-> ReadPrec [Underline]
-> Read Underline
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Underline
readsPrec :: Int -> ReadS Underline
$creadList :: ReadS [Underline]
readList :: ReadS [Underline]
$creadPrec :: ReadPrec Underline
readPrec :: ReadPrec Underline
$creadListPrec :: ReadPrec [Underline]
readListPrec :: ReadPrec [Underline]
Read, Typeable Underline
Typeable Underline =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Underline -> c Underline)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Underline)
-> (Underline -> Constr)
-> (Underline -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Underline))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Underline))
-> ((forall b. Data b => b -> b) -> Underline -> Underline)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Underline -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Underline -> r)
-> (forall u. (forall d. Data d => d -> u) -> Underline -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Underline -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Underline -> m Underline)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Underline -> m Underline)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Underline -> m Underline)
-> Data Underline
Underline -> Constr
Underline -> DataType
(forall b. Data b => b -> b) -> Underline -> Underline
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Underline -> u
forall u. (forall d. Data d => d -> u) -> Underline -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Underline -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Underline -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Underline
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Underline -> c Underline
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Underline)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Underline)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Underline -> c Underline
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Underline -> c Underline
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Underline
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Underline
$ctoConstr :: Underline -> Constr
toConstr :: Underline -> Constr
$cdataTypeOf :: Underline -> DataType
dataTypeOf :: Underline -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Underline)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Underline)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Underline)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Underline)
$cgmapT :: (forall b. Data b => b -> b) -> Underline -> Underline
gmapT :: (forall b. Data b => b -> b) -> Underline -> Underline
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Underline -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Underline -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Underline -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Underline -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Underline -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Underline -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Underline -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Underline -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Underline -> m Underline
Data, Eq Underline
Eq Underline =>
(Underline -> Underline -> Ordering)
-> (Underline -> Underline -> Bool)
-> (Underline -> Underline -> Bool)
-> (Underline -> Underline -> Bool)
-> (Underline -> Underline -> Bool)
-> (Underline -> Underline -> Underline)
-> (Underline -> Underline -> Underline)
-> Ord Underline
Underline -> Underline -> Bool
Underline -> Underline -> Ordering
Underline -> Underline -> Underline
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Underline -> Underline -> Ordering
compare :: Underline -> Underline -> Ordering
$c< :: Underline -> Underline -> Bool
< :: Underline -> Underline -> Bool
$c<= :: Underline -> Underline -> Bool
<= :: Underline -> Underline -> Bool
$c> :: Underline -> Underline -> Bool
> :: Underline -> Underline -> Bool
$c>= :: Underline -> Underline -> Bool
>= :: Underline -> Underline -> Bool
$cmax :: Underline -> Underline -> Underline
max :: Underline -> Underline -> Underline
$cmin :: Underline -> Underline -> Underline
min :: Underline -> Underline -> Underline
Ord)
data Strikeout = Unstruck | Struck deriving (Int -> Strikeout -> ShowS
[Strikeout] -> ShowS
Strikeout -> String
(Int -> Strikeout -> ShowS)
-> (Strikeout -> String)
-> ([Strikeout] -> ShowS)
-> Show Strikeout
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Strikeout -> ShowS
showsPrec :: Int -> Strikeout -> ShowS
$cshow :: Strikeout -> String
show :: Strikeout -> String
$cshowList :: [Strikeout] -> ShowS
showList :: [Strikeout] -> ShowS
Show, Strikeout -> Strikeout -> Bool
(Strikeout -> Strikeout -> Bool)
-> (Strikeout -> Strikeout -> Bool) -> Eq Strikeout
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Strikeout -> Strikeout -> Bool
== :: Strikeout -> Strikeout -> Bool
$c/= :: Strikeout -> Strikeout -> Bool
/= :: Strikeout -> Strikeout -> Bool
Eq, ReadPrec [Strikeout]
ReadPrec Strikeout
Int -> ReadS Strikeout
ReadS [Strikeout]
(Int -> ReadS Strikeout)
-> ReadS [Strikeout]
-> ReadPrec Strikeout
-> ReadPrec [Strikeout]
-> Read Strikeout
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Strikeout
readsPrec :: Int -> ReadS Strikeout
$creadList :: ReadS [Strikeout]
readList :: ReadS [Strikeout]
$creadPrec :: ReadPrec Strikeout
readPrec :: ReadPrec Strikeout
$creadListPrec :: ReadPrec [Strikeout]
readListPrec :: ReadPrec [Strikeout]
Read, Typeable Strikeout
Typeable Strikeout =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Strikeout -> c Strikeout)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Strikeout)
-> (Strikeout -> Constr)
-> (Strikeout -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Strikeout))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strikeout))
-> ((forall b. Data b => b -> b) -> Strikeout -> Strikeout)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Strikeout -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Strikeout -> r)
-> (forall u. (forall d. Data d => d -> u) -> Strikeout -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Strikeout -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Strikeout -> m Strikeout)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Strikeout -> m Strikeout)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Strikeout -> m Strikeout)
-> Data Strikeout
Strikeout -> Constr
Strikeout -> DataType
(forall b. Data b => b -> b) -> Strikeout -> Strikeout
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Strikeout -> u
forall u. (forall d. Data d => d -> u) -> Strikeout -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strikeout -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strikeout -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strikeout
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strikeout -> c Strikeout
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strikeout)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strikeout)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strikeout -> c Strikeout
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Strikeout -> c Strikeout
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strikeout
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Strikeout
$ctoConstr :: Strikeout -> Constr
toConstr :: Strikeout -> Constr
$cdataTypeOf :: Strikeout -> DataType
dataTypeOf :: Strikeout -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strikeout)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Strikeout)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strikeout)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Strikeout)
$cgmapT :: (forall b. Data b => b -> b) -> Strikeout -> Strikeout
gmapT :: (forall b. Data b => b -> b) -> Strikeout -> Strikeout
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strikeout -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Strikeout -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strikeout -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Strikeout -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Strikeout -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Strikeout -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strikeout -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Strikeout -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Strikeout -> m Strikeout
Data, Eq Strikeout
Eq Strikeout =>
(Strikeout -> Strikeout -> Ordering)
-> (Strikeout -> Strikeout -> Bool)
-> (Strikeout -> Strikeout -> Bool)
-> (Strikeout -> Strikeout -> Bool)
-> (Strikeout -> Strikeout -> Bool)
-> (Strikeout -> Strikeout -> Strikeout)
-> (Strikeout -> Strikeout -> Strikeout)
-> Ord Strikeout
Strikeout -> Strikeout -> Bool
Strikeout -> Strikeout -> Ordering
Strikeout -> Strikeout -> Strikeout
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Strikeout -> Strikeout -> Ordering
compare :: Strikeout -> Strikeout -> Ordering
$c< :: Strikeout -> Strikeout -> Bool
< :: Strikeout -> Strikeout -> Bool
$c<= :: Strikeout -> Strikeout -> Bool
<= :: Strikeout -> Strikeout -> Bool
$c> :: Strikeout -> Strikeout -> Bool
> :: Strikeout -> Strikeout -> Bool
$c>= :: Strikeout -> Strikeout -> Bool
>= :: Strikeout -> Strikeout -> Bool
$cmax :: Strikeout -> Strikeout -> Strikeout
max :: Strikeout -> Strikeout -> Strikeout
$cmin :: Strikeout -> Strikeout -> Strikeout
min :: Strikeout -> Strikeout -> Strikeout
Ord)
data Foreground = FGDefault | FG Color8 deriving (Int -> Foreground -> ShowS
[Foreground] -> ShowS
Foreground -> String
(Int -> Foreground -> ShowS)
-> (Foreground -> String)
-> ([Foreground] -> ShowS)
-> Show Foreground
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Foreground -> ShowS
showsPrec :: Int -> Foreground -> ShowS
$cshow :: Foreground -> String
show :: Foreground -> String
$cshowList :: [Foreground] -> ShowS
showList :: [Foreground] -> ShowS
Show, Foreground -> Foreground -> Bool
(Foreground -> Foreground -> Bool)
-> (Foreground -> Foreground -> Bool) -> Eq Foreground
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Foreground -> Foreground -> Bool
== :: Foreground -> Foreground -> Bool
$c/= :: Foreground -> Foreground -> Bool
/= :: Foreground -> Foreground -> Bool
Eq, ReadPrec [Foreground]
ReadPrec Foreground
Int -> ReadS Foreground
ReadS [Foreground]
(Int -> ReadS Foreground)
-> ReadS [Foreground]
-> ReadPrec Foreground
-> ReadPrec [Foreground]
-> Read Foreground
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Foreground
readsPrec :: Int -> ReadS Foreground
$creadList :: ReadS [Foreground]
readList :: ReadS [Foreground]
$creadPrec :: ReadPrec Foreground
readPrec :: ReadPrec Foreground
$creadListPrec :: ReadPrec [Foreground]
readListPrec :: ReadPrec [Foreground]
Read, Typeable Foreground
Typeable Foreground =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Foreground -> c Foreground)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Foreground)
-> (Foreground -> Constr)
-> (Foreground -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Foreground))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Foreground))
-> ((forall b. Data b => b -> b) -> Foreground -> Foreground)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Foreground -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Foreground -> r)
-> (forall u. (forall d. Data d => d -> u) -> Foreground -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Foreground -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Foreground -> m Foreground)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Foreground -> m Foreground)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Foreground -> m Foreground)
-> Data Foreground
Foreground -> Constr
Foreground -> DataType
(forall b. Data b => b -> b) -> Foreground -> Foreground
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Foreground -> u
forall u. (forall d. Data d => d -> u) -> Foreground -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Foreground -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Foreground -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Foreground
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Foreground -> c Foreground
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Foreground)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Foreground)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Foreground -> c Foreground
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Foreground -> c Foreground
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Foreground
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Foreground
$ctoConstr :: Foreground -> Constr
toConstr :: Foreground -> Constr
$cdataTypeOf :: Foreground -> DataType
dataTypeOf :: Foreground -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Foreground)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Foreground)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Foreground)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Foreground)
$cgmapT :: (forall b. Data b => b -> b) -> Foreground -> Foreground
gmapT :: (forall b. Data b => b -> b) -> Foreground -> Foreground
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Foreground -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Foreground -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Foreground -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Foreground -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Foreground -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Foreground -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Foreground -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Foreground -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Foreground -> m Foreground
Data, Eq Foreground
Eq Foreground =>
(Foreground -> Foreground -> Ordering)
-> (Foreground -> Foreground -> Bool)
-> (Foreground -> Foreground -> Bool)
-> (Foreground -> Foreground -> Bool)
-> (Foreground -> Foreground -> Bool)
-> (Foreground -> Foreground -> Foreground)
-> (Foreground -> Foreground -> Foreground)
-> Ord Foreground
Foreground -> Foreground -> Bool
Foreground -> Foreground -> Ordering
Foreground -> Foreground -> Foreground
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Foreground -> Foreground -> Ordering
compare :: Foreground -> Foreground -> Ordering
$c< :: Foreground -> Foreground -> Bool
< :: Foreground -> Foreground -> Bool
$c<= :: Foreground -> Foreground -> Bool
<= :: Foreground -> Foreground -> Bool
$c> :: Foreground -> Foreground -> Bool
> :: Foreground -> Foreground -> Bool
$c>= :: Foreground -> Foreground -> Bool
>= :: Foreground -> Foreground -> Bool
$cmax :: Foreground -> Foreground -> Foreground
max :: Foreground -> Foreground -> Foreground
$cmin :: Foreground -> Foreground -> Foreground
min :: Foreground -> Foreground -> Foreground
Ord)
data Background = BGDefault | BG Color8 deriving (Int -> Background -> ShowS
[Background] -> ShowS
Background -> String
(Int -> Background -> ShowS)
-> (Background -> String)
-> ([Background] -> ShowS)
-> Show Background
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Background -> ShowS
showsPrec :: Int -> Background -> ShowS
$cshow :: Background -> String
show :: Background -> String
$cshowList :: [Background] -> ShowS
showList :: [Background] -> ShowS
Show, Background -> Background -> Bool
(Background -> Background -> Bool)
-> (Background -> Background -> Bool) -> Eq Background
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Background -> Background -> Bool
== :: Background -> Background -> Bool
$c/= :: Background -> Background -> Bool
/= :: Background -> Background -> Bool
Eq, ReadPrec [Background]
ReadPrec Background
Int -> ReadS Background
ReadS [Background]
(Int -> ReadS Background)
-> ReadS [Background]
-> ReadPrec Background
-> ReadPrec [Background]
-> Read Background
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Background
readsPrec :: Int -> ReadS Background
$creadList :: ReadS [Background]
readList :: ReadS [Background]
$creadPrec :: ReadPrec Background
readPrec :: ReadPrec Background
$creadListPrec :: ReadPrec [Background]
readListPrec :: ReadPrec [Background]
Read, Typeable Background
Typeable Background =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Background -> c Background)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Background)
-> (Background -> Constr)
-> (Background -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Background))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Background))
-> ((forall b. Data b => b -> b) -> Background -> Background)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Background -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Background -> r)
-> (forall u. (forall d. Data d => d -> u) -> Background -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Background -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Background -> m Background)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Background -> m Background)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Background -> m Background)
-> Data Background
Background -> Constr
Background -> DataType
(forall b. Data b => b -> b) -> Background -> Background
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Background -> u
forall u. (forall d. Data d => d -> u) -> Background -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Background -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Background -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Background -> m Background
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Background -> m Background
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Background
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Background -> c Background
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Background)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Background)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Background -> c Background
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Background -> c Background
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Background
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Background
$ctoConstr :: Background -> Constr
toConstr :: Background -> Constr
$cdataTypeOf :: Background -> DataType
dataTypeOf :: Background -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Background)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Background)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Background)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Background)
$cgmapT :: (forall b. Data b => b -> b) -> Background -> Background
gmapT :: (forall b. Data b => b -> b) -> Background -> Background
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Background -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Background -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Background -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Background -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Background -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Background -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Background -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Background -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Background -> m Background
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Background -> m Background
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Background -> m Background
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Background -> m Background
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Background -> m Background
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Background -> m Background
Data, Eq Background
Eq Background =>
(Background -> Background -> Ordering)
-> (Background -> Background -> Bool)
-> (Background -> Background -> Bool)
-> (Background -> Background -> Bool)
-> (Background -> Background -> Bool)
-> (Background -> Background -> Background)
-> (Background -> Background -> Background)
-> Ord Background
Background -> Background -> Bool
Background -> Background -> Ordering
Background -> Background -> Background
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Background -> Background -> Ordering
compare :: Background -> Background -> Ordering
$c< :: Background -> Background -> Bool
< :: Background -> Background -> Bool
$c<= :: Background -> Background -> Bool
<= :: Background -> Background -> Bool
$c> :: Background -> Background -> Bool
> :: Background -> Background -> Bool
$c>= :: Background -> Background -> Bool
>= :: Background -> Background -> Bool
$cmax :: Background -> Background -> Background
max :: Background -> Background -> Background
$cmin :: Background -> Background -> Background
min :: Background -> Background -> Background
Ord)

data StyleReq
  = RWeight Weight
  | RShape Shape
  | RForeground Foreground
  | RBackground Background
  | RUnderline Underline
  | RStrikeout Strikeout
  deriving (Int -> StyleReq -> ShowS
[StyleReq] -> ShowS
StyleReq -> String
(Int -> StyleReq -> ShowS)
-> (StyleReq -> String) -> ([StyleReq] -> ShowS) -> Show StyleReq
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StyleReq -> ShowS
showsPrec :: Int -> StyleReq -> ShowS
$cshow :: StyleReq -> String
show :: StyleReq -> String
$cshowList :: [StyleReq] -> ShowS
showList :: [StyleReq] -> ShowS
Show, StyleReq -> StyleReq -> Bool
(StyleReq -> StyleReq -> Bool)
-> (StyleReq -> StyleReq -> Bool) -> Eq StyleReq
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StyleReq -> StyleReq -> Bool
== :: StyleReq -> StyleReq -> Bool
$c/= :: StyleReq -> StyleReq -> Bool
/= :: StyleReq -> StyleReq -> Bool
Eq, ReadPrec [StyleReq]
ReadPrec StyleReq
Int -> ReadS StyleReq
ReadS [StyleReq]
(Int -> ReadS StyleReq)
-> ReadS [StyleReq]
-> ReadPrec StyleReq
-> ReadPrec [StyleReq]
-> Read StyleReq
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS StyleReq
readsPrec :: Int -> ReadS StyleReq
$creadList :: ReadS [StyleReq]
readList :: ReadS [StyleReq]
$creadPrec :: ReadPrec StyleReq
readPrec :: ReadPrec StyleReq
$creadListPrec :: ReadPrec [StyleReq]
readListPrec :: ReadPrec [StyleReq]
Read, Typeable StyleReq
Typeable StyleReq =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> StyleReq -> c StyleReq)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c StyleReq)
-> (StyleReq -> Constr)
-> (StyleReq -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c StyleReq))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StyleReq))
-> ((forall b. Data b => b -> b) -> StyleReq -> StyleReq)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> StyleReq -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> StyleReq -> r)
-> (forall u. (forall d. Data d => d -> u) -> StyleReq -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> StyleReq -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> StyleReq -> m StyleReq)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StyleReq -> m StyleReq)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> StyleReq -> m StyleReq)
-> Data StyleReq
StyleReq -> Constr
StyleReq -> DataType
(forall b. Data b => b -> b) -> StyleReq -> StyleReq
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> StyleReq -> u
forall u. (forall d. Data d => d -> u) -> StyleReq -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StyleReq -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StyleReq -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StyleReq
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StyleReq -> c StyleReq
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StyleReq)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StyleReq)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StyleReq -> c StyleReq
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> StyleReq -> c StyleReq
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StyleReq
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c StyleReq
$ctoConstr :: StyleReq -> Constr
toConstr :: StyleReq -> Constr
$cdataTypeOf :: StyleReq -> DataType
dataTypeOf :: StyleReq -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StyleReq)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c StyleReq)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StyleReq)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c StyleReq)
$cgmapT :: (forall b. Data b => b -> b) -> StyleReq -> StyleReq
gmapT :: (forall b. Data b => b -> b) -> StyleReq -> StyleReq
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StyleReq -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> StyleReq -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StyleReq -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> StyleReq -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> StyleReq -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> StyleReq -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StyleReq -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> StyleReq -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> StyleReq -> m StyleReq
Data, Eq StyleReq
Eq StyleReq =>
(StyleReq -> StyleReq -> Ordering)
-> (StyleReq -> StyleReq -> Bool)
-> (StyleReq -> StyleReq -> Bool)
-> (StyleReq -> StyleReq -> Bool)
-> (StyleReq -> StyleReq -> Bool)
-> (StyleReq -> StyleReq -> StyleReq)
-> (StyleReq -> StyleReq -> StyleReq)
-> Ord StyleReq
StyleReq -> StyleReq -> Bool
StyleReq -> StyleReq -> Ordering
StyleReq -> StyleReq -> StyleReq
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: StyleReq -> StyleReq -> Ordering
compare :: StyleReq -> StyleReq -> Ordering
$c< :: StyleReq -> StyleReq -> Bool
< :: StyleReq -> StyleReq -> Bool
$c<= :: StyleReq -> StyleReq -> Bool
<= :: StyleReq -> StyleReq -> Bool
$c> :: StyleReq -> StyleReq -> Bool
> :: StyleReq -> StyleReq -> Bool
$c>= :: StyleReq -> StyleReq -> Bool
>= :: StyleReq -> StyleReq -> Bool
$cmax :: StyleReq -> StyleReq -> StyleReq
max :: StyleReq -> StyleReq -> StyleReq
$cmin :: StyleReq -> StyleReq -> StyleReq
min :: StyleReq -> StyleReq -> StyleReq
Ord)

(~>) :: Font -> StyleReq -> Font
~> :: Font -> StyleReq -> Font
(~>) Font
f (RWeight Weight
w) = Font
f{ftWeight = w}
(~>) Font
f (RShape Shape
s) = Font
f{ftShape = s}
(~>) Font
f (RForeground Foreground
c) = Font
f{ftForeground = c}
(~>) Font
f (RBackground Background
c) = Font
f{ftBackground = c}
(~>) Font
f (RUnderline Underline
u) = Font
f{ftUnderline = u}
(~>) Font
f (RStrikeout Strikeout
u) = Font
f{ftStrikeout = u}

rawSGR :: (Semigroup a, IsString a) => a -> a
rawSGR :: forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
n = a
"\ESC[" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
n a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"m"

class SGR b where
  renderSGR :: (Semigroup a, IsString a) => b -> a

instance SGR Weight where
  renderSGR :: forall a. (Semigroup a, IsString a) => Weight -> a
renderSGR Weight
Normal = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"22"
  renderSGR Weight
Bold = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"1"

instance SGR Shape where
  renderSGR :: forall a. (Semigroup a, IsString a) => Shape -> a
renderSGR Shape
Roman = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"23"
  renderSGR Shape
Italic = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"3"

instance SGR Foreground where
  renderSGR :: forall a. (Semigroup a, IsString a) => Foreground -> a
renderSGR Foreground
FGDefault = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"39"
  renderSGR (FG Color8
a) = (a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR (a -> a) -> (Color8 -> a) -> Color8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (Color8 -> String) -> Color8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Color8 -> Int) -> Color8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
30 (Int -> Int) -> (Color8 -> Int) -> Color8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color8 -> Int
forall a. Enum a => a -> Int
fromEnum) Color8
a

instance SGR Background where
  renderSGR :: forall a. (Semigroup a, IsString a) => Background -> a
renderSGR Background
BGDefault = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"49"
  renderSGR (BG Color8
a) = (a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR (a -> a) -> (Color8 -> a) -> Color8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString (String -> a) -> (Color8 -> String) -> Color8 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String
forall a. Show a => a -> String
show (Int -> String) -> (Color8 -> Int) -> Color8 -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
(+) Int
40 (Int -> Int) -> (Color8 -> Int) -> Color8 -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Color8 -> Int
forall a. Enum a => a -> Int
fromEnum) Color8
a

instance SGR Underline where
  renderSGR :: forall a. (Semigroup a, IsString a) => Underline -> a
renderSGR Underline
ULNone = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"24"
  renderSGR Underline
ULSingle = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"4"
  renderSGR Underline
ULDouble = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"21"
  renderSGR Underline
ULCurly = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"4:3"

instance SGR Strikeout where
  renderSGR :: forall a. (Semigroup a, IsString a) => Strikeout -> a
renderSGR Strikeout
Unstruck = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"29"
  renderSGR Strikeout
Struck = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"9"

renderFont :: (Semigroup a, IsString a) => Font -> a
renderFont :: forall a. (Semigroup a, IsString a) => Font -> a
renderFont Font
f
  | Font
f Font -> Font -> Bool
forall a. Eq a => a -> a -> Bool
== Font
baseFont = a -> a
forall a. (Semigroup a, IsString a) => a -> a
rawSGR a
"0"
  | Bool
otherwise =
      Weight -> a
forall a. (Semigroup a, IsString a) => Weight -> a
forall b a. (SGR b, Semigroup a, IsString a) => b -> a
renderSGR (Font -> Weight
ftWeight Font
f)
        a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Shape -> a
forall a. (Semigroup a, IsString a) => Shape -> a
forall b a. (SGR b, Semigroup a, IsString a) => b -> a
renderSGR (Font -> Shape
ftShape Font
f)
        a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Foreground -> a
forall a. (Semigroup a, IsString a) => Foreground -> a
forall b a. (SGR b, Semigroup a, IsString a) => b -> a
renderSGR (Font -> Foreground
ftForeground Font
f)
        a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Background -> a
forall a. (Semigroup a, IsString a) => Background -> a
forall b a. (SGR b, Semigroup a, IsString a) => b -> a
renderSGR (Font -> Background
ftBackground Font
f)
        a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Underline -> a
forall a. (Semigroup a, IsString a) => Underline -> a
forall b a. (SGR b, Semigroup a, IsString a) => b -> a
renderSGR (Font -> Underline
ftUnderline Font
f)
        a -> a -> a
forall a. Semigroup a => a -> a -> a
<> Strikeout -> a
forall a. (Semigroup a, IsString a) => Strikeout -> a
forall b a. (SGR b, Semigroup a, IsString a) => b -> a
renderSGR (Font -> Strikeout
ftStrikeout Font
f)

renderOSC8 :: (Semigroup a, IsString a) => Maybe a -> a
renderOSC8 :: forall a. (Semigroup a, IsString a) => Maybe a -> a
renderOSC8 Maybe a
Nothing = a
"\ESC]8;;\ESC\\"
renderOSC8 (Just a
t) = a
"\ESC]8;;" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
t a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
"\ESC\\"