module Rainbow.Types where
import qualified Data.String as Str
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as X
import qualified Data.Text.Lazy as XL
import Data.Word (Word8)
import GHC.Generics
import Data.Typeable
type Background8 = Last Color8
type Background256 = Last Color256
type Foreground8 = Last Color8
type Foreground256 = Last Color256
data Enum8
= E0
| E1
| E2
| E3
| E4
| E5
| E6
| E7
deriving (Eq, Ord, Show, Bounded, Enum, Generic, Typeable)
enum8toWord8 :: Enum8 -> Word8
enum8toWord8 e = case e of
E0 -> 0
E1 -> 1
E2 -> 2
E3 -> 3
E4 -> 4
E5 -> 5
E6 -> 6
E7 -> 7
newtype Color8 = Color8
{ unColor8 :: Maybe Enum8
} deriving (Eq, Ord, Show, Generic, Typeable)
newtype Color256 = Color256
{ unColor256 :: Maybe Word8
} deriving (Eq, Ord, Show, Generic, Typeable)
to256 :: Color8 -> Color256
to256 (Color8 mayE) = Color256 $ fmap enum8toWord8 mayE
data StyleCommon = StyleCommon
{ scBold :: Last Bool
, scFaint :: Last Bool
, scItalic :: Last Bool
, scUnderline :: Last Bool
, scBlink :: Last Bool
, scInverse :: Last Bool
, scInvisible :: Last Bool
, scStrikeout :: Last Bool
} deriving (Show, Eq, Ord, Generic, Typeable)
instance Monoid StyleCommon where
mempty = StyleCommon (Last Nothing) (Last Nothing)
(Last Nothing) (Last Nothing)
(Last Nothing) (Last Nothing)
(Last Nothing) (Last Nothing)
mappend (StyleCommon x1 x2 x3 x4 x5 x6 x7 x8)
(StyleCommon y1 y2 y3 y4 y5 y6 y7 y8)
= StyleCommon (x1 <> y1) (x2 <> y2) (x3 <> y3) (x4 <> y4)
(x5 <> y5) (x6 <> y6) (x7 <> y7) (x8 <> y8)
data Style8 = Style8
{ foreground8 :: Foreground8
, background8 :: Background8
, common8 :: StyleCommon
} deriving (Show, Eq, Ord, Generic, Typeable)
instance Monoid Style8 where
mappend (Style8 fx bx cx) (Style8 fy by cy)
= Style8 (fx <> fy) (bx <> by) (cx <> cy)
mempty = Style8 mempty mempty mempty
data Style256 = Style256
{ foreground256 :: Foreground256
, background256 :: Background256
, common256 :: StyleCommon
} deriving (Show, Eq, Ord, Generic, Typeable)
instance Monoid Style256 where
mappend (Style256 fx bx cx) (Style256 fy by cy)
= Style256 (fx <> fy) (bx <> by) (cx <> cy)
mempty = Style256 mempty mempty mempty
data TextSpec = TextSpec
{ style8 :: Style8
, style256 :: Style256
} deriving (Show, Eq, Ord, Generic, Typeable)
instance Monoid TextSpec where
mappend (TextSpec x1 x2) (TextSpec y1 y2)
= TextSpec (x1 <> y1) (x2 <> y2)
mempty = TextSpec mempty mempty
data Chunk = Chunk
{ chunkTextSpec :: TextSpec
, chunkTexts :: [Text]
} deriving (Eq, Show, Ord, Generic, Typeable)
instance Str.IsString Chunk where
fromString s = Chunk mempty [(X.pack s)]
chunkFromText :: X.Text -> Chunk
chunkFromText = Chunk mempty . (:[])
chunkFromTexts :: [X.Text] -> Chunk
chunkFromTexts = Chunk mempty
chunkFromLazyText :: XL.Text -> Chunk
chunkFromLazyText = Chunk mempty . XL.toChunks
chunkFromLazyTexts :: [XL.Text] -> Chunk
chunkFromLazyTexts = Chunk mempty . concatMap XL.toChunks
instance Monoid Chunk where
mempty = Chunk mempty mempty
mappend (Chunk s1 t1) (Chunk s2 t2) = Chunk (s1 <> s2) (t1 <> t2)
bold8 :: Chunk
bold8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scBold = Last (Just True) }}}}
where
x = mempty
bold8off :: Chunk
bold8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scBold = Last (Just False) }}}}
where
x = mempty
faint8 :: Chunk
faint8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scFaint = Last (Just True) }}}}
where
x = mempty
faint8off :: Chunk
faint8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scFaint = Last (Just False) }}}}
where
x = mempty
italic8 :: Chunk
italic8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scItalic = Last (Just True) }}}}
where
x = mempty
italic8off :: Chunk
italic8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scItalic = Last (Just False) }}}}
where
x = mempty
underline8 :: Chunk
underline8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scUnderline = Last (Just True) }}}}
where
x = mempty
underline8off :: Chunk
underline8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scUnderline = Last (Just False) }}}}
where
x = mempty
blink8 :: Chunk
blink8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scBlink = Last (Just True) }}}}
where
x = mempty
blink8off :: Chunk
blink8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scBlink = Last (Just False) }}}}
where
x = mempty
inverse8 :: Chunk
inverse8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scInverse = Last (Just True) }}}}
where
x = mempty
inverse8off :: Chunk
inverse8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scInverse = Last (Just False) }}}}
where
x = mempty
invisible8 :: Chunk
invisible8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scInvisible = Last (Just True) }}}}
where
x = mempty
invisible8off :: Chunk
invisible8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scInvisible = Last (Just False) }}}}
where
x = mempty
strikeout8 :: Chunk
strikeout8 = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scStrikeout = Last (Just True) }}}}
where
x = mempty
strikeout8off :: Chunk
strikeout8off = x {
chunkTextSpec = (chunkTextSpec x) {
style8 = (style8 (chunkTextSpec x)) {
common8 = (common8 (style8 (chunkTextSpec x))) {
scStrikeout = Last (Just False) }}}}
where
x = mempty
bold256 :: Chunk
bold256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scBold = Last (Just True) }}}}
where
x = mempty
bold256off :: Chunk
bold256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scBold = Last (Just False) }}}}
where
x = mempty
faint256 :: Chunk
faint256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scFaint = Last (Just True) }}}}
where
x = mempty
faint256off :: Chunk
faint256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scFaint = Last (Just False) }}}}
where
x = mempty
italic256 :: Chunk
italic256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scItalic = Last (Just True) }}}}
where
x = mempty
italic256off :: Chunk
italic256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scItalic = Last (Just False) }}}}
where
x = mempty
underline256 :: Chunk
underline256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scUnderline = Last (Just True) }}}}
where
x = mempty
underline256off :: Chunk
underline256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scUnderline = Last (Just False) }}}}
where
x = mempty
blink256 :: Chunk
blink256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scBlink = Last (Just True) }}}}
where
x = mempty
blink256off :: Chunk
blink256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scBlink = Last (Just False) }}}}
where
x = mempty
inverse256 :: Chunk
inverse256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scInverse = Last (Just True) }}}}
where
x = mempty
inverse256off :: Chunk
inverse256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scInverse = Last (Just False) }}}}
where
x = mempty
invisible256 :: Chunk
invisible256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scInvisible = Last (Just True) }}}}
where
x = mempty
invisible256off :: Chunk
invisible256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scInvisible = Last (Just False) }}}}
where
x = mempty
strikeout256 :: Chunk
strikeout256 = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scStrikeout = Last (Just True) }}}}
where
x = mempty
strikeout256off :: Chunk
strikeout256off = x {
chunkTextSpec = (chunkTextSpec x) {
style256 = (style256 (chunkTextSpec x)) {
common256 = (common256 (style256 (chunkTextSpec x))) {
scStrikeout = Last (Just False) }}}}
where
x = mempty
bold :: Chunk
bold = bold8 <> bold256
boldOff :: Chunk
boldOff = bold8off <> bold256off
faint :: Chunk
faint = faint8 <> faint256
faintOff :: Chunk
faintOff = faint8off <> faint256off
italic :: Chunk
italic = italic8 <> italic256
italicOff :: Chunk
italicOff = italic8off <> italic256off
underline :: Chunk
underline = underline8 <> underline256
underlineOff :: Chunk
underlineOff = underline8off <> underline256off
blink :: Chunk
blink = blink8 <> blink256
blinkOff :: Chunk
blinkOff = blink8off <> blink256off
inverse :: Chunk
inverse = inverse8 <> inverse256
inverseOff :: Chunk
inverseOff = inverse8off <> inverse256off
invisible :: Chunk
invisible = invisible8 <> invisible256
invisibleOff :: Chunk
invisibleOff = invisible8off <> invisible256off
strikeout :: Chunk
strikeout = strikeout8 <> strikeout256
strikeoutOff :: Chunk
strikeoutOff = strikeout8off <> strikeout256off