climb-0.3.1: app/Main.hs

{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings #-}

module Main where

import Control.Monad.Catch (MonadThrow)
import Control.Monad.IO.Class (MonadIO)
import Control.Monad.IO.Unlift (MonadUnliftIO (..), UnliftIO (..))
import Climb
import Linenoise

newtype Repl a = Repl { unRepl :: ReplT () () IO a }
  deriving (Functor, Applicative, Monad, MonadIO, MonadThrow)

instance MonadUnliftIO Repl where
  askUnliftIO = do
    UnliftIO run <- Repl askUnliftIO
    pure (UnliftIO (run . unRepl))

runRepl :: Repl a -> IO a
runRepl r = fmap fst (runReplT (unRepl r) () ())

options :: OptionCommands Repl
options = mempty

exec :: Command Repl
exec = const (pure ReplContinue)

completion :: Completion Repl
completion = const (pure [])

replDef :: ReplDef Repl
replDef = ReplDef
  { _rdOnInterrupt = ReplContinue
  , _rdGreeting = "Hello, REPL!"
  , _rdPrompt = "> "
  , _rdOptionCommands = options
  , _rdExecCommand = exec
  , _rdCompletion = completion
  }

main :: IO ()
main = runRepl (runReplDef replDef)