    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 703
    {-# LANGUAGE Safe #-}
    #endif
    -- |
    -- Maintainer  : judah.jacobson@gmail.com
    -- Stability   : experimental
    -- Portability : portable (FFI)
    module System.Console.Terminfo.Color(
                        termColors,
                        Color(..),
                        -- ColorPair,
                        withForegroundColor,
                        withBackgroundColor,
                        -- withColorPair,
                        setForegroundColor,
                        setBackgroundColor,
                        -- setColorPair,
                        restoreDefaultColors
                        ) where

    import System.Console.Terminfo.Base
    import Control.Monad (mplus)

    -- TODOs:
    -- examples
    -- try with xterm-256-colors (?)
    -- Color pairs, and HP terminals.
    -- TODO: this "white" looks more like a grey.  (What does ncurses do?)

    -- NB: for all the terminals in ncurses' terminfo.src, colors>=8 when it's
    -- set.  So we don't need to perform that check.

    -- | The maximum number of of colors on the screen.
    termColors :: Capability Int
    termColors :: Capability Int
    termColors = String -> Capability Int
    tiGetNum String
    "colors"

    data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan
                | White | ColorNumber Int
            deriving (Int -> Color -> ShowS
    [Color] -> ShowS
    Color -> String
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Color] -> ShowS
    $cshowList :: [Color] -> ShowS
    show :: Color -> String
    $cshow :: Color -> String
    showsPrec :: Int -> Color -> ShowS
    $cshowsPrec :: Int -> Color -> ShowS
    Show,Color -> Color -> Bool
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Color -> Color -> Bool
    $c/= :: Color -> Color -> Bool
    == :: Color -> Color -> Bool
    $c== :: Color -> Color -> Bool
    Eq,Eq Color
    Color -> Color -> Bool
    Color -> Color -> Ordering
    Color -> Color -> Color
    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
    min :: Color -> Color -> Color
    $cmin :: Color -> Color -> Color
    max :: Color -> Color -> Color
    $cmax :: Color -> Color -> Color
    >= :: Color -> Color -> Bool
    $c>= :: Color -> Color -> Bool
    > :: Color -> Color -> Bool
    $c> :: Color -> Color -> Bool
    <= :: Color -> Color -> Bool
    $c<= :: Color -> Color -> Bool
    < :: Color -> Color -> Bool
    $c< :: Color -> Color -> Bool
    compare :: Color -> Color -> Ordering
    $ccompare :: Color -> Color -> Ordering
    Ord)

    colorIntA, colorInt :: Color -> Int
    colorIntA :: Color -> Int
    colorIntA Color
    c = case Color
    c of
        Color
    Black -> Int
    0
        Color
    Red -> Int
    1
        Color
    Green -> Int
    2
        Color
    Yellow -> Int
    3
        Color
    Blue -> Int
    4
        Color
    Magenta -> Int
    5
        Color
    Cyan -> Int
    6
        Color
    White -> Int
    7
        ColorNumber Int
    n -> Int
    n
    colorInt :: Color -> Int
    colorInt Color
    c = case Color
    c of
        Color
    Black -> Int
    0
        Color
    Blue -> Int
    1
        Color
    Green -> Int
    2
        Color
    Cyan -> Int
    3
        Color
    Red -> Int
    4
        Color
    Magenta -> Int
    5
        Color
    Yellow -> Int
    6
        Color
    White -> Int
    7
        ColorNumber Int
    n -> Int
    n

    -- NB these aren't available on HP systems.
    -- also do we want to handle case when they're not available?

    -- | This capability temporarily sets the
    -- terminal's foreground color while outputting the given text, and
    -- then restores the terminal to its default foreground and background
    -- colors.
    withForegroundColor :: TermStr s => Capability (Color -> s -> s)
    withForegroundColor :: forall s. TermStr s => Capability (Color -> s -> s)
    withForegroundColor = forall s a.
    TermStr s =>
    Capability (a -> s) -> Capability (a -> s -> s)
    withColorCmd forall s. TermStr s => Capability (Color -> s)
    setForegroundColor

    -- | This capability temporarily sets the
    -- terminal's background color while outputting the given text, and
    -- then restores the terminal to its default foreground and background
    -- colors.
    withBackgroundColor :: TermStr s => Capability (Color -> s -> s)
    withBackgroundColor :: forall s. TermStr s => Capability (Color -> s -> s)
    withBackgroundColor = forall s a.
    TermStr s =>
    Capability (a -> s) -> Capability (a -> s -> s)
    withColorCmd forall s. TermStr s => Capability (Color -> s)
    setBackgroundColor

    withColorCmd :: TermStr s => Capability (a -> s)
                -> Capability (a -> s -> s)
    withColorCmd :: forall s a.
    TermStr s =>
    Capability (a -> s) -> Capability (a -> s -> s)
    withColorCmd Capability (a -> s)
    getSet = do
        a -> s
    set <- Capability (a -> s)
    getSet
        s
    restore <- forall s. TermStr s => Capability s
    restoreDefaultColors
        forall (m :: * -> *) a. Monad m => a -> m a
    return forall a b. (a -> b) -> a -> b
    $ \a
    c s
    t -> a -> s
    set a
    c forall m. Monoid m => m -> m -> m
    <#> s
    t forall m. Monoid m => m -> m -> m
    <#> s
    restore

    -- | Sets the foreground color of all further text output, using
    -- either the @setaf@ or @setf@ capability.
    setForegroundColor :: TermStr s => Capability (Color -> s)
    setForegroundColor :: forall s. TermStr s => Capability (Color -> s)
    setForegroundColor = Capability (Color -> s)
    setaf forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Capability (Color -> s)
    setf
        where
            setaf :: Capability (Color -> s)
    setaf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> Int
    colorIntA) forall a b. (a -> b) -> a -> b
    $ forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "setaf"
            setf :: Capability (Color -> s)
    setf = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> Int
    colorInt) forall a b. (a -> b) -> a -> b
    $ forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "setf"

    -- | Sets the background color of all further text output, using
    -- either the @setab@ or @setb@ capability.
    setBackgroundColor :: TermStr s => Capability (Color -> s)
    setBackgroundColor :: forall s. TermStr s => Capability (Color -> s)
    setBackgroundColor = Capability (Color -> s)
    setab forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Capability (Color -> s)
    setb
        where
            setab :: Capability (Color -> s)
    setab = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> Int
    colorIntA) forall a b. (a -> b) -> a -> b
    $ forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "setab"
            setb :: Capability (Color -> s)
    setb = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Color -> Int
    colorInt) forall a b. (a -> b) -> a -> b
    $ forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "setb"

    {-
    withColorPair :: TermStr s => Capability (ColorPair -> s -> s)
    withColorPair = withColorCmd setColorPair

    setColorPair :: TermStr s => Capability (ColorPair -> s)
    setColorPair = do
        setf <- setForegroundColor
        setb <- setBackgroundColor
        return (\(f,b) -> setf f <#> setb b)

    type ColorPair = (Color,Color)
    -}

    -- | Restores foreground/background colors to their original
    -- settings.
    restoreDefaultColors :: TermStr s => Capability s
    restoreDefaultColors :: forall s. TermStr s => Capability s
    restoreDefaultColors = forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "op"