    -- |
    -- Module      : Basement.Terminal.ANSI
    -- License     : BSD-style
    -- Maintainer  : Vincent Hanquez <vincent@snarc.org>
    --
    -- ANSI Terminal escape for cursor and attributes manipulations
    --
    -- On Unix system, it should be supported by most terminal emulators.
    --
    -- On Windows system, all escape sequences are empty for maximum
    -- compatibility purpose, and easy implementation. newer version
    -- of Windows 10 supports ANSI escape now, but we'll need
    -- some kind of detection.
    --
    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DataKinds #-}
    {-# LANGUAGE OverloadedStrings #-}
    module Basement.Terminal.ANSI
        (
        -- * Types
          Escape
        , Displacement
        , ColorComponent
        , GrayComponent
        , RGBComponent
        -- * Simple ANSI escape factory functions
        , cursorUp
        , cursorDown
        , cursorForward
        , cursorBack
        , cursorNextLine
        , cursorPrevLine
        , cursorHorizontalAbsolute
        , cursorPosition
        , eraseScreenFromCursor
        , eraseScreenToCursor
        , eraseScreenAll
        , eraseLineFromCursor
        , eraseLineToCursor
        , eraseLineAll
        , scrollUp
        , scrollDown
        , sgrReset
        , sgrForeground
        , sgrBackground
        , sgrForegroundGray24
        , sgrBackgroundGray24
        , sgrForegroundColor216
        , sgrBackgroundColor216
        ) where

    import Basement.String
    import Basement.Bounded
    import Basement.Imports
    import Basement.Numerical.Multiplicative
    import Basement.Numerical.Additive

    #ifndef mingw32_HOST_OS
    #define SUPPORT_ANSI_ESCAPE
    #endif

    type Escape = String

    type Displacement = Word64

    -- | Simple color component on 8 color terminal (maximum compatibility)
    type ColorComponent = Zn64 8

    -- | Gray color compent on 256colors terminals
    type GrayComponent = Zn64 24

    -- | Color compent on 256colors terminals
    type RGBComponent = Zn64 6

    cursorUp, cursorDown, cursorForward, cursorBack
        , cursorNextLine, cursorPrevLine
        , cursorHorizontalAbsolute :: Displacement -> Escape
    cursorUp :: Displacement -> String
    cursorUp Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "A"
    cursorDown :: Displacement -> String
    cursorDown Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "B"
    cursorForward :: Displacement -> String
    cursorForward Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "C"
    cursorBack :: Displacement -> String
    cursorBack Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "D"
    cursorNextLine :: Displacement -> String
    cursorNextLine Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "E"
    cursorPrevLine :: Displacement -> String
    cursorPrevLine Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "F"
    cursorHorizontalAbsolute :: Displacement -> String
    cursorHorizontalAbsolute Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "G"

    cursorPosition :: Displacement -> Displacement -> Escape
    cursorPosition :: Displacement -> Displacement -> String
    cursorPosition Displacement
    row Displacement
    col = Displacement -> Displacement -> String -> String
    csi2 Displacement
    row Displacement
    col String
    "H"

    eraseScreenFromCursor
        , eraseScreenToCursor
        , eraseScreenAll
        , eraseLineFromCursor
        , eraseLineToCursor
        , eraseLineAll :: Escape
    eraseScreenFromCursor :: String
    eraseScreenFromCursor = Displacement -> String -> String
    csi1 Displacement
    0 String
    "J"
    eraseScreenToCursor :: String
    eraseScreenToCursor = Displacement -> String -> String
    csi1 Displacement
    1 String
    "J"
    eraseScreenAll :: String
    eraseScreenAll = Displacement -> String -> String
    csi1 Displacement
    2 String
    "J"
    eraseLineFromCursor :: String
    eraseLineFromCursor = Displacement -> String -> String
    csi1 Displacement
    0 String
    "K"
    eraseLineToCursor :: String
    eraseLineToCursor = Displacement -> String -> String
    csi1 Displacement
    1 String
    "K"
    eraseLineAll :: String
    eraseLineAll = Displacement -> String -> String
    csi1 Displacement
    2 String
    "K"

    scrollUp, scrollDown :: Displacement -> Escape
    scrollUp :: Displacement -> String
    scrollUp Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "S"
    scrollDown :: Displacement -> String
    scrollDown Displacement
    n = Displacement -> String -> String
    csi1 Displacement
    n String
    "T"

    -- | All attribute off
    sgrReset :: Escape
    sgrReset :: String
    sgrReset = Displacement -> String -> String
    csi1 Displacement
    0 String
    "m"

    -- | 8 Colors + Bold attribute for foreground
    sgrForeground :: ColorComponent -> Bool -> Escape
    sgrForeground :: ColorComponent -> Bool -> String
    sgrForeground ColorComponent
    n Bool
    bold
        | Bool
    bold      = Displacement -> Displacement -> String -> String
    csi2 (Displacement
    30Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    +ColorComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 ColorComponent
    n) Displacement
    1 String
    "m"
        | Bool
    otherwise = Displacement -> String -> String
    csi1 (Displacement
    30Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    +ColorComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 ColorComponent
    n) String
    "m"

    -- | 8 Colors + Bold attribute for background
    sgrBackground :: ColorComponent -> Bool -> Escape
    sgrBackground :: ColorComponent -> Bool -> String
    sgrBackground ColorComponent
    n Bool
    bold
        | Bool
    bold      = Displacement -> Displacement -> String -> String
    csi2 (Displacement
    40Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    +ColorComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 ColorComponent
    n) Displacement
    1 String
    "m"
        | Bool
    otherwise = Displacement -> String -> String
    csi1 (Displacement
    40Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    +ColorComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 ColorComponent
    n) String
    "m"

    -- 256 colors mode

    sgrForegroundGray24, sgrBackgroundGray24 :: GrayComponent -> Escape
    sgrForegroundGray24 :: GrayComponent -> String
    sgrForegroundGray24 GrayComponent
    v = Displacement -> Displacement -> Displacement -> String -> String
    csi3 Displacement
    38 Displacement
    5 (Displacement
    0xE8 Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + GrayComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 GrayComponent
    v) String
    "m"
    sgrBackgroundGray24 :: GrayComponent -> String
    sgrBackgroundGray24 GrayComponent
    v = Displacement -> Displacement -> Displacement -> String -> String
    csi3 Displacement
    48 Displacement
    5 (Displacement
    0xE8 Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + GrayComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 GrayComponent
    v) String
    "m"

    sgrForegroundColor216 :: RGBComponent -- ^ Red component
                          -> RGBComponent -- ^ Green component
                          -> RGBComponent -- ^ Blue component
                          -> Escape
    sgrForegroundColor216 :: RGBComponent -> RGBComponent -> RGBComponent -> String
    sgrForegroundColor216 RGBComponent
    r RGBComponent
    g RGBComponent
    b = Displacement -> Displacement -> Displacement -> String -> String
    csi3 Displacement
    38 Displacement
    5 (Displacement
    0x10 Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + Displacement
    36 Displacement -> Displacement -> Displacement
    forall a. Multiplicative a => a -> a -> a
    * RGBComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 RGBComponent
    r Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + Displacement
    6 Displacement -> Displacement -> Displacement
    forall a. Multiplicative a => a -> a -> a
    * RGBComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 RGBComponent
    g Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + RGBComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 RGBComponent
    b) String
    "m"

    sgrBackgroundColor216 :: RGBComponent -- ^ Red component
                          -> RGBComponent -- ^ Green component
                          -> RGBComponent -- ^ Blue component
                          -> Escape
    sgrBackgroundColor216 :: RGBComponent -> RGBComponent -> RGBComponent -> String
    sgrBackgroundColor216 RGBComponent
    r RGBComponent
    g RGBComponent
    b = Displacement -> Displacement -> Displacement -> String -> String
    csi3 Displacement
    48 Displacement
    5 (Displacement
    0x10 Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + Displacement
    36 Displacement -> Displacement -> Displacement
    forall a. Multiplicative a => a -> a -> a
    * RGBComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 RGBComponent
    r Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + Displacement
    6 Displacement -> Displacement -> Displacement
    forall a. Multiplicative a => a -> a -> a
    * RGBComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 RGBComponent
    g Displacement -> Displacement -> Displacement
    forall a. Additive a => a -> a -> a
    + RGBComponent -> Displacement
    forall (n :: Nat). Zn64 n -> Displacement
    unZn64 RGBComponent
    b) String
    "m"

    #ifdef SUPPORT_ANSI_ESCAPE

    csi0 :: String -> String
    csi0 :: String -> String
    csi0 String
    suffix = [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "\ESC[", String
    suffix]

    csi1 :: Displacement -> String -> String
    csi1 :: Displacement -> String -> String
    csi1 Displacement
    p1 String
    suffix = [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "\ESC[", Displacement -> String
    pshow Displacement
    p1, String
    suffix]

    csi2 :: Displacement -> Displacement -> String -> String
    csi2 :: Displacement -> Displacement -> String -> String
    csi2 Displacement
    p1 Displacement
    p2 String
    suffix = [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "\ESC[", Displacement -> String
    pshow Displacement
    p1, String
    ";", Displacement -> String
    pshow Displacement
    p2, String
    suffix]

    csi3 :: Displacement -> Displacement -> Displacement -> String -> String
    csi3 :: Displacement -> Displacement -> Displacement -> String -> String
    csi3 Displacement
    p1 Displacement
    p2 Displacement
    p3 String
    suffix = [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "\ESC[", Displacement -> String
    pshow Displacement
    p1, String
    ";", Displacement -> String
    pshow Displacement
    p2, String
    ";", Displacement -> String
    pshow Displacement
    p3, String
    suffix]

    pshow :: Displacement -> String
    pshow = Displacement -> String
    forall a. Show a => a -> String
    show

    #else

    csi0 :: String -> String
    csi0 _ = ""

    csi1 :: Displacement -> String -> String
    csi1 _ _ = ""

    csi2 :: Displacement -> Displacement -> String -> String
    csi2 _ _ _ = ""

    csi3 :: Displacement -> Displacement -> Displacement -> String -> String
    csi3 _ _ _ _ = ""

    #endif