{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 703
{-# LANGUAGE Safe #-}
#endif
-- |
-- Maintainer  : judah.jacobson@gmail.com
-- Stability   : experimental
-- Portability : portable (FFI)
module System.Console.Terminfo.Edit where

import System.Console.Terminfo.Base

-- | Clear the screen, and move the cursor to the upper left.
clearScreen :: Capability (LinesAffected -> TermOutput)
clearScreen :: Capability (LinesAffected -> TermOutput)
clearScreen = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ []) forall a b. (a -> b) -> a -> b
$ String
-> Capability ([LinesAffected] -> LinesAffected -> TermOutput)
tiGetOutput String
"clear" 

-- | Clear from beginning of line to cursor.
clearBOL :: TermStr s => Capability s
clearBOL :: forall s. TermStr s => Capability s
clearBOL = forall f. OutputCap f => String -> Capability f
tiGetOutput1 String
"el1"

-- | Clear from cursor to end of line.
clearEOL :: TermStr s => Capability s
clearEOL :: forall s. TermStr s => Capability s
clearEOL = forall f. OutputCap f => String -> Capability f
tiGetOutput1 String
"el"

-- | Clear display after cursor.
clearEOS :: Capability (LinesAffected -> TermOutput)
clearEOS :: Capability (LinesAffected -> TermOutput)
clearEOS = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a b. (a -> b) -> a -> b
$ []) forall a b. (a -> b) -> a -> b
$ String
-> Capability ([LinesAffected] -> LinesAffected -> TermOutput)
tiGetOutput String
"ed"