{-# LANGUAGE OverloadedStrings #-}

module Hsm.Readline
  ( readline
  , allocateReadline
  ) where

import Control.IO.Region (Region, alloc_)
import Data.Text (Text, pack)
import Data.Typeable (Proxy(Proxy), Typeable, typeRep)
import Hsm.Log qualified as L
import System.Console.Haskeline qualified as H
import System.Console.Haskeline.IO qualified as H
import Text.Read (readEither)

logMsg :: Text -> IO ()
logMsg = L.logMsg ["readline"]

readline ::
     forall a. (Read a, Show a, Typeable a)
  => H.InputState
  -> IO (Maybe a)
readline handle = do
  logMsg $ "Expecting value of type " <> pack (show $ typeRep $ Proxy @a)
  valueMaybe <- queryInput
  maybe (return Nothing) parseValueStr valueMaybe
  where
    queryInput =
      H.queryInput handle
        $ H.handleInterrupt (return Nothing)
        $ H.withInterrupt
        $ H.getInputLine "% "
    parseValueStr valueStr =
      case readEither @a valueStr of
        Right commandValue -> do
          logMsg $ "Parsed value " <> pack (show commandValue)
          return $ Just commandValue
        Left err -> do
          logMsg $ pack err
          readline handle

allocateReadline :: Region -> IO H.InputState
allocateReadline region = alloc_ region initializeInput cancelInput
  where
    initializeInput = do
      logMsg "Initializing input with default settings"
      H.initializeInput H.defaultSettings
    cancelInput handle = do
      logMsg "Cancelling input"
      H.cancelInput handle