LLM.hs

{-# OPTIONS_GHC -Wall -Werror #-}

{-# LANGUAGE Safe                         #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}

{-# LANGUAGE RankNTypes                   #-}

--------------------------------------------------------------------------------

-- |
-- Copyright  : (c) 2026 SPISE MISU ApS
-- License    : SSPL-1.0 OR AGPL-3.0-only
-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>
-- Stability  : experimental
--
-- Polite and well educated LLM agent with excellent manners that always behaves
-- well.

--------------------------------------------------------------------------------

module Agent.LLM
  ( -- * Modes
    Mode(..)
    -- * Context
  , Load
  , Context(..)
    -- * Paramenters
  , Eval
    -- * Methods
  , repl
  , replWithMode
  )
where

--------------------------------------------------------------------------------

import           Prelude hiding (head, mod, print, read)

import           Data.Char
  ( toLower
  )
import           System.IO
  ( BufferMode(NoBuffering)
  , hFlush, hSetBuffering, hSetEcho
  , stderr, stdin, stdout
  , utf8
  )
import           GHC.IO.Encoding
  ( setLocaleEncoding
  )

import           Agent.IO.Restricted
import           Agent.JSON
  ( Data
  )

--------------------------------------------------------------------------------

data Mode
  = Auto
  | Chat
  | Code
  | Docs
  | Echo
  | Plan
  | Test
  deriving (Bounded, Enum, Eq, Show)

{- TODO: Use ↑ and ↓ to see previous and current input text
data Text =
  Text
    { prev :: [String]
    , curr ::  String
    , next :: [String]
    }
-}

type Load a =
  Data a
  => Maybe a

data Context a =
  Context
    { exit :: Bool
    , mode :: Mode
    -- , text :: Text
    , load :: Load a
    }

type Eval a =
  Context a
  -> String
  -> RIO (Context a, String)

--------------------------------------------------------------------------------

repl
  :: Eval a
  -> IO ()
repl =
  replWithMode Chat

replWithMode
  :: Mode
  -> Eval a
  -> IO ()
replWithMode mod proc =
  do
    setLocaleEncoding utf8
    hSetBuffering stderr NoBuffering
    hSetBuffering stdin  NoBuffering
    hSetBuffering stdout NoBuffering
    hSetEcho      stdin  False -- NOTE: No default output when typing
    putStrLn head >> hFlush stdout
    run $ loop ctx proc
    where
      ctx =
        Context
          { exit = False
          , mode = mod
          , load = Nothing
          }

--------------------------------------------------------------------------------

-- HELPERS

loop
  :: Context a
  -> Eval a
  -> RIO ()
loop ctx eval =
  if exit ctx then
    return ()
  else
    print prompt >>
    read         >>= \ txt ->
    case txt of
      "/exit"      ->
        printLn  [] >>
        printLn "Λ-gent will shutdown" >>
        loop (ctx { exit = True }) eval
      "/help"      ->
        printLn [ ]  >>
        printLn help >>
        loop ctx eval
      "/mode chat" ->
        printLn [ ] >>
        printLn "Changed to chat-mode" >>
        loop (ctx { mode = Chat }) eval
      "/mode code" ->
        printLn [ ] >>
        printLn "Changed to code-mode" >>
        loop (ctx { mode = Code }) eval
      "/mode echo" ->
        printLn [ ] >>
        printLn "Changed to echo-mode" >>
        loop (ctx { mode = Echo }) eval
      ____________ ->
       eval    ctx txt >>= \ (upd, res) ->
       printLn [ ]     >>
       printLn res     >>
       loop    upd eval
    where
      prompt    = "Λ-" ++ (map toLower $ show $ mode ctx) ++ "> "
      read      = input
      print     = output
      printLn x = print $ x ++ "\n"

modes :: [Mode]
modes =
 [ minBound .. maxBound ]

head :: String
head =
  "# Quit Λ-gent with `/exit`. For more commands, type `/help`."

help :: String
help =
  "# Supported commands\n" ++
  "* /help : This message\n" ++
  "* /exit : Quit Λ-gent\n" ++
  "* /mode : Change mode to {" ++ ms ++ "}`. Ex:`/mode code`"
  where
    ms = foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes