{-# LANGUAGE DataKinds #-}
{-# LANGUAGE TypeFamilies #-}

module Hsm.Command.Readline
  ( Readline
  , readline
  , runReadline
  ) where

import Effectful (Dispatch(Static), DispatchOf, Eff, IOE, (:>))
import Effectful.Dispatch.Static qualified as S
import Effectful.Log (Log, getLoggerEnv, leLogger, waitForLogger)
import Effectful.Resource (Resource, allocate)
import System.Console.Haskeline qualified as H
import System.Console.Haskeline.IO qualified as H

data Readline a b

type instance DispatchOf Readline = Static S.WithSideEffects

newtype instance S.StaticRep Readline =
  Readline H.InputState

readline ::
     forall es. (Log :> es, Readline :> es)
  => Eff es (Maybe String)
readline = do
  flushLogger
  Readline hdl <- S.getStaticRep
  S.unsafeEff_ $ nextLine hdl
  where
    flushLogger :: Eff es ()
    flushLogger = getLoggerEnv >>= S.unsafeEff_ . waitForLogger . leLogger
    --
    nextLine :: H.InputState -> IO (Maybe String)
    nextLine hdl =
      H.queryInput hdl
        $ H.handleInterrupt (return Nothing)
        $ H.withInterrupt
        $ H.getInputLine "% "

runReadline :: (IOE :> es, Resource :> es) => Eff (Readline : es) a -> Eff es a
runReadline action = do
  handle <- snd <$> allocate istate H.cancelInput
  S.evalStaticRep (Readline handle) action
  where
    settings :: H.Settings IO
    settings = H.defaultSettings {H.historyFile = Just ".hsm_command_history"}
    --
    istate :: IO H.InputState
    istate = H.initializeInput settings