{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE TypeFamilies #-}

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

import Data.Function ((&))
import Effectful (Dispatch (Static), DispatchOf, Eff, Effect, 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
import Prelude hiding (takeWhile)

data Readline :: Effect

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 handle <- S.getStaticRep
  H.getInputLine "% "
    & H.withInterrupt
    & H.handleInterrupt (return Nothing)
    & H.queryInput handle
    & S.unsafeEff_
 where
  flushLogger :: Eff es ()
  flushLogger = getLoggerEnv >>= S.unsafeEff_ . waitForLogger . leLogger

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

  state :: IO H.InputState
  state = H.initializeInput settings