module Data.Monoid.Colorful.Nested (
Style(..)
, Color(..)
, Term(..)
, Colored(..)
, hGetTerm
, getTerm
, hPrintColored
, printColored
, hPrintColoredIO
, printColoredIO
, hPrintColoredS
, printColoredS
, showColored
, showColoredM
, showColoredS
) where
import System.IO (Handle)
import Data.Monoid.Colorful.Term
import Data.Monoid.Colorful.Color
import Data.Monoid.Colorful.SGR
import Data.Monoid.Colorful.Trustworthy
import Data.String (IsString(..))
import Data.Semigroup (Semigroup)
import GHC.Generics (Generic, Generic1)
import qualified Data.Monoid.Colorful.Flat as Flat
import Control.Monad (ap)
data Colored a
= Nil
| Value a
| Style !Style (Colored a)
| Unstyle !Style (Colored a)
| Fg !Color (Colored a)
| Bg !Color (Colored a)
| Pair (Colored a) (Colored a)
deriving (Eq, Ord, Show, Read, Functor, Foldable, Traversable, Generic, Generic1)
instance Applicative Colored where
pure = Value
(<*>) = ap
instance Monad Colored where
Nil >>= _ = Nil
Value x >>= f = f x
Style a x >>= f = Style a (x >>= f)
Unstyle a x >>= f = Unstyle a (x >>= f)
Fg a x >>= f = Fg a (x >>= f)
Bg a x >>= f = Bg a (x >>= f)
Pair x y >>= f = Pair (x >>= f) (y >>= f)
instance Semigroup (Colored a)
instance Monoid (Colored a) where
mempty = Nil
mappend = Pair
instance IsString a => IsString (Colored a) where
fromString = Value . fromString
instance IsList (Colored a) where
type Item (Colored a) = Colored a
fromList = foldr Pair Nil
toList = (:[])
flatten :: Colored a -> [Flat.Colored a]
flatten s = go s []
where go (Value a) = (Flat.Value a:)
go (Style a b) = (Flat.Push:) . (Flat.Style a:) . go b . (Flat.Pop:)
go (Unstyle a b) = (Flat.Push:) . (Flat.Unstyle a:) . go b . (Flat.Pop:)
go (Fg a b) = (Flat.Push:) . (Flat.Fg a:) . go b . (Flat.Pop:)
go (Bg a b) = (Flat.Push:) . (Flat.Bg a:) . go b . (Flat.Pop:)
go Nil = id
go (Pair a b) = go a . go b
hPrintColoredIO :: Handle -> Term -> Colored (IO ()) -> IO ()
hPrintColoredIO h t = Flat.hPrintColoredIO h t . flatten
printColoredIO :: Term -> Colored (IO ()) -> IO ()
printColoredIO t = Flat.printColoredIO t . flatten
hPrintColored :: (Handle -> a -> IO ()) -> Handle -> Term -> Colored a -> IO ()
hPrintColored f h t = Flat.hPrintColored f h t . flatten
printColored :: (a -> IO ()) -> Term -> Colored a -> IO ()
printColored f t = Flat.printColored f t . flatten
hPrintColoredS :: Handle -> Term -> Colored String -> IO ()
hPrintColoredS h t = Flat.hPrintColoredS h t . flatten
printColoredS :: Term -> Colored String -> IO ()
printColoredS t = Flat.printColoredS t . flatten
showColoredM :: (Monad f, Monoid o) => (a -> f o) -> (SGRCode -> f o) -> Term -> Colored a -> f o
showColoredM f g t = Flat.showColoredM f g t . flatten
showColored :: Monoid o => (a -> o) -> (SGRCode -> o) -> Term -> Colored a -> o
showColored f g t = Flat.showColored f g t . flatten
showColoredS :: Term -> Colored String -> ShowS
showColoredS t = Flat.showColoredS t . flatten