{-|
Module      : System.IO.Terminal.Input.Windows
Copyright   : (c) UU, 2019
License     : MIT
Maintainer  : Tom Smeding
Stability   : experimental
Portability : Windows

Platform-specific submodule of "System.IO.Terminal.Input" that works on Windows.
-}
module System.IO.Terminal.Input.Windows
    (withRawMode, getCharTimeout
    ,seqParser)
    where

import Control.Monad.IO.Class
import Data.Char
import System.IO.HiddenChar
import System.IO.Terminal.Input.Key
import System.IO.Terminal.Input.SeqParser


-- | Run an IO-monadic computation with terminal input buffering and echo
-- turned off.
--
-- Note: on Windows this is currently nonfunctional.
withRawMode :: MonadIO m => m a -> m a
withRawMode = id


peekIO :: Show a => IO a -> IO a
-- peekIO act = act >>= \x -> print ("peekIO", x) >> return x
peekIO = id

-- | Get a character from standard input, returning Nothing if no character
-- has appeared after the specified number of milliseconds.
--
-- Note: on Windows the timeout is currently ineffective.
getCharTimeout :: Maybe Int -> IO (Maybe Char)
getCharTimeout _ = peekIO (Just <$> getHiddenChar)


-- | A Windows conio control sequence parser. Pass Nothing to the input if
-- the time between the surrounding characters was "very long", for some
-- definition of "very long" (a reasonable value is ~10ms). This timeout
-- value is used to determine whether certain characters belong together in
-- an escape sequence or are just unrelated keys.
seqParser :: SeqParser (Maybe Char) Key
seqParser = SeqParser $ \case
    Nothing     -> ([], seqParser)
    Just '\224' -> ([], escParser)
    Just c      -> ([recogSingle c], seqParser)
  where
    escParser :: SeqParser (Maybe Char) Key
    escParser = SeqParser $ \case
        Nothing  -> ([KInvalid "timeout"], seqParser)
        Just 'H' -> ([KUp], seqParser)
        Just 'P' -> ([KDown], seqParser)
        Just 'M' -> ([KRight], seqParser)
        Just 'K' -> ([KLeft], seqParser)
        Just c   -> ([KInvalid ['\224', c]], seqParser)

    recogSingle :: Char -> Key
    recogSingle '\ESC' = KEsc
    recogSingle '\HT'  = KTab
    recogSingle '\LF'  = KEnter
    recogSingle '\CR'  = KEnter
    recogSingle '\BS'  = KBackspace
    recogSingle '\NUL' = addCtrl (KChar ' ')
    recogSingle c
        | ord c < 27                = addCtrl (KChar (chr $ ord 'a' - 1 + ord c))
        | 32 <= ord c, ord c <= 126 = KChar c
        | otherwise                 = KInvalid [c]

    addCtrl :: Key -> Key
    addCtrl  = kmodify (\km -> km { kCtrl  = True })

    kmodify :: (Key -> Key) -> Key -> Key
    kmodify f k@(KMod {}) = f k
    kmodify f k           = f (KMod False False False k)