    {-# LANGUAGE CPP #-}
    #if __GLASGOW_HASKELL__ >= 703
    {-# LANGUAGE Safe #-}
    #endif
    -- |
    -- Maintainer  : judah.jacobson@gmail.com
    -- Stability   : experimental
    -- Portability : portable (FFI)
    module System.Console.Terminfo.Effects(
                        -- * Bell alerts
                        bell,visualBell,
                        -- * Text attributes
                        Attributes(..),
                        defaultAttributes,
                        withAttributes,
                        setAttributes,
                        allAttributesOff,
                        -- ** Mode wrappers
                        withStandout,
                        withUnderline,
                        withBold,
                        -- ** Low-level capabilities
                        enterStandoutMode,
                        exitStandoutMode,
                        enterUnderlineMode,
                        exitUnderlineMode,
                        reverseOn,
                        blinkOn,
                        boldOn,
                        dimOn,
                        invisibleOn,
                        protectedOn
                        ) where

    import System.Console.Terminfo.Base
    import Control.Monad

    wrapWith :: TermStr s => Capability s -> Capability s -> Capability (s -> s)
    wrapWith :: forall s.
    TermStr s =>
    Capability s -> Capability s -> Capability (s -> s)
    wrapWith Capability s
    start Capability s
    end = do
        s
    s <- Capability s
    start
        s
    e <- Capability s
    end
        (s -> s) -> Capability (s -> s)
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (\s
    t -> s
    s s -> s -> s
    forall m. Monoid m => m -> m -> m
    <#> s
    t s -> s -> s
    forall m. Monoid m => m -> m -> m
    <#> s
    e)

    -- | Turns on standout mode before outputting the given
    -- text, and then turns it off.
    withStandout :: TermStr s => Capability (s -> s)
    withStandout :: forall s. TermStr s => Capability (s -> s)
    withStandout = Capability s -> Capability s -> Capability (s -> s)
    forall s.
    TermStr s =>
    Capability s -> Capability s -> Capability (s -> s)
    wrapWith Capability s
    forall s. TermStr s => Capability s
    enterStandoutMode Capability s
    forall s. TermStr s => Capability s
    exitStandoutMode

    -- | Turns on underline mode before outputting the given
    -- text, and then turns it off.
    withUnderline :: TermStr s => Capability (s -> s)
    withUnderline :: forall s. TermStr s => Capability (s -> s)
    withUnderline = Capability s -> Capability s -> Capability (s -> s)
    forall s.
    TermStr s =>
    Capability s -> Capability s -> Capability (s -> s)
    wrapWith Capability s
    forall s. TermStr s => Capability s
    enterUnderlineMode Capability s
    forall s. TermStr s => Capability s
    exitUnderlineMode

    -- | Turns on bold mode before outputting the given text, and then turns
    -- all attributes off.
    withBold :: TermStr s => Capability (s -> s)
    withBold :: forall s. TermStr s => Capability (s -> s)
    withBold = Capability s -> Capability s -> Capability (s -> s)
    forall s.
    TermStr s =>
    Capability s -> Capability s -> Capability (s -> s)
    wrapWith Capability s
    forall s. TermStr s => Capability s
    boldOn Capability s
    forall s. TermStr s => Capability s
    allAttributesOff

    enterStandoutMode :: TermStr s => Capability s
    enterStandoutMode :: forall s. TermStr s => Capability s
    enterStandoutMode = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "smso"

    exitStandoutMode :: TermStr s => Capability s
    exitStandoutMode :: forall s. TermStr s => Capability s
    exitStandoutMode = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "rmso"

    enterUnderlineMode :: TermStr s => Capability s
    enterUnderlineMode :: forall s. TermStr s => Capability s
    enterUnderlineMode = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "smul"

    exitUnderlineMode :: TermStr s => Capability s
    exitUnderlineMode :: forall s. TermStr s => Capability s
    exitUnderlineMode = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "rmul"

    reverseOn :: TermStr s => Capability s
    reverseOn :: forall s. TermStr s => Capability s
    reverseOn = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "rev"

    blinkOn:: TermStr s => Capability s
    blinkOn :: forall s. TermStr s => Capability s
    blinkOn = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "blink"

    boldOn :: TermStr s => Capability s
    boldOn :: forall s. TermStr s => Capability s
    boldOn = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "bold"

    dimOn :: TermStr s => Capability s
    dimOn :: forall s. TermStr s => Capability s
    dimOn = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "dim"

    invisibleOn :: TermStr s => Capability s
    invisibleOn :: forall s. TermStr s => Capability s
    invisibleOn = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "invis"

    protectedOn :: TermStr s => Capability s
    protectedOn :: forall s. TermStr s => Capability s
    protectedOn = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "prot"

    -- | Turns off all text attributes.  This capability will always succeed, but it has
    -- no effect in terminals which do not support text attributes.
    allAttributesOff :: TermStr s => Capability s
    allAttributesOff :: forall s. TermStr s => Capability s
    allAttributesOff = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "sgr0" Capability s -> Capability s -> Capability s
    forall a. Capability a -> Capability a -> Capability a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` s -> Capability s
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return s
    forall a. Monoid a => a
    mempty

    data Attributes = Attributes {
                        Attributes -> Bool
    standoutAttr,
                        Attributes -> Bool
    underlineAttr,
                        Attributes -> Bool
    reverseAttr,
                        Attributes -> Bool
    blinkAttr,
                        Attributes -> Bool
    dimAttr,
                        Attributes -> Bool
    boldAttr,
                        Attributes -> Bool
    invisibleAttr,
                        Attributes -> Bool
    protectedAttr :: Bool
                    -- NB: I'm not including the "alternate character set."
                    }

    -- | Sets the attributes on or off before outputting the given text,
    -- and then turns them all off.  This capability will always succeed; properties
    -- which cannot be set in the current terminal will be ignored.
    withAttributes :: TermStr s => Capability (Attributes -> s -> s)
    withAttributes :: forall s. TermStr s => Capability (Attributes -> s -> s)
    withAttributes = do
        Attributes -> s
    set <- Capability (Attributes -> s)
    forall s. TermStr s => Capability (Attributes -> s)
    setAttributes
        s
    off <- Capability s
    forall s. TermStr s => Capability s
    allAttributesOff
        (Attributes -> s -> s) -> Capability (Attributes -> s -> s)
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Attributes -> s -> s) -> Capability (Attributes -> s -> s))
    -> (Attributes -> s -> s) -> Capability (Attributes -> s -> s)
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    attrs s
    to -> Attributes -> s
    set Attributes
    attrs s -> s -> s
    forall m. Monoid m => m -> m -> m
    <#> s
    to s -> s -> s
    forall m. Monoid m => m -> m -> m
    <#> s
    off

    -- | Sets the attributes on or off.  This capability will always succeed;
    -- properties which cannot be set in the current terminal will be ignored.
    setAttributes :: TermStr s => Capability (Attributes -> s)
    setAttributes :: forall s. TermStr s => Capability (Attributes -> s)
    setAttributes = Capability (Attributes -> s)
    usingSGR0 Capability (Attributes -> s)
    -> Capability (Attributes -> s) -> Capability (Attributes -> s)
    forall a. Capability a -> Capability a -> Capability a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` Capability (Attributes -> s)
    manualSets
        where
            usingSGR0 :: Capability (Attributes -> s)
    usingSGR0 = do
                Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> s
    sgr <- String
    -> Capability
         (Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> s)
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "sgr"
                (Attributes -> s) -> Capability (Attributes -> s)
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Attributes -> s) -> Capability (Attributes -> s))
    -> (Attributes -> s) -> Capability (Attributes -> s)
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    a -> let mkAttr :: (Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    f = if Attributes -> Bool
    f Attributes
    a then Int
    1 else Int
    0 :: Int
                               in Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> Int -> s
    sgr ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    standoutAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    underlineAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    reverseAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    blinkAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    dimAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    boldAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    invisibleAttr)
                                      ((Attributes -> Bool) -> Int
    mkAttr Attributes -> Bool
    protectedAttr)
                                      (Int
    0::Int) -- for alt. character sets
            attrCap :: TermStr s => (Attributes -> Bool) -> Capability s
                        -> Capability (Attributes -> s)
            attrCap :: forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    f Capability s
    cap = do {s
    to <- Capability s
    cap; (Attributes -> s) -> Capability (Attributes -> s)
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Attributes -> s) -> Capability (Attributes -> s))
    -> (Attributes -> s) -> Capability (Attributes -> s)
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    a -> if Attributes -> Bool
    f Attributes
    a then s
    to else s
    forall a. Monoid a => a
    mempty}
                            Capability (Attributes -> s)
    -> Capability (Attributes -> s) -> Capability (Attributes -> s)
    forall a. Capability a -> Capability a -> Capability a
    forall (m :: * -> *) a. MonadPlus m => m a -> m a -> m a
    `mplus` (Attributes -> s) -> Capability (Attributes -> s)
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (s -> Attributes -> s
    forall a b. a -> b -> a
    const s
    forall a. Monoid a => a
    mempty)
            manualSets :: Capability (Attributes -> s)
    manualSets = do
                [Attributes -> s]
    cs <- [Capability (Attributes -> s)] -> Capability [Attributes -> s]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [(Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    standoutAttr Capability s
    forall s. TermStr s => Capability s
    enterStandoutMode
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    underlineAttr Capability s
    forall s. TermStr s => Capability s
    enterUnderlineMode
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    reverseAttr Capability s
    forall s. TermStr s => Capability s
    reverseOn
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    blinkAttr Capability s
    forall s. TermStr s => Capability s
    blinkOn
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    boldAttr Capability s
    forall s. TermStr s => Capability s
    boldOn
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    dimAttr Capability s
    forall s. TermStr s => Capability s
    dimOn
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    invisibleAttr Capability s
    forall s. TermStr s => Capability s
    invisibleOn
                                , (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    forall s.
    TermStr s =>
    (Attributes -> Bool)
    -> Capability s -> Capability (Attributes -> s)
    attrCap Attributes -> Bool
    protectedAttr Capability s
    forall s. TermStr s => Capability s
    protectedOn
                                ]
                (Attributes -> s) -> Capability (Attributes -> s)
    forall a. a -> Capability a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Attributes -> s) -> Capability (Attributes -> s))
    -> (Attributes -> s) -> Capability (Attributes -> s)
    forall a b. (a -> b) -> a -> b
    $ \Attributes
    a -> [s] -> s
    forall a. Monoid a => [a] -> a
    mconcat ([s] -> s) -> [s] -> s
    forall a b. (a -> b) -> a -> b
    $ ((Attributes -> s) -> s) -> [Attributes -> s] -> [s]
    forall a b. (a -> b) -> [a] -> [b]
    map ((Attributes -> s) -> Attributes -> s
    forall a b. (a -> b) -> a -> b
    $ Attributes
    a) [Attributes -> s]
    cs

    -- | These attributes have all properties turned off.
    defaultAttributes :: Attributes
    defaultAttributes :: Attributes
    defaultAttributes = Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Bool
    -> Attributes
    Attributes Bool
    False Bool
    False Bool
    False Bool
    False Bool
    False Bool
    False Bool
    False Bool
    False

    -- | Sound the audible bell.
    bell :: TermStr s => Capability s
    bell :: forall s. TermStr s => Capability s
    bell = String -> Capability s
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "bel"

    -- | Present a visual alert using the @flash@ capability.
    visualBell :: Capability TermOutput
    visualBell :: Capability TermOutput
    visualBell = String -> Capability TermOutput
    forall f. OutputCap f => String -> Capability f
    tiGetOutput1 String
    "flash"