{-# OPTIONS_GHC -Wall -Werror #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE RankNTypes #-}
module Agent.LLM
(
Mode(..)
, Context(..)
, AbsoluteFilePath
, Chat
, Chit
, File
, FileLine
, FilePaths
, Files
, Filter
, History
, Load
, Mask
, Root
, Template
, UUID
, Eval
, repl
, replWithMode
)
where
import Prelude hiding ( head, mod, print, read )
import Data.Char ( toLower, toUpper )
import Data.Maybe ( fromMaybe )
import GHC.IO.Encoding ( setLocaleEncoding )
import System.Environment ( getProgName )
import qualified System.Environment.Blank as ENV
import System.Exit
( ExitCode (ExitFailure, ExitSuccess)
)
import System.IO
( BufferMode (LineBuffering, NoBuffering)
, hFlush
, hSetBuffering
, hSetEcho
, stderr
, stdin
, stdout
, utf8
)
import System.Process ( readProcessWithExitCode )
import Text.Read ( readMaybe )
import Internal.LLM
( AbsoluteFilePath
, Chat
, Chit (..)
, File
, FileLine
, FilePaths
, Files
, Filter
, History (..)
, Mask
, Mode (..)
, Root
, Template
, UUID
, modes
)
import qualified Internal.LLM as INT
import Internal.LLM.Action ( Action (..) )
import Internal.RIO ( RIO (..), input, output )
import qualified Internal.Utils as UTL
import qualified Agent.Data.ANSI.EscapeCode as AEC
import qualified Agent.LLM.Message as MSG
import Agent.Data.JSON ( Data )
import Agent.LLM.Message ( Message )
type Load a =
( Data a
, Show a
)
=> Maybe a
data Context a =
Context
{ forall a. Context a -> UUID
uuid :: !UUID
, forall a. Context a -> Mode
mode :: !Mode
, forall a. Context a -> Load a
load :: !(Load a)
, forall a. Context a -> History
hist :: !History
, forall a. Context a -> Maybe Filter
list :: !(Maybe Filter)
, forall a. Context a -> Maybe FilePaths
pile :: !(Maybe FilePaths)
, forall a. Context a -> Maybe Files
ruck :: !(Maybe Files)
}
type Eval a =
Context a
-> Message
-> RIO (Context a, Action)
repl
:: Eval a
-> IO ()
repl :: forall a. Eval a -> IO ()
repl =
Mode -> Eval a -> IO ()
forall a. Mode -> Eval a -> IO ()
replWithMode Mode
INT.Chat
replWithMode
:: INT.Mode
-> Eval a
-> IO ()
replWithMode :: forall a. Mode -> Eval a -> IO ()
replWithMode Mode
mod Eval a
proc =
do
Either String ()
constraint <- IO (Either String ())
integrity
case Either String ()
constraint of
Right ()
__ ->
do
TextEncoding -> IO ()
setLocaleEncoding TextEncoding
utf8
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stderr BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdin BufferMode
NoBuffering
Handle -> BufferMode -> IO ()
hSetBuffering Handle
stdout BufferMode
LineBuffering
Handle -> Bool -> IO ()
hSetEcho Handle
stdin Bool
False
String -> IO ()
putStrLn String
head IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
RIO () -> IO ()
forall a. RIO a -> IO a
run (RIO () -> IO ()) -> RIO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop Context a
forall {a}. Context a
ctx Eval a
proc
Left String
err ->
String -> IO ()
putStrLn String
err IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Handle -> IO ()
hFlush Handle
stdout
where
ctx :: Context a
ctx =
Context
{ uuid :: UUID
uuid = String -> UUID
INT.UUID []
, mode :: Mode
mode = Mode
mod
, load :: Load a
load = Maybe a
Load a
forall a. Maybe a
Nothing
, hist :: History
hist =
History
{ chit :: Chit
chit =
Chit
{ prev :: Chat
prev = []
, next :: Chat
next = []
}
, chat :: Chat
chat = []
}
, list :: Maybe Filter
list = Maybe Filter
forall a. Maybe a
Nothing
, pile :: Maybe FilePaths
pile = FilePaths -> Maybe FilePaths
forall a. a -> Maybe a
Just (FilePaths -> Maybe FilePaths) -> FilePaths -> Maybe FilePaths
forall a b. (a -> b) -> a -> b
$ Chat -> FilePaths
INT.FilePaths []
, ruck :: Maybe Files
ruck = Files -> Maybe Files
forall a. a -> Maybe a
Just (Files -> Maybe Files) -> Files -> Maybe Files
forall a b. (a -> b) -> a -> b
$ [File] -> Files
INT.Files []
}
head :: String
head :: String
head =
String
"# Exit Λ-gent with /e or /exit. For more commands, type /? or /help."
help :: String
help :: String
help =
Chat -> String
unlines
[ String
"# Supported commands:"
, String
ds
, String
"/? or /help | This message"
, String
"/e or /exit | Exit Λ-gent"
, String
"/w or /wipe | Clear screen"
, String
ds
, String
"/m m or /mode m | Change to {" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
ms String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"}. Ex: /m plan"
, String
ds
, String
"/h or /hist | View history (input and output)"
, String
" /chit | View history (only input) "
, String
" /chat | View history (only output)"
, String
ds
, String
"/l f or /list f | List of files, limited by mode, file masks and filter"
, String
"/p or /pile | Show stored list of files. See /list above"
, String
"/f i or /file i | Show file with the given index. See /pile above"
, String
"/n i or /nums i | Show file with line numbers. See /file above"
, String
ds
, String
"/s m or /send m | Sending /pile to LLM as context to the message"
, String
"/r o or /ruck o | View files (opt index) from LLM response. See /send"
, String
"/a d or /atom d | Atomically save /ruck files to a GIT branch (+ description)"
, String
" /repo | List GIT branches (+ description). See /atom above"
, String
ds
]
where
ds :: String
ds = Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
80 Char
'-'
ms :: String
ms =
(String -> String -> String) -> Chat -> String
forall a. (a -> a -> a) -> [a] -> a
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldl1 (\ String
x String
y -> String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"|" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
y) (Chat -> String) -> Chat -> String
forall a b. (a -> b) -> a -> b
$ (Mode -> String) -> [Mode] -> Chat
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Mode -> String) -> Mode -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> String
forall a. Show a => a -> String
show) [Mode]
modes
loop
:: Context a
-> Eval a
-> RIO ()
loop :: forall a. Context a -> Eval a -> RIO ()
loop Context a
ctx Eval a
eval =
String -> RIO ()
print String
prompt RIO () -> RIO String -> RIO String
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Chat -> Chat -> RIO String
read Chat
hps Chat
hns RIO String -> (String -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
txt ->
String -> RIO ()
printLn [ ] RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
case String -> Action
txt2act String
txt of
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
File File
_ ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Template TextToFile
_ [File]
_ [File]
_ [File]
_ ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
Exit -> RIO ()
caseExit
Action
Help -> String -> RIO ()
caseHelp String
txt
Hist (Bool
chits, Bool
chats) -> String -> Bool -> Bool -> RIO ()
caseHist String
txt Bool
chits Bool
chats
Mode Char
c String
cs -> String -> Char -> String -> RIO ()
caseMode String
txt Char
c String
cs
Paths (INT.FilePaths Chat
fps) -> String -> Chat -> RIO ()
casePaths String
txt Chat
fps
Action
Pile -> String -> RIO ()
casePile String
txt
Ruck String
mdix -> String -> String -> RIO ()
caseRuck String
txt String
mdix
Action
Wipe -> String -> RIO ()
caseWipe String
txt
UnknownCmd String
cmd -> String -> String -> RIO ()
caseUnknownCmd String
txt String
cmd
Branch String
msg Files
fs ->
Eval a
eval Context a
ctx (String -> Files -> Message
MSG.Atom String
msg Files
fs) RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
Prompt String
msg ->
Eval a
eval Context a
ctx (Maybe [AbsoluteFilePath] -> Message
MSG.Tmpl Maybe [AbsoluteFilePath]
afps) RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd0, Action
action0) ->
case Action
action0 of
Template TextToFile
f [File]
is [File]
es [File]
fs ->
Eval a
eval Context a
ctx (Chat -> Message
MSG.Send Chat
xml) RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd1, Action
action1) ->
case Action
action1 of
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop
( String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt
( Context a
upd1 { ruck = Just $ pfs }
)
( String -> Maybe String
forall a. a -> Maybe a
Just String
cs
)
) Eval a
eval
where
pfs :: Files
pfs =
case (((String, Chat) -> File) -> [(String, Chat)] -> [File]
forall a b. (a -> b) -> [a] -> [b]
map (String, Chat) -> File
INT.File ([(String, Chat)] -> [File]) -> TextToFile -> String -> [File]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TextToFile
f) String
cs of
[] -> [File] -> Files
INT.Files []
[File]
xs -> [File] -> Files
INT.Files [File]
xs
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd1 Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd1 (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
where
ils :: Chat
ils = (File -> String) -> [File] -> Chat
forall a b. (a -> b) -> [a] -> [b]
map ( \ (INT.File (String
_, Chat
ls)) -> Chat -> String
unlines Chat
ls) [File]
is
els :: Chat
els = (File -> String) -> [File] -> Chat
forall a b. (a -> b) -> [a] -> [b]
map ( \ (INT.File (String
_, Chat
ls)) -> Chat -> String
unlines Chat
ls) [File]
es
tpl :: Template
tpl = String -> Chat -> Chat -> [File] -> Template
INT.Template String
msg Chat
ils Chat
els [File]
fs
xml :: Chat
xml = Template -> Chat
INT.tpl2xmls Template
tpl
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd0 (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd0 Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd0 (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
where
afps :: Maybe [AbsoluteFilePath]
afps =
( \ (INT.FilePaths Chat
fps) -> (String -> AbsoluteFilePath) -> Chat -> [AbsoluteFilePath]
forall a b. (a -> b) -> [a] -> [b]
map String -> AbsoluteFilePath
INT.AbsoluteFilePath Chat
fps
)
(FilePaths -> [AbsoluteFilePath])
-> Maybe FilePaths -> Maybe [AbsoluteFilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context a -> Maybe FilePaths
forall a. Context a -> Maybe FilePaths
pile Context a
ctx
Message (MSG.Path Bool
ns Maybe AbsoluteFilePath
afp) ->
Eval a
eval Context a
ctx (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
ns Maybe AbsoluteFilePath
afp) RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
File (INT.File (String
_,Chat
ls)) ->
String -> Bool -> Chat -> RIO ()
caseFile String
txt Bool
ns Chat
ls
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
Message (MSG.List Maybe Filter
fil) ->
Eval a
eval Context a
ctx (Maybe Filter -> Message
MSG.List Maybe Filter
fil) RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
Paths (INT.FilePaths Chat
fps) ->
String -> Chat -> RIO ()
casePaths String
txt Chat
fps
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
Message Message
MSG.Repo ->
Eval a
eval Context a
ctx Message
MSG.Repo RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
Message Message
msg ->
Eval a
eval Context a
ctx Message
msg RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
where
txt2act :: String -> Action
txt2act String
txt =
case String
txt of
Char
'/':Char
'm':Char
'o':Char
'd':Char
'e':Char
' ':Char
c:String
cs -> Char -> String -> Action
Mode Char
c String
cs
Char
'/':Char
'm' :Char
' ':Char
c:String
cs -> Char -> String -> Action
Mode Char
c String
cs
Char
'/':Char
'l':Char
'i':Char
's':Char
't' :String
mfil ->
Message -> Action
Message (Maybe Filter -> Message
MSG.List Maybe Filter
fil)
where
fil :: Maybe Filter
fil =
case String
mfil of
[ ] -> Filter -> Maybe Filter
forall a. a -> Maybe a
Just (Filter -> Maybe Filter) -> Filter -> Maybe Filter
forall a b. (a -> b) -> a -> b
$ String -> Filter
INT.Filter String
mfil
Char
' ':String
cs -> Filter -> Maybe Filter
forall a. a -> Maybe a
Just (Filter -> Maybe Filter) -> Filter -> Maybe Filter
forall a b. (a -> b) -> a -> b
$ String -> Filter
INT.Filter String
cs
String
______ -> Maybe Filter
forall a. Maybe a
Nothing
Char
'/':Char
'l' :String
mfil ->
Message -> Action
Message (Maybe Filter -> Message
MSG.List Maybe Filter
fil)
where
fil :: Maybe Filter
fil =
case String
mfil of
[ ] -> Filter -> Maybe Filter
forall a. a -> Maybe a
Just (Filter -> Maybe Filter) -> Filter -> Maybe Filter
forall a b. (a -> b) -> a -> b
$ String -> Filter
INT.Filter String
mfil
Char
' ':String
cs -> Filter -> Maybe Filter
forall a. a -> Maybe a
Just (Filter -> Maybe Filter) -> Filter -> Maybe Filter
forall a b. (a -> b) -> a -> b
$ String -> Filter
INT.Filter String
cs
String
______ -> Maybe Filter
forall a. Maybe a
Nothing
Char
'/':Char
'f':Char
'i':Char
'l':Char
'e':Char
' ':String
midx ->
case Maybe Int
oidx of
Maybe Int
Nothing ->
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
False Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
Just Int
idx ->
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
idx Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Chat -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Chat
pfs then
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
False (AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a. a -> Maybe a
Just (AbsoluteFilePath -> Maybe AbsoluteFilePath)
-> AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ String -> AbsoluteFilePath
INT.AbsoluteFilePath (String -> AbsoluteFilePath) -> String -> AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ Chat
pfs Chat -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx))
else
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
False Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
where
pfs :: Chat
pfs = (FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePaths -> Chat
INT.filePaths (Maybe FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall a b. (a -> b) -> a -> b
$ Context a -> Maybe FilePaths
forall a. Context a -> Maybe FilePaths
pile Context a
ctx
where
oidx :: Maybe Int
oidx =
case String
midx of
[] -> Maybe Int
forall a. Maybe a
Nothing
String
cs -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
cs :: Maybe Int
Char
'/':Char
'f' :Char
' ':String
midx ->
case Maybe Int
oidx of
Maybe Int
Nothing ->
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
False Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
Just Int
idx ->
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
idx Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Chat -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Chat
pfs then
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
False (AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a. a -> Maybe a
Just (AbsoluteFilePath -> Maybe AbsoluteFilePath)
-> AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ String -> AbsoluteFilePath
INT.AbsoluteFilePath (String -> AbsoluteFilePath) -> String -> AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ Chat
pfs Chat -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx))
else
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
False Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
where
pfs :: Chat
pfs = (FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePaths -> Chat
INT.filePaths (Maybe FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall a b. (a -> b) -> a -> b
$ Context a -> Maybe FilePaths
forall a. Context a -> Maybe FilePaths
pile Context a
ctx
where
oidx :: Maybe Int
oidx =
case String
midx of
[] -> Maybe Int
forall a. Maybe a
Nothing
String
cs -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
cs :: Maybe Int
Char
'/':Char
'n':Char
'u':Char
'm':Char
's':Char
' ':String
midx ->
case Maybe Int
oidx of
Maybe Int
Nothing ->
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
True Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
Just Int
idx ->
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
idx Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Chat -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Chat
pfs then
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
True (AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a. a -> Maybe a
Just (AbsoluteFilePath -> Maybe AbsoluteFilePath)
-> AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ String -> AbsoluteFilePath
INT.AbsoluteFilePath (String -> AbsoluteFilePath) -> String -> AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ Chat
pfs Chat -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx))
else
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
True Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
where
pfs :: Chat
pfs = (FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePaths -> Chat
INT.filePaths (Maybe FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall a b. (a -> b) -> a -> b
$ Context a -> Maybe FilePaths
forall a. Context a -> Maybe FilePaths
pile Context a
ctx
where
oidx :: Maybe Int
oidx =
case String
midx of
[] -> Maybe Int
forall a. Maybe a
Nothing
String
cs -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
cs :: Maybe Int
Char
'/':Char
'n' :Char
' ':String
midx ->
case Maybe Int
oidx of
Maybe Int
Nothing ->
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
True Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
Just Int
idx ->
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
idx Bool -> Bool -> Bool
&& Int
idx Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Chat -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Chat
pfs then
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
True (AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a. a -> Maybe a
Just (AbsoluteFilePath -> Maybe AbsoluteFilePath)
-> AbsoluteFilePath -> Maybe AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ String -> AbsoluteFilePath
INT.AbsoluteFilePath (String -> AbsoluteFilePath) -> String -> AbsoluteFilePath
forall a b. (a -> b) -> a -> b
$ Chat
pfs Chat -> Int -> String
forall a. HasCallStack => [a] -> Int -> a
!! Int
idx))
else
Message -> Action
Message (Bool -> Maybe AbsoluteFilePath -> Message
MSG.Path Bool
True Maybe AbsoluteFilePath
forall a. Maybe a
Nothing)
where
pfs :: Chat
pfs = (FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePaths -> Chat
INT.filePaths (Maybe FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall a b. (a -> b) -> a -> b
$ Context a -> Maybe FilePaths
forall a. Context a -> Maybe FilePaths
pile Context a
ctx
where
oidx :: Maybe Int
oidx =
case String
midx of
[] -> Maybe Int
forall a. Maybe a
Nothing
String
cs -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
cs :: Maybe Int
Char
'/':Char
's':Char
'e':Char
'n':Char
'd':Char
' ':String
mesg -> String -> Action
Prompt String
mesg
Char
'/':Char
's' :Char
' ':String
mesg -> String -> Action
Prompt String
mesg
Char
'/':Char
'a':Char
't':Char
'o':Char
'm':Char
' ':String
mesg ->
String -> Files -> Action
Branch String
mesg Files
fs
where
fs :: Files
fs = Files -> Maybe Files -> Files
forall a. a -> Maybe a -> a
fromMaybe ([File] -> Files
INT.Files []) (Context a -> Maybe Files
forall a. Context a -> Maybe Files
ruck Context a
ctx)
Char
'/':Char
'a' :Char
' ':String
mesg ->
String -> Files -> Action
Branch String
mesg Files
fs
where
fs :: Files
fs = Files -> Maybe Files -> Files
forall a. a -> Maybe a -> a
fromMaybe ([File] -> Files
INT.Files []) (Context a -> Maybe Files
forall a. Context a -> Maybe Files
ruck Context a
ctx)
Char
'/':Char
'r':Char
'e':Char
'p':Char
'o' :[ ] -> Message -> Action
Message Message
MSG.Repo
Char
'/':Char
'r':Char
'u':Char
'c':Char
'k' :String
midx -> String -> Action
Ruck String
midx
Char
'/':Char
'r' :String
midx -> String -> Action
Ruck String
midx
String
"/exit" -> Action
Exit
String
"/e" -> Action
Exit
String
"/help" -> Action
Help
String
"/?" -> Action
Help
String
"/hist" -> (Bool, Bool) -> Action
Hist ( Bool
True, Bool
True )
String
"/h" -> (Bool, Bool) -> Action
Hist ( Bool
True, Bool
True )
String
"/chit" -> (Bool, Bool) -> Action
Hist ( Bool
True, Bool
False )
String
"/chat" -> (Bool, Bool) -> Action
Hist ( Bool
False, Bool
True )
String
"/pile" -> Action
Pile
String
"/p" -> Action
Pile
String
"/wipe" -> Action
Wipe
String
"/w" -> Action
Wipe
Char
'/':String
cmd -> String -> Action
UnknownCmd String
cmd
String
____________________________ -> Message -> Action
Message (String -> Message
MSG.Text String
txt)
his :: History
his = Context a -> History
forall a. Context a -> History
hist Context a
ctx
chi :: Chit
chi = History -> Chit
chit History
his
hps :: Chat
hps = Chit -> Chat
prev Chit
chi
hns :: Chat
hns = Chit -> Chat
next Chit
chi
nxt :: String -> Context a -> Maybe String -> Context a
nxt String
p Context a
c Maybe String
o =
Context a
c
{ hist =
(hist c)
{ chit =
(chit $ hist c)
{ prev = p : hps
}
, chat =
case o of
Maybe String
Nothing -> History -> Chat
chat (History -> Chat) -> History -> Chat
forall a b. (a -> b) -> a -> b
$ Context a -> History
forall a. Context a -> History
hist Context a
c
Just String
r -> (String
rString -> Chat -> Chat
forall a. a -> [a] -> [a]
:) (Chat -> Chat) -> Chat -> Chat
forall a b. (a -> b) -> a -> b
$ History -> Chat
chat (History -> Chat) -> History -> Chat
forall a b. (a -> b) -> a -> b
$ Context a -> History
forall a. Context a -> History
hist Context a
c
}
}
caseMode :: String -> Char -> String -> RIO ()
caseMode String
txt Char
c String
cs =
case Maybe Mode
mmod of
Just Mode
mod ->
String -> RIO ()
printLn (String
"Changed to " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
low String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-mode") RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop
( (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing)
{ mode = mod
, pile = Just $ INT.FilePaths []
, ruck = Just $ INT.Files []
}
) Eval a
eval
where
low :: String
low = (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Mode -> String
forall a. Show a => a -> String
show Mode
mod
Maybe Mode
Nothing ->
String -> RIO ()
printLn (String
"Invalid mode: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
cs) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop Context a
ctx Eval a
eval
where
mmod :: Maybe Mode
mmod = String -> Maybe Mode
forall a. Read a => String -> Maybe a
readMaybe (Char -> Char
toUpper Char
c Char -> String -> String
forall a. a -> [a] -> [a]
: (Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower String
cs) :: Maybe INT.Mode
caseHist :: String -> Bool -> Bool -> RIO ()
caseHist String
txt Bool
chits Bool
chats =
( if Bool
chits then
String -> RIO ()
printLn String
"* Chits:" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
( (String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (Context a -> Chat) -> Context a -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (Context a -> [(String, String)]) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Chat -> [(String, String)]
UTL.chits Bool
True (Chat -> [(String, String)])
-> (Context a -> Chat) -> Context a -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Chit -> Chat
prev (Chit -> Chat) -> (Context a -> Chit) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Chit
chit (History -> Chit) -> (Context a -> History) -> Context a -> Chit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> History
forall a. Context a -> History
hist
) Context a
ctx
else
() -> RIO ()
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
( if Bool
chats then
String -> RIO ()
printLn String
"* Chats:" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
( (String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (Context a -> Chat) -> Context a -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (Context a -> [(String, String)]) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Chat -> [(String, String)]
UTL.chats Bool
True (Chat -> [(String, String)])
-> (Context a -> Chat) -> Context a -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. History -> Chat
chat (History -> Chat) -> (Context a -> History) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> History
forall a. Context a -> History
hist
) Context a
ctx
else
() -> RIO ()
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
caseExit :: RIO ()
caseExit =
String -> RIO ()
printLn String
"Λ-gent will shutdown" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
() -> RIO ()
forall a. a -> RIO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
caseFile :: String -> Bool -> Chat -> RIO ()
caseFile String
txt Bool
ns Chat
ls =
( (String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (String -> Chat) -> String -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (String -> [(String, String)]) -> String -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> String -> [(String, String)]
UTL.file Bool
ns
) (Chat -> String
unlines Chat
ls) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
caseHelp :: String -> RIO ()
caseHelp String
txt =
String -> RIO ()
printLn String
help RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
casePaths :: String -> Chat -> RIO ()
casePaths String
txt Chat
fps =
Eval a
eval Context a
ctx Message
MSG.Root RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
Paths (INT.FilePaths Chat
rfps) ->
( case Chat
rfps of
[String
cwd] ->
(String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (Chat -> Chat) -> Chat -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (Chat -> [(String, String)]) -> Chat -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Bool -> Chat -> [(String, String)]
UTL.files [] Bool
True (Chat -> [(String, String)])
-> (Chat -> Chat) -> Chat -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> String) -> Chat -> Chat
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cwd)) (Chat -> RIO ()) -> Chat -> RIO ()
forall a b. (a -> b) -> a -> b
$
Chat
fps
Chat
_____ ->
String -> RIO ()
printLn String
"Missing root path"
) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop
( (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing)
{ pile = Just $ INT.FilePaths fps
}
) Eval a
eval
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
casePile :: String -> RIO ()
casePile String
txt =
Eval a
eval Context a
ctx Message
MSG.Root RIO (Context a, Action)
-> ((Context a, Action) -> RIO ()) -> RIO ()
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ (Context a
upd, Action
action) ->
case Action
action of
Paths (INT.FilePaths Chat
fps) ->
( case Chat
fps of
[String
cwd] ->
(String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (Context a -> Chat) -> Context a -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (Context a -> [(String, String)]) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Bool -> Chat -> [(String, String)]
UTL.files [] Bool
True (Chat -> [(String, String)])
-> (Context a -> Chat) -> Context a -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(String -> String) -> Chat -> Chat
forall a b. (a -> b) -> [a] -> [b]
map (Int -> String -> String
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cwd)) (Chat -> Chat) -> (Context a -> Chat) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(FilePaths -> Chat) -> Maybe FilePaths -> Chat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePaths -> Chat
INT.filePaths (Maybe FilePaths -> Chat)
-> (Context a -> Maybe FilePaths) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Context a -> Maybe FilePaths
forall a. Context a -> Maybe FilePaths
pile (Context a -> RIO ()) -> Context a -> RIO ()
forall a b. (a -> b) -> a -> b
$
Context a
upd
Chat
_____ ->
String -> RIO ()
printLn String
"Missing root path"
) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Message (MSG.Text String
cs) ->
String -> RIO ()
printLn String
cs RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just String
cs)) Eval a
eval
Action
None ->
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd Maybe String
forall a. Maybe a
Nothing) Eval a
eval
Action
_________________________ ->
String -> RIO ()
printLn String
"Unexpected error" RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
upd (String -> Maybe String
forall a. a -> Maybe a
Just [])) Eval a
eval
caseRuck :: String -> String -> RIO ()
caseRuck String
txt String
midx =
( if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
midx then
( (String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (Context a -> Chat) -> Context a -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (Context a -> [(String, String)]) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
String -> Bool -> Chat -> [(String, String)]
UTL.files [] Bool
True (Chat -> [(String, String)])
-> (Context a -> Chat) -> Context a -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Files -> Chat) -> Maybe Files -> Chat
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Files -> Chat
fps (Maybe Files -> Chat)
-> (Context a -> Maybe Files) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Context a -> Maybe Files
forall a. Context a -> Maybe Files
ruck
) Context a
ctx
else
( case Maybe Int
idx of
Just Int
i ->
if Int
0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
i Bool -> Bool -> Bool
&& Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
len then
( (String -> RIO ()) -> Chat -> RIO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> RIO ()
printLn (Chat -> RIO ()) -> (Context a -> Chat) -> Context a -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
[(String, String)] -> Chat
UTL.combine ([(String, String)] -> Chat)
-> (Context a -> [(String, String)]) -> Context a -> Chat
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Bool -> String -> [(String, String)]
UTL.file Bool
True (String -> [(String, String)])
-> (Context a -> String) -> Context a -> [(String, String)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
(Files -> String) -> Maybe Files -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Files -> String
f (Maybe Files -> String)
-> (Context a -> Maybe Files) -> Context a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Context a -> Maybe Files
forall a. Context a -> Maybe Files
ruck
) Context a
ctx
else
let
m :: String
m = String
"Index (" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
i String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
") is out of bounds."
in
String -> RIO ()
printLn String
m
where
f :: Files -> String
f (INT.Files [File]
fs) =
case [File]
fs [File] -> Int -> File
forall a. HasCallStack => [a] -> Int -> a
!! Int
i of
INT.File (String
_,Chat
ls) -> Chat -> String
unlines Chat
ls
Maybe Int
Nothing ->
String -> RIO ()
printLn String
"Invalid use of /ruck. Use space between cmd and index"
)
) RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
where
idx :: Maybe Int
idx =
case String
midx of
[ ] -> Maybe Int
forall a. Maybe a
Nothing
Char
' ':String
cs -> String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe String
cs :: Maybe Int
String
______ -> Maybe Int
forall a. Maybe a
Nothing
len :: Int
len =
case Context a -> Maybe Files
forall a. Context a -> Maybe Files
ruck Context a
ctx of
Just (INT.Files [File]
fs) -> [File] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [File]
fs
Maybe Files
Nothing -> Int
0
fps :: Files -> Chat
fps (INT.Files [File]
fs) =
(File -> String) -> [File] -> Chat
forall a b. (a -> b) -> [a] -> [b]
map ( \ (INT.File (String
p,Chat
_)) -> String
p) [File]
fs
caseWipe :: String -> RIO ()
caseWipe String
txt =
String -> RIO ()
printLn String
clear RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
caseUnknownCmd :: String -> String -> RIO ()
caseUnknownCmd String
txt String
cmd =
String -> RIO ()
printLn String
msg RIO () -> RIO () -> RIO ()
forall a b. RIO a -> RIO b -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
Context a -> Eval a -> RIO ()
forall a. Context a -> Eval a -> RIO ()
loop (String -> Context a -> Maybe String -> Context a
forall {a}. String -> Context a -> Maybe String -> Context a
nxt String
txt Context a
ctx Maybe String
forall a. Maybe a
Nothing) Eval a
eval
where
msg :: String
msg = String
"Command not recognized: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
cmd
clear :: String
clear = String
"\^[[H\^[[2J"
prompt :: String
prompt =
(SelectGraphicRendition -> String
forall a. Show a => a -> String
show (SelectGraphicRendition -> String)
-> (String -> SelectGraphicRendition) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectGraphicRendition -> SelectGraphicRendition
AEC.bold (SelectGraphicRendition -> SelectGraphicRendition)
-> (String -> SelectGraphicRendition)
-> String
-> SelectGraphicRendition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SelectGraphicRendition
AEC.sgr)
(String
"Λ-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String) -> (Context a -> String) -> Context a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Mode -> String
forall a. Show a => a -> String
show (Mode -> String) -> (Context a -> Mode) -> Context a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Context a -> Mode
forall a. Context a -> Mode
mode) Context a
ctx String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"> ")
read :: Chat -> Chat -> RIO String
read = Chat -> Chat -> RIO String
forall (m :: * -> *). StdIn m => Chat -> Chat -> m String
input
print :: String -> RIO ()
print = String -> RIO ()
forall (m :: * -> *). StdOut m => String -> m ()
output (String -> RIO ()) -> (String -> String) -> String -> RIO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectGraphicRendition -> String
forall a. Show a => a -> String
show (SelectGraphicRendition -> String)
-> (String -> SelectGraphicRendition) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SelectGraphicRendition -> SelectGraphicRendition
AEC.faint (SelectGraphicRendition -> SelectGraphicRendition)
-> (String -> SelectGraphicRendition)
-> String
-> SelectGraphicRendition
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> SelectGraphicRendition
AEC.sgr
printLn :: String -> RIO ()
printLn String
x = String -> RIO ()
print (String -> RIO ()) -> String -> RIO ()
forall a b. (a -> b) -> a -> b
$ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
integrity :: IO (Either String ())
integrity :: IO (Either String ())
integrity =
do
Maybe String
ohi <- String -> IO (Maybe String)
ENV.getEnv String
"LLM_SIGN_SHA"
case Maybe String
ohi of
Maybe String
Nothing -> Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()
Just String
hi ->
do
Either String String
op <- IO (Either String String)
cwd
String
pn <- IO String
getProgName
case Either String String
op of
Left String
e -> Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left String
e
Right String
p ->
do
Either String String
ehf <- String -> IO (Either String String)
sha String
ap
case Either String String
ehf of
Left String
ef -> Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ String -> Either String ()
forall a b. a -> Either a b
Left String
ef
Right String
hf ->
if String
hi String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
h64 then
Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$ () -> Either String ()
forall a b. b -> Either a b
Right ()
else
Either String () -> IO (Either String ())
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String () -> IO (Either String ()))
-> Either String () -> IO (Either String ())
forall a b. (a -> b) -> a -> b
$
String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$
String
"# Λ-gent integrity failed:\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
hi String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (expected)\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++
String
"> " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
h64 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" (observed)"
where
h64 :: String
h64 = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
64 String
hf
where
ap :: String
ap =
(String -> String) -> Chat -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap String -> String
forall a. a -> a
id
(Chat -> String) -> Chat -> String
forall a b. (a -> b) -> a -> b
$ String -> Chat
lines String
p Chat -> Chat -> Chat
forall a. [a] -> [a] -> [a]
++ [ String
"/" ] Chat -> Chat -> Chat
forall a. [a] -> [a] -> [a]
++ String -> Chat
lines String
pn
where
cwd :: IO (Either String String)
cwd =
do
(ExitCode
exitcode, String
out, String
err) <- String -> Chat -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"pwd" [] []
case ExitCode
exitcode of
ExitCode
ExitSuccess ->
Either String String -> IO (Either String String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
out
ExitFailure Int
_ ->
Either String String -> IO (Either String String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
err
sha :: String -> IO (Either String String)
sha String
p =
do
(ExitCode
exitcode, String
out, String
err) <- String -> Chat -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"sha256sum" [ String
p ] []
case ExitCode
exitcode of
ExitCode
ExitSuccess ->
Either String String -> IO (Either String String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
out
ExitFailure Int
_ ->
Either String String -> IO (Either String String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> IO (Either String String))
-> Either String String -> IO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
err