content: module Main
    (
      main
    ) where
  
  import Control.Concurrent (threadDelay)
  import Control.Monad (forM_, replicateM_)
  import System.IO (hFlush, stdout)
  import Text.Printf(printf)
  
  import Data.Colour.SRGB (sRGB24)
  
  import System.Console.ANSI
  import System.Environment ( getArgs )
  
  examples :: [(String, IO ())]
  examples =
    [ ( "Cursor movement", cursorMovementExample )
    , ( "Line change", lineChangeExample )
    , ( "Set cursor position", setCursorPositionExample )
    , ( "Save restore cursor", saveRestoreCursorExample )
    , ( "Clear", clearExample )
    , ( "Line wrap", lineWrapExample )
    , ( "Scroll", scrollExample )
    , ( "Screen buffers", screenBuffersExample )
    , ( "SGR color", sgrColorExample )
    , ( "SGR other", sgrOtherExample )
    , ( "Cursor visibility", cursorVisibilityExample )
    , ( "Hyperlink", hyperlinkExample )
    , ( "Title", titleExample )
    , ( "Get cursor position", getCursorPositionExample )
    , ( "Get terminal size", getTerminalSizeExample )
    , ( "Get layer color", getLayerColorExample )
    ]
  
  main :: IO ()
  main = do
    args <- getArgs
    let numExamples = zip [1 ..] examples
    if wantHelp args
      then
        listExamples numExamples
      else do
        let wantedNumExamples = filter (isExample args) numExamples
            wantedExamples = map getExample wantedNumExamples
        stdoutSupportsANSI <- hNowSupportsANSI stdout
        if stdoutSupportsANSI
          then
            mapM_ (resetScreen >>) wantedExamples
          else
            putStrLn "Standard output does not support 'ANSI' escape codes."
   where
    wantHelp :: [String] -> Bool
    wantHelp args = "-h" `elem` args || "--help" `elem` args
  
    listExamples :: [(Int, (String, IO ()))] -> IO ()
    listExamples = mapM_ (\(n, (d, _)) -> putStrLn $ show n ++ ": " ++ d)
  
    isExample :: [String] -> (Int, (String, IO ())) -> Bool
    isExample args (n, _) = show n `elem` args
  
    getExample :: (Int, (String, IO ())) -> IO ()
    getExample (_, (_, example)) = example
  
  -- Annex D to Standard ECMA-48 (5th Ed, 1991) identifies that the representation
  -- of an erased state is implementation-dependent. There may or may not be a
  -- distinction between a character position in the erased state and one imaging
  -- SPACE. Consequently, to reset the screen, the default graphic rendition must
  -- be selected (setSGR [Reset]) before all character positions are put into the
  -- erased state (clearScreen).
  resetScreen :: IO ()
  resetScreen = setSGR [Reset] >> clearScreen >> setCursorPosition 0 0
  
  pause :: IO ()
  pause = do
    hFlush stdout
    -- 1 second pause
    threadDelay 1000000
  
  cursorMovementExample :: IO ()
  cursorMovementExample = do
    putStrLn "Line One"
    putStr "Line Two"
    pause
    -- Line One
    -- Line Two
  
    cursorUp 1
    putStr " - Extras"
    pause
    -- Line One - Extras
    -- Line Two
  
    cursorBackward 2
    putStr "zz"
    pause
    -- Line One - Extrzz
    -- Line Two
  
    cursorForward 2
    putStr "- And More"
    pause
    -- Line One - Extrzz  - And More
    -- Line Two
  
    cursorDown 1
    putStr "Disconnected"
    pause
    -- Line One - Extrzz  - And More
    -- Line Two                     Disconnected
  
  lineChangeExample :: IO ()
  lineChangeExample = do
    putStrLn "Line One"
    putStr "Line Two"
    pause
    -- Line One
    -- Line Two
  
    cursorUpLine 1
    putStr "New Line One"
    pause
    -- New Line One
    -- Line Two
  
    cursorDownLine 1
    putStr "New Line Two"
    pause
    -- New Line One
    -- New Line Two
  
  setCursorPositionExample :: IO ()
  setCursorPositionExample = do
    putStrLn "Line One"
    putStrLn "Line Two"
    pause
    -- Line One
    -- Line Two
  
    setCursorPosition 0 5
    putStr "Foo"
    pause
    -- Line Foo
    -- Line Two
  
    setCursorPosition 1 5
    putStr "Bar"
    pause
    -- Line Foo
    -- Line Bar
  
    setCursorColumn 1
    putStr "oaf"
    pause
    -- Line Foo
    -- Loaf Bar
  
  saveRestoreCursorExample :: IO ()
  saveRestoreCursorExample = do
    putStr "Start sentence ..."
    pause
    -- Start sentence ...
  
    saveCursor
    setCursorPosition 2 3
    putStr "SPLASH!"
    pause
    -- Start sentence ...
    --
    --    SPLASH!
  
    restoreCursor
    putStr " end sentence, uninterrupted."
    pause
    -- Start sentence ... end sentence, uninterrupted
    --
    --    SPLASH!
  
  clearExample :: IO ()
  clearExample = do
    putStrLn "Line One"
    putStrLn "Line Two"
    pause
    -- Line One
    -- Line Two
  
    setCursorPosition 0 4
    clearFromCursorToScreenEnd
    pause
    -- Line
  
    resetScreen
    putStrLn "Line One"
    putStrLn "Line Two"
    pause
    -- Line One
    -- Line Two
  
    setCursorPosition 1 4
    clearFromCursorToScreenBeginning
    pause
    --
    --     Two
  
    resetScreen
    putStrLn "Line One"
    putStrLn "Line Two"
    pause
    -- Line One
    -- Line Two
  
    setCursorPosition 0 4
    clearFromCursorToLineEnd
    pause
    -- Line
    -- Line Two
  
    setCursorPosition 1 4
    clearFromCursorToLineBeginning
    pause
    -- Line
    --      Two
  
    clearLine
    pause
    -- Line
  
    clearScreen
    pause
    --
  
  lineWrapExample :: IO ()
  lineWrapExample = do
    putStrLn $ take 240 $ cycle "Default-line-wrap|"
    pause
    -- Default-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Def
    -- ault-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Defaul
    -- t-line-wrap|Default-line-wrap|Default-line-wrap|Default-line-wrap|Default-l
    disableLineWrap
    putStrLn $ take 240 $ cycle "Disable-line-wrap|"
    pause
    -- Disable-line-wrap|Disable-line-wrap|Disable-line-wrap|Disable-line-wrap|Dis
    enableLineWrap
    putStrLn $ take 240 $ cycle "Enable-line-wrap|"
    pause
    -- Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-
    -- line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wr
    -- ap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enable-line-wrap|Enab
  
  scrollExample :: IO ()
  scrollExample = do
    putStrLn "Line One"
    putStrLn "Line Two"
    putStrLn "Line Three"
    pause
    -- Line One
    -- Line Two
    -- Line Three
  
    scrollPageDown 2
    pause
    --
    --
    -- Line One
    -- Line Two
    -- Line Three
  
    scrollPageUp 3
    pause
    -- Line Two
    -- Line Three
  
  screenBuffersExample :: IO ()
  screenBuffersExample = do
    replicateM_ 5 $ putStrLn "This message is on the Normal Screen Bufffer"
    replicateM_ 5 pause
    useAlternateScreenBuffer
    replicateM_ 5 $ putStrLn "This message is on the Alternate Screen Bufffer"
    replicateM_ 5 pause
    useNormalScreenBuffer
    replicateM_ 5 $ putStrLn "This message is continuing where we left off"
    replicateM_ 5 pause
  
  sgrColorExample :: IO ()
  sgrColorExample = do
    let colors = enumFromTo minBound maxBound :: [Color]
    forM_ [Foreground, Background, Underlining] $ \layer ->  do
      forM_ [Dull, Vivid] $ \intensity -> do
        resetScreen
        forM_ colors $ \color -> do
          setSGR [Reset]
          setSGR [SetColor layer intensity color]
          setSGR [SetUnderlining SingleUnderline]
          print color
        pause
    -- The ANSI eight standard colors, 6 times in sequence (three layers and two
    -- intensities)
  
    resetScreen
    putStrLn "True color (24 bit color depth)"
    putStrLn "-------------------------------"
    putStrLn ""
    setSGR [SetRGBColor Foreground $ sRGB24 0 0 0]
    forM_ [0 .. 23] $ \row -> do
      forM_ [0 .. 47] $ \col -> do
        let r = row * 11
            g = 255 - r
            b = col * 5
        setSGR [SetRGBColor Background $ sRGB24 r g b]
        putStr "-"
      putStrLn ""
    replicateM_ 5 pause
    -- True colors, a swatch of 24 rows and 48 columns
  
    resetScreen
    putStrLn "A 256-color palette"
    putStrLn "-------------------"
    putStrLn ""
  
    -- First 16 colors ('system' colors in xterm protocol), in a row
    --
    -- 0 0 1 1 2 2 3 3 4 4 5 5 6 6 7 7 8 8 9 9 A A B B C C D D E E F F
    forM_ [Dull .. Vivid] $ \intensity -> do
      forM_ [Black .. White] $ \color -> do
        let i = fromEnum intensity * 8 + fromEnum color
            eol = i == 15
        setSGR [SetPaletteColor Background $ xtermSystem intensity color]
        setSGR [SetPaletteColor Foreground $ xtermSystem Dull Black]
        printf "%X " i
        setSGR [SetPaletteColor Foreground $ xtermSystem Vivid White]
        printf "%X" i
        if eol
          then putStrLn ""
          else do
            setSGR [Reset]
            putStr " "
    putStrLn ""
  
    -- Next 216 colors (6 level RGB in xterm protocol), in 12 rows of 18
    --
    -- 000 001 002 003 004 005 010 011 012 013 014 015 020 021 022 023 024 025
    -- 030 031 032 033 034 035 040 041 042 043 044 045 050 051 052 053 054 055
    -- 100 101 102 103 104 105 110 111 112 113 114 115 120 121 122 123 124 125
    -- ... and so on ...
    forM_ [0 .. 5] $ \r -> do
      forM_ [0 .. 5] $ \g -> do
        forM_ [0 .. 5] $ \b -> do
          let i = 16 + b + g * 6 + r * 36
              eol = i `mod` 18 == 15
              r' = (r + 3) `mod` 6
              g' = (g + 3) `mod` 6
              b' = (b + 3) `mod` 6
          setSGR [SetPaletteColor Foreground $ xterm6LevelRGB r' g' b']
          setSGR [SetPaletteColor Background $ xterm6LevelRGB r g b]
          putStr $ show r ++ show g ++ show b
          if eol
            then putStrLn ""
            else do
              setSGR [Reset]
              putStr " "
    putStrLn ""
  
    -- Final 24 colors (24 levels of gray in xterm protocol), in two rows
    --
    --   0   1   2   3   4   5   6   7   8   9  10  11
    --  12  13  14  15  16  17  18  19  20  21  22  23
    forM_ [0 .. 23] $ \y -> do
      setSGR [SetPaletteColor Foreground $ xterm24LevelGray $ (y + 12) `mod` 24]
      setSGR [SetPaletteColor Background $ xterm24LevelGray y]
      printf "%3d" y
      if y == 11
        then putStrLn ""
        else do
          setSGR [Reset]
          putStr " "
    replicateM_ 5 pause
  
    resetScreen
    setSGR [Reset]
    setSGR [SetUnderlining SingleUnderline]
    forM_
      (zip "Underlining: True color (24 bit color depth)" (cycle [0, 10 .. 255])) $
      \(c, i) -> do
        setSGR [SetRGBColor Underlining $ sRGB24 i 0 0]
        putChar c
    putChar '\n'
    putChar '\n'
    setSGR [Reset]
    setSGR [SetUnderlining SingleUnderline]
    forM_ (zip "Underlining: A 256-color palette" (cycle [0 .. 5])) $
      \(c, i) -> do
        setSGR [SetPaletteColor Underlining $ xterm6LevelRGB i 0 0]
        putChar c
    putChar '\n'
    replicateM_ 5 pause
  
  sgrOtherExample :: IO ()
  sgrOtherExample = do
    let named_styles = [ (SetConsoleIntensity BoldIntensity, "Bold")
                       , (SetConsoleIntensity FaintIntensity, "Faint")
                       , (SetConsoleIntensity NormalIntensity, "Normal")
                       , (SetItalicized True, "Italic")
                       , (SetItalicized False, "No Italics")
                       , (SetUnderlining SingleUnderline, "Single Underline")
                       , (SetUnderlining DoubleUnderline, "Double Underline")
                       , (SetUnderlining CurlyUnderline, "Curly Underline")
                       , (SetUnderlining DottedUnderline, "Dotted Underline")
                       , (SetUnderlining DashedUnderline, "Dashed Underline")
                       , (SetUnderlining NoUnderline, "No Underline")
                       , (SetBlinkSpeed SlowBlink, "Slow Blink")
                       , (SetBlinkSpeed RapidBlink, "Rapid Blink")
                       , (SetBlinkSpeed NoBlink, "No Blink")
                       , (SetVisible False, "Conceal")
                       , (SetVisible True, "Reveal")
                       ]
    forM_ named_styles $ \(style, name) -> do
      resetScreen
      setSGR [style]
      putStrLn name
      pause
    -- Text describing a style displayed in that style in sequence
  
    setSGR [SetColor Foreground Vivid Red]
    setSGR [SetColor Background Vivid Blue]
  
    clearScreen >> setCursorPosition 0 0
    setSGR [SetSwapForegroundBackground False]
    putStr "Red-On-Blue"
    pause
    -- Red-On-Blue
  
    clearScreen >> setCursorPosition 0 0
    setSGR [SetSwapForegroundBackground True]
    putStr "Blue-On-Red"
    pause
    -- Blue-On-Red
  
  cursorVisibilityExample :: IO ()
  cursorVisibilityExample = do
    putStr "Cursor Demo"
    pause
    -- Cursor Demo|
  
    hideCursor
    pause
    -- Cursor Demo
  
    showCursor
    pause
    -- Cursor Demo|
  
  hyperlinkExample :: IO ()
  hyperlinkExample = do
    putStr "Hyperlink demo: "
    hyperlink "https://example.com" "Example hyperlink\n"
    putStrLn ""
    putStrLn "Linked hyperlinks demo:"
    hyperlinkWithId "ref" "https://example.com" "Example linked hyperlink one\n"
    hyperlinkWithId "ref" "https://example.com" "Example linked hyperlink two\n"
  
    replicateM_ 5 pause
    -- Hyperlink demo: Example hyperlink
    --
    -- Linked hyperlinks demo:
    -- Example linked hyperlink one
    -- Example linked hyperlink two
  
  titleExample :: IO ()
  titleExample = do
    putStr "Title Demo"
    pause
    -- ~/foo/ - ansi-terminal-ex - 83x70
    ------------------------------------
    -- Title Demo
  
    setTitle "Yup, I'm a new title!"
    pause
    -- Yup, I'm a new title! - ansi-terminal-ex - 83x70
    ---------------------------------------------------
    -- Title Demo
  
  getCursorPositionExample :: IO ()
  getCursorPositionExample = do
    putStrLn "         11111111112222222222"
    putStrLn "12345678901234567890123456789"
    putStr   "Report cursor position here:"
    pause
    --          11111111112222222222
    -- 12345678901234567890123456789
    -- Report cursor position here:|
    result <- getCursorPosition
    putStrLn " (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.\n"
    case result of
      Just (row, col) -> putStrLn $ "The cursor was at row number " ++
        show (row + 1) ++ " and column number " ++ show (col + 1) ++ ".\n"
      Nothing -> putStrLn "Error: unable to get the cursor position\n"
    replicateM_ 3 pause
    --          11111111112222222222
    -- 12345678901234567890123456789
    -- Report cursor position here: (3rd row, 29th column) to stdin, as CSI 3 ; 29 R.
    --
    -- The cursor was at row number 3 and column number 29.
  
  getTerminalSizeExample :: IO ()
  getTerminalSizeExample = do
    result <- getTerminalSize
    case result of
      Just (h, w) -> putStrLn $ "The size of the terminal is " ++ show h ++
        " rows by " ++ show w ++ " columns.\n"
      Nothing -> putStrLn "Error: unable to get the terminal size\n"
    pause
    -- The size of the terminal is 25 rows by 80 columns.
  
  getLayerColorExample :: IO ()
  getLayerColorExample = do
    fgResult <- getLayerColor Foreground
    case fgResult of
      Just fgCol -> putStrLn $ "The reported foreground color is:\n" ++
        show fgCol ++ "\n"
      Nothing -> putStrLn "Error: unable to get the foreground color\n"
    bgResult <- getLayerColor Background
    case bgResult of
      Just bgCol -> putStrLn $ "The reported background color is:\n" ++
        show bgCol ++ "\n"
      Nothing -> putStrLn "Error: unable to get the background color\n"
  