{-# OPTIONS_GHC -Wall -Werror #-}

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

{-# LANGUAGE FlexibleContexts             #-}
{-# LANGUAGE UndecidableInstances         #-}

{-# LANGUAGE LambdaCase                   #-}

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

-- |
-- Copyright  : (c) 2026 SPISE MISU ApS
-- License    : SSPL-1.0 OR AGPL-3.0-only
-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>
-- Stability  : experimental
--
-- Safe {H}askell
--
-- https://simonmar.github.io/bib/safe-haskell-2012_abstract.html
--
-- (David Terei, David Mazières, Simon Marlow, Simon Peyton Jones) Haskell ’12:
-- Proceedings of the Fifth ACM SIGPLAN Symposium on Haskell, Copenhagen,
-- Denmark, ACM, 2012
--
-- Though Haskell is predominantly type-safe, implementations contain a few
-- loopholes through which code can bypass typing and module encapsulation. This
-- paper presents Safe Haskell, a language extension that closes these
-- loopholes. Safe Haskell makes it possible to confine and safely execute
-- untrusted, possibly malicious code. By strictly enforcing types, Safe Haskell
-- allows a variety of different policies from API sandboxing to
-- information-flow control to be implemented easily as monads. Safe Haskell is
-- aimed to be as unobtrusive as possible. It enforces properties that
-- programmers tend to meet already by convention. We describe the design of
-- Safe Haskell and an implementation (currently shipping with GHC) that infers
-- safety for code that lies in a safe subset of the language. We use Safe
-- Haskell to implement an online Haskell interpreter that can securely execute
-- arbitrary untrusted code with no overhead. The use of Safe Haskell greatly
-- simplifies this task and allows the use of a large body of existing code and
-- tools.

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

module Internal.RIO
  ( RIO ()
  , run
    -- * Environment
  , getEnvVar
    -- * Read/Print
  , input
  , output
    -- * LLM (Config)
  , llmPathCWD
    -- * LLM (Chat)
  , llmChatKey, llmChatAPI
  , llmChatWeb
    -- * LLM (Code)
  , llmCodeDir
  , llmCodeMsk
  , llmCodeIns, llmCodeExa
  , llmCodeSeq, llmCodeGet, llmCodeGit
  , llmCodePut
  , llmCodeKey, llmCodeAPI
  , llmCodeWeb
    -- * LLM (Plan)
  , llmPlanDir
  , llmPlanMsk
  , llmPlanSeq, llmPlanGet
  , llmPlanKey, llmPlanAPI
  , llmPlanWeb
    -- * Internal
  , findFiles
  , readFileStrict
    -- * Temp
  , timestampUTC
  )
where

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

import           Control.Exception        ( SomeException, try )
import           Data.Char                ( isDigit )
import           Data.Either              ( fromLeft, partitionEithers )
import           Data.List                ( isPrefixOf )
import           Data.Maybe               ( maybeToList )
import qualified System.Environment.Blank as ENV
import           System.Exit
  ( ExitCode (ExitFailure, ExitSuccess)
  )
import           System.IO
  ( hClose
  , hFlush
  , hGetContents
  , hPutStrLn
  , hReady
  , stdin
  , stdout
  )
import           System.Process
  ( CreateProcess (cwd, std_err, std_in, std_out)
  , StdStream (CreatePipe)
  , createProcess
  , proc
  , readCreateProcessWithExitCode
  , readProcessWithExitCode
  , waitForProcess
  )
import           Text.Read                ( readMaybe )

import qualified Internal.LLM             as LLM
import qualified Internal.Utils           as UTL

import qualified Agent.IO.Effects         as EFF

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

newtype RIO a = RestrictedIO { forall a. RIO a -> IO a
run :: IO a }

instance Functor RIO where
  fmap :: forall a b. (a -> b) -> RIO a -> RIO b
fmap a -> b
f RIO a
m = IO b -> RIO b
forall a. IO a -> RIO a
RestrictedIO (IO b -> RIO b) -> IO b -> RIO b
forall a b. (a -> b) -> a -> b
$      a -> b
f (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RIO a -> IO a
forall a. RIO a -> IO a
run RIO a
m

instance Applicative RIO where
  pure :: forall a. a -> RIO a
pure      = IO a -> RIO a
forall a. IO a -> RIO a
RestrictedIO (IO a -> RIO a) -> (a -> IO a) -> a -> RIO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  <*> :: forall a b. RIO (a -> b) -> RIO a -> RIO b
(<*>) RIO (a -> b)
f RIO a
m = IO b -> RIO b
forall a. IO a -> RIO a
RestrictedIO (IO b -> RIO b) -> IO b -> RIO b
forall a b. (a -> b) -> a -> b
$ RIO (a -> b) -> IO (a -> b)
forall a. RIO a -> IO a
run RIO (a -> b)
f IO (a -> b) -> IO a -> IO b
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RIO a -> IO a
forall a. RIO a -> IO a
run RIO a
m

instance Monad RIO where
  >>= :: forall a b. RIO a -> (a -> RIO b) -> RIO b
(>>=) RIO a
m a -> RIO b
f = IO b -> RIO b
forall a. IO a -> RIO a
RestrictedIO (IO b -> RIO b) -> IO b -> RIO b
forall a b. (a -> b) -> a -> b
$ RIO a -> IO a
forall a. RIO a -> IO a
run RIO a
m IO a -> (a -> IO b) -> IO b
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= RIO b -> IO b
forall a. RIO a -> IO a
run (RIO b -> IO b) -> (a -> RIO b) -> a -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> RIO b
f

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

data Position =
  Position !Int !Int
  deriving (Position -> Position -> Bool
(Position -> Position -> Bool)
-> (Position -> Position -> Bool) -> Eq Position
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Position -> Position -> Bool
== :: Position -> Position -> Bool
$c/= :: Position -> Position -> Bool
/= :: Position -> Position -> Bool
Eq, Int -> Position -> ShowS
[Position] -> ShowS
Position -> String
(Int -> Position -> ShowS)
-> (Position -> String) -> ([Position] -> ShowS) -> Show Position
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Position -> ShowS
showsPrec :: Int -> Position -> ShowS
$cshow :: Position -> String
show :: Position -> String
$cshowList :: [Position] -> ShowS
showList :: [Position] -> ShowS
Show)

instance Ord Position where
  <= :: Position -> Position -> Bool
(<=) (Position Int
y1 Int
x1) (Position Int
y2 Int
x2) =
    case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
y1 Int
y2 of
      Ordering
GT -> Bool
False
      Ordering
EQ -> Int
x1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
x2
      Ordering
LT -> Bool
True

instance Read Position where
  readsPrec :: Int -> ReadS Position
readsPrec Int
_ String
str =
    -- NOTE:
    -- "\^[[#;#R" => "\^[" and "[#;#R" (only parse last)
    Maybe (Position, String) -> [(Position, String)]
forall a. Maybe a -> [a]
maybeToList
    ( String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (ShowS
f String
str) Maybe Int
-> (Int -> Maybe (Position, String)) -> Maybe (Position, String)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Int
y ->
      String -> Maybe Int
forall a. Read a => String -> Maybe a
readMaybe (ShowS
g String
str) Maybe Int
-> (Int -> Maybe (Position, String)) -> Maybe (Position, String)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Int
x ->
        (Position, String) -> Maybe (Position, String)
forall a. a -> Maybe a
Just
          ( Int -> Int -> Position
Position Int
y Int
x
          , ShowS
h String
str
          )
    )
    where
      f :: ShowS
f = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[')
      g :: ShowS
g = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'R') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';')
      h :: ShowS
h = Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
1 ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'R') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
';') ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'[')

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

data MultiLine =
  MultiLine
    { MultiLine -> Maybe Position
stx :: !(Maybe Position)
    , MultiLine -> Maybe Position
cur :: !(Maybe Position)
    , MultiLine -> Maybe Position
etx :: !(Maybe Position)
    , MultiLine -> Int
col :: !Int
    }
  deriving Int -> MultiLine -> ShowS
[MultiLine] -> ShowS
MultiLine -> String
(Int -> MultiLine -> ShowS)
-> (MultiLine -> String)
-> ([MultiLine] -> ShowS)
-> Show MultiLine
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> MultiLine -> ShowS
showsPrec :: Int -> MultiLine -> ShowS
$cshow :: MultiLine -> String
show :: MultiLine -> String
$cshowList :: [MultiLine] -> ShowS
showList :: [MultiLine] -> ShowS
Show

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

class StdIn m where
  input
    :: [ String ]
    -> [ String ]
    -> m String

class StdOut m where
  output
    :: String
    -> m ()

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

instance StdIn RIO where
  input :: [String] -> [String] -> RIO String
input [String]
prev [String]
next =
    -- NOTE: "\^[7" - save cursor position (SCO)
    -- - https://gist.github.com/fnky/458719343aabd01cfb17a3a4f7296797#cursor-controls
    IO String -> RIO String
forall a. IO a -> RIO a
RestrictedIO (IO String -> RIO String) -> IO String -> RIO String
forall a b. (a -> b) -> a -> b
$ String -> IO ()
putStr String
"\^[7" IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
gen [String]
prev [String]
next [] []
    where
      msv :: Int
msv = Int
32767 :: Int
      gen :: MultiLine
gen =
        MultiLine
          { stx :: Maybe Position
stx = Maybe Position
forall a. Maybe a
Nothing
          , cur :: Maybe Position
cur = Maybe Position
forall a. Maybe a
Nothing
          , etx :: Maybe Position
etx = Maybe Position
forall a. Maybe a
Nothing
          , col :: Int
col = Int
0
          }
      aux :: MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs =
        IO String
block IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
blk ->
        case (String
blk String -> String -> Bool
forall a. Ord a => a -> a -> Bool
< [Char
'\32'], String
blk) of
          -- NOTE: To view keystrokes, use: `ghc -e getLine` (hit + ENTER) and
          -- then map to ASCII control codes (use Caret notation cos Λ prefix):
          --
          -- - https://en.wikipedia.org/wiki/ASCII#Control_code_table
          (Bool
True , [Char
'\^J'])                     -> IO String
caseEnter
          (Bool
True , [Char
'\^H'])                     -> IO String
caseBackspace
          (Bool
True , [Char
'\^[',Char
'[',Char
'3',Char
'~'])         -> IO String
caseDelete
          (Bool
True , [Char
'\^D'])                     -> IO String
caseDelete
          (Bool
True , [Char
'\^[',Char
'[',Char
'H'])             -> IO String
caseHome
          (Bool
True , [Char
'\^A'])                     -> IO String
caseHome
          (Bool
True , [Char
'\^[',Char
'[',Char
'F'])             -> IO String
caseEnd
          (Bool
True , [Char
'\^E'])                     -> IO String
caseEnd
          (Bool
True , [Char
'\^L'])                     -> IO String
caseWipe
          (Bool
True , [Char
'\^U'])                     -> IO String
caseWipeStart
          (Bool
True , [Char
'\^K'])                     -> IO String
caseWipeEnd
          (Bool
True , [Char
'\^[',Char
'[',Char
'A'])             -> IO String
caseArrowUp
          (Bool
True , [Char
'\^[',Char
'[',Char
'B'])             -> IO String
caseArrowDown
          (Bool
True , [Char
'\^[',Char
'[',Char
'C'])             -> String -> IO String
caseArrowRight String
blk
          (Bool
True , [Char
'\^[',Char
'[',Char
'D'])             -> String -> IO String
caseArrowLeft  String
blk
          (Bool
True , [Char
'\^[',Char
'[',Char
'1',Char
';',Char
'5',Char
'C']) -> IO String
caseArrowCtrlRight
          (Bool
True , [Char
'\^[',Char
'[',Char
'1',Char
';',Char
'5',Char
'D']) -> IO String
caseArrowCtrlLeft
          (Bool
True , Char
'\^[':String
ps)                    -> String -> IO String
casePositions String
ps
          (Bool
True , String
_)                           -> IO String
caseSkip
          (Bool
False, [Char
'\DEL'])                    -> IO String
caseSkip
          (Bool
False, String
_)                           -> String -> IO String
caseText String
blk
          where
            caseEnter :: IO String
caseEnter =
              -- NOTE: ENTER (line feed) only if something is typed
              case (String
bcs, String
acs) of
                ([], []) ->
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs
                (String, String)
________ ->
                  Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Move to end of text
                  String -> IO ()
putStr String
hom    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 IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  (String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> ShowS -> String -> IO String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
acs) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
forall a. [a] -> [a]
reverse) String
bcs
                  where
                    hom :: String
hom =
                      case MultiLine
mlp of
                        MultiLine { etx :: MultiLine -> Maybe Position
etx = Just (Position Int
y Int
x) } ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                        MultiLine
_______________________________________ ->
                          []
            caseBackspace :: IO String
caseBackspace =
              -- NOTE: BACKSPACE / CTRL + H (remove char if any and re-write
              -- after chars)
              case String
bcs of
                [    ] -> MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs
                (Char
_:String
cs) ->
                  Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 0) Print "\^[[6n" position before action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Remove char
                  Char -> IO ()
putChar Char
'\^H'                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Save position
                  String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Clear rest of screen from position
                  String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Print after chars
                  String -> IO ()
putStr  String
acs                        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 1) Print "\^[[6n" end position after action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 2) Print "\^[[6n" column witdh
                  String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Go back to saved position
                  String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 3) Print "\^[[6n" current position after action
                  String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
cs String
acs
            caseDelete :: IO String
caseDelete =
              -- NOTE: DELETE / CTRL + D behave as delete key
              case String
acs of
                -- NOTE: Delete (remove char if any and re-write after chars)
                [    ] -> MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs
                (Char
_:String
cs) ->
                  Handle -> IO ()
hFlush Handle
stdout                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 0) Print "\^[[6n" position before action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Save position
                  String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Clear rest of screen from position
                  String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Print after chars
                  String -> IO ()
putStr  String
cs                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 1) Print "\^[[6n" end position after action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 2) Print "\^[[6n" column witdh
                  String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Go back to saved position
                  String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 3) Print "\^[[6n" current position after action
                  String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
cs
            caseHome :: IO String
caseHome =
              -- NOTE: HOME / CTRL + A to move to start of text
              Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
hom    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 IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mln [String]
hps [String]
hns [] (ShowS
forall a. [a] -> [a]
reverse String
bcs String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
acs)
              where
                (MultiLine
mln, String
hom) =
                  case MultiLine
mlp of
                    MultiLine { stx :: MultiLine -> Maybe Position
stx = Just (Position Int
y Int
x) } ->
                      ( MultiLine
mlp { cur = Just (Position y x) }
                      , String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                      )
                    MultiLine
_______________________________________ ->
                      ( MultiLine
mlp
                      , String
"\^[8"
                      )
            caseEnd :: IO String
caseEnd =
              -- NOTE: END / CTRL + E to move to end of text
              Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
hom    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 IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mln [String]
hps [String]
hns ((String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bcs) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
acs) []
              where
                (MultiLine
mln, String
hom) =
                  case MultiLine
mlp of
                    MultiLine { etx :: MultiLine -> Maybe Position
etx = Just (Position Int
y Int
x) } ->
                      ( MultiLine
mlp { cur = Just (Position y x) }
                      , String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                      )
                    MultiLine
_______________________________________ ->
                      ( MultiLine
mlp
                      , []
                      )
            caseWipe :: IO String
caseWipe =
              -- NOTE: CTRL + L (form feed) becomes "/w" (clear screen)
              String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"/wipe"
            caseWipeStart :: IO String
caseWipeStart =
              -- NOTE: CTRL + U cut text to start
              Handle -> IO ()
hFlush Handle
stdout                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 0) Print "\^[[6n" position before action
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Go back to start of line
              String -> IO ()
putStr String
hom                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Save position
              String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Clear rest of screen from position
              String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Print after chars
              String -> IO ()
putStr  String
acs                        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 1) Print "\^[[6n" end position after action
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 2) Print "\^[[6n" column witdh
              String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Go back to saved position
              String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 3) Print "\^[[6n" current position after action
              String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns [] String
acs
              where
                hom :: String
hom =
                  case MultiLine
mlp of
                    MultiLine { stx :: MultiLine -> Maybe Position
stx = Just (Position Int
y Int
x) } ->
                      String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                    MultiLine
_______________________________________ ->
                      String
"\^[8"
            caseWipeEnd :: IO String
caseWipeEnd =
              -- NOTE: CTRL + K cut text to end
              Handle -> IO ()
hFlush Handle
stdout                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 0) Print "\^[[6n" position before action
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Save position
              String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Clear rest of screen from position
              String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 1) Print "\^[[6n" end position after action
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 2) Print "\^[[6n" column witdh
              String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Go back to saved position
              String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 3) Print "\^[[6n" current position after action
              String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs []
            caseArrowUp :: IO String
caseArrowUp =
              -- NOTE: Allowed escaped sequences: Arrow "↑"
              case ([String]
hps, [String]
hns) of
                ([  ], [String]
_) -> MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs
                (String
p:[String]
ps, [String]
_) ->
                  Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 0) Print "\^[[6n" position before action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Move to start of text
                  String -> IO ()
putStr String
hom                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Print previous line
                  String -> IO ()
putStr String
p                           IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Save position
                  String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Clear rest of screen from position
                  String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Print after chars
                  String -> IO ()
putStr  []                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 1) Print "\^[[6n" end position after action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 2) Print "\^[[6n" column witdh
                  String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Go back to saved position
                  String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 3) Print "\^[[6n" current position after action
                  String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
ps (String
pString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
hns) String
rev []
                  where
                    rev :: String
rev = ShowS
forall a. [a] -> [a]
reverse String
p
                    hom :: String
hom =
                      case MultiLine
mlp of
                        MultiLine { stx :: MultiLine -> Maybe Position
stx = Just (Position Int
y Int
x) } ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                        MultiLine
_______________________________________ ->
                          String
"\^[8"
            caseArrowDown :: IO String
caseArrowDown =
              -- NOTE: Allowed escaped sequences: Arrow "↓"
              case ([String]
hps, [String]
hns) of
                ([String]
_, [  ]) -> MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs
                ([String]
_, String
p:[String]
ps) ->
                  Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 0) Print "\^[[6n" position before action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Move to start of text
                  String -> IO ()
putStr String
hom                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Print previous line
                  String -> IO ()
putStr String
p                           IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Save position
                  String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Clear rest of screen from position
                  String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Print after chars
                  String -> IO ()
putStr  []                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 1) Print "\^[[6n" end position after action
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 2) Print "\^[[6n" column witdh
                  String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Go back to saved position
                  String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: 3) Print "\^[[6n" current position after action
                  String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp (String
pString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
hps) [String]
ps String
rev []
                  where
                    rev :: String
rev = ShowS
forall a. [a] -> [a]
reverse String
p
                    hom :: String
hom =
                      case MultiLine
mlp of
                        MultiLine { stx :: MultiLine -> Maybe Position
stx = Just (Position Int
y Int
x) } ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                        MultiLine
_______________________________________ ->
                          String
"\^[8"
            caseArrowRight :: String -> IO String
caseArrowRight String
str =
              -- NOTE: Allowed escaped sequences: Arrow "→"
              case (String
bcs, String
acs) of
                (String
_, [  ]) ->
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns    String
bcs  String
acs
                (String
_, Char
c:String
cs) ->
                  Handle -> IO ()
hFlush Handle
stdout   IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  ( if Bool
pl then
                      String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"1" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"E")
                    else
                      String -> IO ()
putStr String
str
                  ) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Update current position
                  String -> IO ()
putStr String
"\^[[6n" 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   IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
bcs) String
cs
                  where
                    pl :: Bool
pl =
                      case MultiLine
mlp of
                        MultiLine
                          { cur :: MultiLine -> Maybe Position
cur = Just (Position Int
cy Int
cx)
                          , etx :: MultiLine -> Maybe Position
etx = Just (Position Int
ey Int
__)
                          , col :: MultiLine -> Int
col = Int
cw
                          } -> Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ey Bool -> Bool -> Bool
&& Int
cx Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
cw
                        MultiLine
___ -> Bool
False
            caseArrowLeft :: String -> IO String
caseArrowLeft String
str =
              -- NOTE: Allowed escaped sequences: Arrow "←"
              case (String
bcs, String
acs) of
                ([  ], String
_) ->
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs    String
acs
                (Char
c:String
cs, String
_) ->
                  Handle -> IO ()
hFlush Handle
stdout IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  ( if Bool
pl then
                      String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++      String
"1" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"F") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                      String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C")
                    else
                      String -> IO ()
putStr String
str
                  ) IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  -- NOTE: Update current position
                  String -> IO ()
putStr String
"\^[[6n" 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 IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
                  MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns  String
cs (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
acs)
                  where
                    pl :: Bool
pl =
                      case MultiLine
mlp of
                        MultiLine
                          { stx :: MultiLine -> Maybe Position
stx = Just (Position Int
sy Int
__)
                          , cur :: MultiLine -> Maybe Position
cur = Just (Position Int
cy Int
01)
                          } -> Int
sy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cy
                        MultiLine
___ -> Bool
False
            caseArrowCtrlRight :: IO String
caseArrowCtrlRight =
              -- NOTE: Allowed escaped sequences: CTRL + Arrow "→"
              -- NOTE: Move to end of text
              Handle -> IO ()
hFlush Handle
stdout   IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
np       IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Update current position
              String -> IO ()
putStr String
"\^[[6n" 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   IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns (String
ts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bcs) String
ds
              where
                ds :: String
ds = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
acs
                ts :: String
ts = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ds) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
acs
                lc :: Int
lc = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ts
                np :: String
np =
                  case MultiLine
mlp of
                    MultiLine
                      { cur :: MultiLine -> Maybe Position
cur = Just (Position Int
cy Int
cx)
                      , etx :: MultiLine -> Maybe Position
etx = Just (Position Int
ey Int
_ )
                      , col :: MultiLine -> Int
col = Int
cw
                      } ->
                      case (Int
cy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
ey, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Int
cw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cx) Int
lc) of
                        (Bool
True, Ordering
LT) ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                          where
                            y :: Int
y = Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
                            x :: Int
x = Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
cw Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cx)
                        (Bool, Ordering)
__________ ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                          where
                            y :: Int
y = Int
cy
                            x :: Int
x = Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
lc
                    MultiLine
___ -> []
            caseArrowCtrlLeft :: IO String
caseArrowCtrlLeft =
              -- NOTE: Allowed escaped sequences: CTRL + Arrow "←"
              Handle -> IO ()
hFlush Handle
stdout   IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
np       IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Update current position
              String -> IO ()
putStr String
"\^[[6n" 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   IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
ds (String
ts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
acs)
              where
                ds :: String
ds = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ') ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ') String
bcs
                ts :: String
ts = Int -> ShowS
forall a. Int -> [a] -> [a]
drop (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ds) ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ ShowS
forall a. [a] -> [a]
reverse String
bcs
                lc :: Int
lc = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
ts
                np :: String
np =
                  case MultiLine
mlp of
                    MultiLine
                      { stx :: MultiLine -> Maybe Position
stx = Just (Position Int
sy Int
_ )
                      , cur :: MultiLine -> Maybe Position
cur = Just (Position Int
cy Int
cx)
                      , col :: MultiLine -> Int
col = Int
cw
                      } ->
                      case (Int
sy Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
cy, Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
cx Int
lc) of
                        (Bool
True, Ordering
LT) ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                          where
                            y :: Int
y = Int
cy Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                            x :: Int
x = Int
cw Int -> Int -> Int
forall a. Num a => a -> a -> a
- (Int
lc Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cx)
                        (Bool, Ordering)
__________ ->
                          String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
y String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
";" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"H"
                          where
                            y :: Int
y = Int
cy
                            x :: Int
x = Int
cx Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lc
                    MultiLine
___ -> []
            casePositions :: String -> IO String
casePositions String
ps =
              -- NOTE: Other escaped sequences (skip unless positions)
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mln [String]
hps [String]
hns String
bcs String
acs
              where
                ops :: [Maybe Position]
ops = (String -> Maybe Position) -> [String] -> [Maybe Position]
forall a b. (a -> b) -> [a] -> [b]
map String -> Maybe Position
forall a. Read a => String -> Maybe a
readMaybe ([String] -> [Maybe Position]) -> [String] -> [Maybe Position]
forall a b. (a -> b) -> a -> b
$ Char -> String -> [String]
UTL.split Char
'\^[' String
ps :: [Maybe Position]
                mln :: MultiLine
mln =
                  -- NOTE: 0) Print "\^[[6n" position before action (unused)
                  -- NOTE: 1) Print "\^[[6n" end position after action
                  -- NOTE: 2) Print "\^[[6n" column witdh
                  -- NOTE: 3) Print "\^[[6n" current position after action
                  case (MultiLine
mlp, [Maybe Position]
ops) of
                    (MultiLine
___________________________,
                     [                                           ]) ->
                      MultiLine
mlp
                    (MultiLine { stx :: MultiLine -> Maybe Position
stx = Maybe Position
Nothing },
                     [Just (Position Int
y Int
x)                        ]) ->
                      MultiLine
mlp
                        { stx = Just sp
                        , cur = Just sp
                        , etx = Just sp
                        , col = x
                        }
                      where
                        sp :: Position
sp = Int -> Int -> Position
Position Int
y Int
x
                    (MultiLine { etx :: MultiLine -> Maybe Position
etx = Just Position
ep },
                     [Just Position
cp                                    ]) ->
                      if Position
cp Position -> Position -> Bool
forall a. Ord a => a -> a -> Bool
> Position
ep then
                        MultiLine
mlp
                          { cur = Just cp
                          , etx = Just cp
                          }
                      else
                        MultiLine
mlp
                          { cur = Just cp
                          }
                    (MultiLine { stx :: MultiLine -> Maybe Position
stx = Maybe Position
Nothing },
                     [Just Position
sp,Just Position
ep,Just (Position Int
_ Int
w),Just Position
cp]) ->
                      MultiLine
mlp
                        { stx = Just sp
                        , cur = Just cp
                        , etx = Just ep
                        , col = w
                        }
                    (MultiLine
___________________________,
                     [Just Position
__,Just Position
ep,Just (Position Int
_ Int
w),Just Position
cp]) ->
                      MultiLine
mlp
                        { cur = Just cp
                        , etx = Just ep
                        , col = w
                        }
                    (MultiLine, [Maybe Position])
_______________________________________________ ->
                      MultiLine
mlp
            caseSkip :: IO String
caseSkip =
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns String
bcs String
acs
            caseText :: String -> IO String
caseText String
str =
              Handle -> IO ()
hFlush Handle
stdout                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 0) Print "\^[[6n" position before action
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Type key or text
              String -> IO ()
putStr String
str                         IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Save position
              String -> IO ()
putStr String
"\^[7"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Clear rest of screen from position
              String -> IO ()
putStr String
"\^[[0J"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Print after chars
              String -> IO ()
putStr  String
acs                        IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 1) Print "\^[[6n" end position after action
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 2) Print "\^[[6n" column witdh
              String -> IO ()
putStr (String
"\^[[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
msv String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"C") IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              String -> IO ()
putStr String
"\^[[6n"                    IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: Go back to saved position
              String -> IO ()
putStr String
"\^[8"                      IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              -- NOTE: 3) Print "\^[[6n" current position after action
              String -> IO ()
putStr String
"\^[[6n"                    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                      IO () -> IO String -> IO String
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>>
              MultiLine -> [String] -> [String] -> String -> String -> IO String
aux MultiLine
mlp [String]
hps [String]
hns (ShowS
forall a. [a] -> [a]
reverse String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
bcs) String
acs
      block :: IO String
block =
        -- NOTE: https://stackoverflow.com/a/38553473
        --
        -- We refactored and named it `block` instead of `key` as it is possible
        -- to paste a huge block of text. Calling that a keystroke, doesn't seem
        -- appropiate
        ShowS
forall a. [a] -> [a]
reverse ShowS -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO String
nxt []
        where
          nxt :: String -> IO String
nxt String
cs =
            do
              Char
c <- IO Char
getChar
              Bool
m <- Handle -> IO Bool
hReady Handle
stdin
              (if Bool
m then String -> IO String
nxt else String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure) (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
cs)

instance StdOut RIO where
  output :: String -> RIO ()
output String
x = IO () -> RIO ()
forall a. IO a -> RIO a
RestrictedIO (IO () -> RIO ()) -> IO () -> RIO ()
forall a b. (a -> b) -> a -> b
$
    String -> IO ()
putStr String
x 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

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

class
  EFF.LlmConf m
  => LlmConf m
  where
    llmPathCWD
      :: m (Maybe LLM.Root)

instance
  EFF.LlmConf RIO
  => LlmConf RIO
  where
    llmPathCWD :: RIO (Maybe Root)
llmPathCWD =
      ( \ case
          Just String
rp -> Root -> Maybe Root
forall a. a -> Maybe a
Just (Root -> Maybe Root) -> Root -> Maybe Root
forall a b. (a -> b) -> a -> b
$ String -> Root
LLM.Root String
rp
          Maybe String
Nothing -> Maybe Root
forall a. Maybe a
Nothing
      )
      (Maybe String -> Maybe Root)
-> RIO (Maybe String) -> RIO (Maybe Root)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO (Maybe String)
getEnvVar String
"LLM_PATH_CWD"

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

class
  EFF.LlmChatConf m
  => LlmChatConf m
  where
    llmChatAPI
      :: m (Maybe String)
    llmChatKey
      :: m (Maybe String)

instance
  EFF.LlmChatConf RIO
  => LlmChatConf RIO
  where
    llmChatAPI :: RIO (Maybe String)
llmChatAPI = String -> RIO (Maybe String)
getEnvVar String
"LLM_CHAT_LOCALHOST_API"
    llmChatKey :: RIO (Maybe String)
llmChatKey = Maybe String -> RIO (Maybe String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing

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

class
  EFF.LlmChatConf m
  => LlmChatPost m
  where
    llmChatWeb
      :: String -> m (Either String String)

instance
  EFF.LlmChatConf RIO
  => LlmChatPost RIO
  where
    llmChatWeb :: String -> RIO (Either String String)
llmChatWeb String
json =
      RIO (Maybe String)
forall (m :: * -> *). LlmChatConf m => m (Maybe String)
EFF.llmChatAPI RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mapi ->
      RIO (Maybe String)
forall (m :: * -> *). LlmChatConf m => m (Maybe String)
EFF.llmChatKey RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mkey ->
      String
-> Maybe String -> Maybe String -> RIO (Either String String)
llmCurl String
json Maybe String
mapi Maybe String
mkey

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

class
  EFF.LlmConf m
  => LlmCodeRoot m
  where
    llmCodeDir
      :: m String

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmCodeRoot RIO
  )
  => LlmCodeRoot RIO
  where
    llmCodeDir :: RIO String
llmCodeDir = String -> RIO String
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"src"

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

class
  EFF.LlmCodeMask m
  => LlmCodeMask m
  where
    llmCodeMsk
      :: m [String]

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmCodeMask RIO
  )
  => LlmCodeMask RIO
  where
    llmCodeMsk :: RIO [String]
llmCodeMsk = [String] -> RIO [String]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure [ String
"*.hs" ]

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

class
  EFF.LlmCodeTmpl m
  => LlmCodeTmpl m
  where
    llmCodeIns
      :: m [LLM.File]
    llmCodeExa
      :: m [LLM.File]

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmCodeTmpl RIO
  )
  => LlmCodeTmpl RIO
  where
    llmCodeIns :: RIO [File]
llmCodeIns =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root) -> (Maybe Root -> RIO [File]) -> RIO [File]
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      case Maybe Root
ocwd of
        Just (LLM.Root String
root) ->
          String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"llm") RIO (Either String String)
-> (Either String String -> RIO [File]) -> RIO [File]
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            -- TODO: DRY
            Right String
fap ->
              String -> String -> RIO (Either String [String])
findFiles String
fap String
"*code_instructions_*.json" RIO (Either String [String])
-> (Either String [String] -> RIO [File]) -> RIO [File]
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String [String]
eafps ->
              case Either String [String]
eafps of
                Right [String]
afps ->
                  (String -> RIO File) -> [String] -> RIO [File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                  ( \ String
abspath ->
                      (String, [String]) -> File
LLM.File ((String, [String]) -> File)
-> (String -> (String, [String])) -> String -> File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
abspath ([String] -> (String, [String]))
-> (String -> [String]) -> String -> (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
                      (String -> File) -> RIO String -> RIO File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO String
readFileStrict String
abspath
                  ) [String]
afps
                Left  String
__ ->
                  [File] -> RIO [File]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Left String
____ ->
              [File] -> RIO [File]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Maybe Root
Nothing ->
          [File] -> RIO [File]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

    llmCodeExa :: RIO [File]
llmCodeExa =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root) -> (Maybe Root -> RIO [File]) -> RIO [File]
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      case Maybe Root
ocwd of
        Just (LLM.Root String
root) ->
          String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"llm") RIO (Either String String)
-> (Either String String -> RIO [File]) -> RIO [File]
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            -- TODO: DRY
            Right String
fap ->
              String -> String -> RIO (Either String [String])
findFiles String
fap String
"*code_examples_*.md" RIO (Either String [String])
-> (Either String [String] -> RIO [File]) -> RIO [File]
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String [String]
eafps ->
              case Either String [String]
eafps of
                Right [String]
afps ->
                  (String -> RIO File) -> [String] -> RIO [File]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                  ( \ String
abspath ->
                      (String, [String]) -> File
LLM.File ((String, [String]) -> File)
-> (String -> (String, [String])) -> String -> File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) String
abspath ([String] -> (String, [String]))
-> (String -> [String]) -> String -> (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
                      (String -> File) -> RIO String -> RIO File
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO String
readFileStrict String
abspath
                  ) [String]
afps
                Left  String
__ ->
                  [File] -> RIO [File]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
            Left String
____ ->
              [File] -> RIO [File]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
        Maybe Root
Nothing ->
          [File] -> RIO [File]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []

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

class
  ( EFF.LlmConf     m
  , EFF.LlmCodeRoot m
  , EFF.LlmCodeMask m
  )
  => LlmCodeRead m
  where
    llmCodeSeq
      :: Maybe LLM.Filter
      -> m (Either [String] LLM.FilePaths)
    llmCodeGet
      :: LLM.AbsoluteFilePath
      -> m (Either String LLM.File)
    llmCodeGit
      :: m (Either String String)

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmCodeRoot RIO
  , EFF.LlmCodeMask RIO
  )
  => LlmCodeRead RIO
  where
    llmCodeSeq :: Maybe Filter -> RIO (Either [String] FilePaths)
llmCodeSeq Maybe Filter
mfilter =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root)
-> (Maybe Root -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      case Maybe Root
ocwd of
        Just (LLM.Root String
root) ->
          RIO String
forall (m :: * -> *). LlmCodeRoot m => m String
EFF.llmCodeDir          RIO String
-> (String -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
cdir ->
          RIO [String]
forall (m :: * -> *). LlmCodeMask m => m [String]
EFF.llmCodeMsk          RIO [String]
-> ([String] -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [String]
cmsk ->
          String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cdir) RIO (Either String String)
-> (Either String String -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            -- TODO: DRY
            Right String
fap ->
              ( \ case
                  ([], [[String]]
rs) -> FilePaths -> Either [String] FilePaths
forall a b. b -> Either a b
Right (FilePaths -> Either [String] FilePaths)
-> FilePaths -> Either [String] FilePaths
forall a b. (a -> b) -> a -> b
$ [String] -> FilePaths
LLM.FilePaths ([String] -> FilePaths) -> [String] -> FilePaths
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [[String]]
rs
                  ([String]
ls, [[String]]
__) -> [String] -> Either [String] FilePaths
forall a b. a -> Either a b
Left                            [String]
ls
              )
              (([String], [[String]]) -> Either [String] FilePaths)
-> ([Either String [String]] -> ([String], [[String]]))
-> [Either String [String]]
-> Either [String] FilePaths
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [String]] -> ([String], [[String]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
              ([Either String [String]] -> Either [String] FilePaths)
-> RIO [Either String [String]] -> RIO (Either [String] FilePaths)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> RIO (Either String [String]))
-> [String] -> RIO [Either String [String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ String
msk -> String -> String -> RIO (Either String [String])
findFiles String
fap (String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fil String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msk)) [String]
cmsk
            Left String
err ->
              Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [String] FilePaths -> RIO (Either [String] FilePaths))
-> Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a b. (a -> b) -> a -> b
$ [String] -> Either [String] FilePaths
forall a b. a -> Either a b
Left [String
err]
        Maybe Root
Nothing ->
          Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [String] FilePaths -> RIO (Either [String] FilePaths))
-> Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a b. (a -> b) -> a -> b
$ [String] -> Either [String] FilePaths
forall a b. a -> Either a b
Left [String
noLlmConf]
      where
        fil :: String
fil =
          case Maybe Filter
mfilter of
            Just (LLM.Filter String
f) ->  String
f
            Maybe Filter
Nothing             -> [ ]

    llmCodeGet :: AbsoluteFilePath -> RIO (Either String File)
llmCodeGet (LLM.AbsoluteFilePath String
abspath) =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root)
-> (Maybe Root -> RIO (Either String File))
-> RIO (Either String File)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      RIO String
forall (m :: * -> *). LlmCodeRoot m => m String
EFF.llmCodeDir RIO String
-> (String -> RIO (Either String File)) -> RIO (Either String File)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
cdir ->
      case Maybe Root
ocwd of
        -- TODO: DRY
        Just (LLM.Root String
root) ->
          String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cdir) RIO (Either String String)
-> (Either String String -> RIO (Either String File))
-> RIO (Either String File)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            Right String
fap ->
              if String
fap String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
abspath then
                -- NOTE: Root relative path
                File -> Either String File
forall a b. b -> Either a b
Right (File -> Either String File)
-> (String -> File) -> String -> Either String File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> File
LLM.File ((String, [String]) -> File)
-> (String -> (String, [String])) -> String -> File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
len String
abspath) ([String] -> (String, [String]))
-> (String -> [String]) -> String -> (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
                (String -> Either String File)
-> RIO String -> RIO (Either String File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO String
readFileStrict String
abspath
              else
                Either String File -> RIO (Either String File)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String File -> RIO (Either String File))
-> Either String File -> RIO (Either String File)
forall a b. (a -> b) -> a -> b
$ String -> Either String File
forall a b. a -> Either a b
Left (String -> Either String File) -> String -> Either String File
forall a b. (a -> b) -> a -> b
$ String -> String -> Mode -> String
notPrefixRootAndMode String
fap String
abspath Mode
LLM.Code
            Left  String
err ->
              Either String File -> RIO (Either String File)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String File -> RIO (Either String File))
-> Either String File -> RIO (Either String File)
forall a b. (a -> b) -> a -> b
$ String -> Either String File
forall a b. a -> Either a b
Left String
err
            where
              len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
root
        Maybe Root
Nothing ->
          Either String File -> RIO (Either String File)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String File -> RIO (Either String File))
-> Either String File -> RIO (Either String File)
forall a b. (a -> b) -> a -> b
$ String -> Either String File
forall a b. a -> Either a b
Left String
noLlmConf

    llmCodeGit :: RIO (Either String String)
llmCodeGit =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root)
-> (Maybe Root -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      case Maybe Root
ocwd of
        Just (LLM.Root String
root) ->
          String -> RIO (Either String String)
realPath String
root RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            -- TODO: DRY
            Right String
fap ->
              String -> RIO Bool
gitExist String
fap RIO Bool
-> (Bool -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Bool
igit ->
              if Bool
igit then
                String -> RIO (Either String String)
gitBranchesDesc String
fap
              else
                Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"No GIT repo initialized"
            Left String
err ->
              Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
err
        Maybe Root
Nothing ->
          Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
noLlmConf

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

class
  ( EFF.LlmConf m
  , EFF.LlmCodeRoot m
  )
  => LlmCodeSave m
  where
    llmCodePut
      :: String
      -> LLM.Files
      -> m (Either String String)

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmCodeRoot RIO
  )
  => LlmCodeSave RIO
  where
    -- TODO: Needs some refactoring at some point …
    llmCodePut :: String -> Files -> RIO (Either String String)
llmCodePut String
___ (LLM.Files []) =
      Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"No files provided, therefore no action performed"
    llmCodePut String
txt (LLM.Files [File]
fs) =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root)
-> (Maybe Root -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      RIO String
forall (m :: * -> *). LlmCodeRoot m => m String
EFF.llmCodeDir RIO String
-> (String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
cdir ->
      case Maybe Root
ocwd of
        Just (LLM.Root String
root) ->
          String -> RIO (Either String String)
realPath String
root RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
erap ->
          case Either String String
erap of
            Right String
rp ->
              String -> RIO Bool
gitExist     String
rp RIO Bool
-> (Bool -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Bool
igit ->
              String -> RIO Bool
gitignoreTmp String
rp RIO Bool
-> (Bool -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Bool
itmp ->
              case (Bool
igit, Bool
itmp) of
                (Bool
True,  Bool
True) ->
                  RIO (Maybe String)
timestampUTC RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mts ->
                  case Maybe String
mts of
                    Just String
ts ->
                      String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"tmp") RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
etmp ->
                      case Either String String
etmp of
                        Right String
tmp ->
                          String -> String -> String -> RIO (Either String String)
gitWorktreeAdd String
root String
ts String
tap RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewta ->
                          (
                            (File -> RIO (Either String String))
-> [File] -> RIO [Either String String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM
                              ( \ (LLM.File (String
fp, [String]
fls)) ->
                                  let
                                    fil :: String
fil = String
tap String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fp
                                    len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
tap String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/"
                                  in
                                    if String
dir String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
fil then
                                      String -> String -> RIO (Either String String)
ensureFolderPath String
tap String
fil           RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
eefp ->
                                      String -> String -> RIO (Either String String)
writeFileStrict  String
fil ([String] -> String
unlines [String]
fls) RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewfs ->
                                      case (Either String String
eefp, Either String String
ewfs) of
                                        (Right String
efp, Right String
wfs) ->
                                          Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                                          [ String
"* Ensuring folder exists:"
                                          , String
efp
                                          , String
"* Writing file to folder:"
                                          , String
wfs
                                          ]
                                        (Either String String
_, Either String String
_) ->
                                          Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                                          [ String
"* Ensuring folder exists:"
                                          , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
eefp
                                          , String
"* Writing file to folder:"
                                          , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
ewfs
                                          ]
                                    else
                                      Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$
                                      ( (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
len String
fil) String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        String
" doesn't start with " String -> ShowS
forall a. [a] -> [a] -> [a]
++
                                        (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
len String
dir)
                                      )
                              )
                            [File]
fs
                          ) RIO [Either String String]
-> ([Either String String] -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [Either String String]
ewfs ->
                          String -> RIO (Either String String)
gitAddFiles         String
tap     RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewaf ->
                          String -> String -> RIO (Either String String)
gitCommit           String
tap String
txt RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewcf ->
                          String -> String -> RIO (Either String String)
gitWorktreeRem String
root String
tap     RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewrf ->
                          case
                            ( Either String String
ewta
                            , [Either String String] -> ([String], [String])
forall a b. [Either a b] -> ([a], [b])
partitionEithers [Either String String]
ewfs
                            , Either String String
ewaf
                            , Either String String
ewcf
                            , Either String String
ewrf
                            )
                          of
                            (   Right String
wta
                              , ( []
                                , [String]
xs
                                )
                              , Right String
___
                              , Right String
wcf
                              , Right String
wrf
                              ) ->
                              String -> String -> String -> RIO (Either String String)
gitUpdateBranchDesc String
root String
ts String
txt RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewtb ->
                              case Either String String
ewtb of
                                Right String
_ ->
                                  Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                                  [ String
"# Temporary worktree branch:"
                                  , String
"## Adding:"
                                  , String
wta
                                  , String
"## Saving files:"
                                  , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
xs
                                  , String
"## Adding files and committing :"
                                  , String
wcf
                                  , String
"## Removing:"
                                  , String
wrf
                                  ]
                                Left  String
e ->  Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
e
                            ( Either String String
_, ([String]
es,[String]
__), Either String String
_, Either String String
_, Either String String
_) ->
                              String -> String -> String -> RIO (Either String String)
gitUpdateBranchDesc String
root String
ts String
err RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
ewtb ->
                              case Either String String
ewtb of
                                Right String
_ ->
                                  Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
                                  [ String
"# Temporary worktree branch error(s):"
                                  , String
"## Adding:"
                                  , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
ewta
                                  , String
"## Adding description:"
                                  , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
ewtb
                                  , String
"## Saving files:"
                                  , [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [String]
es
                                  , String
"## Adding files:"
                                  , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
ewaf
                                  , String
"## Committing:"
                                  , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
ewcf
                                  , String
"## Removing:"
                                  , String -> Either String String -> String
forall a b. a -> Either a b -> a
fromLeft String
"No error" Either String String
ewrf
                                  ]
                                Left  String
e ->  Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
e
                              where
                                err :: String
err = String
"[ERROR]: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
txt
                          where
                            tap :: String
tap = String
tmp String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ts
                            dir :: String
dir = String
tap String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
cdir
                        Left  String
e ->
                          Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
e
                    Maybe String
_______ ->
                      Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"No timestamp"
                (Bool
False, Bool
____) ->
                  Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"No GIT repo initialized"
                (Bool
____, Bool
False) ->
                  Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
"No /tmp/ folder added to the .gitignore file"
            Left String
err ->
              Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
err
        Maybe Root
Nothing ->
          Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
noLlmConf

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

class
  ( EFF.LlmConf m
  , EFF.LlmCodeConf m
  )
  => LlmCodeConf m
  where
    llmCodeAPI
      :: m (Maybe String)
    llmCodeKey
      :: m (Maybe String)

instance
  ( EFF.LlmConf RIO
  , EFF.LlmCodeConf RIO
  )
  => LlmCodeConf RIO
  where
    llmCodeAPI :: RIO (Maybe String)
llmCodeAPI = String -> RIO (Maybe String)
getEnvVar String
"LLM_CODE_LOCALHOST_API"
    llmCodeKey :: RIO (Maybe String)
llmCodeKey = Maybe String -> RIO (Maybe String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing

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

class
  ( EFF.LlmConf m
  , EFF.LlmCodeConf m
  )
  => LlmCodePost m
  where
    llmCodeWeb
      :: String
      -> m (Either String String)

instance
  ( EFF.LlmConf RIO
  , EFF.LlmCodeConf RIO
  )
  => LlmCodePost RIO
  where
    llmCodeWeb :: String -> RIO (Either String String)
llmCodeWeb String
json =
      RIO (Maybe String)
forall (m :: * -> *). LlmCodeConf m => m (Maybe String)
EFF.llmCodeAPI RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mapi ->
      RIO (Maybe String)
forall (m :: * -> *). LlmCodeConf m => m (Maybe String)
EFF.llmCodeKey RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mkey ->
      String
-> Maybe String -> Maybe String -> RIO (Either String String)
llmCurl String
json Maybe String
mapi Maybe String
mkey

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

class
  EFF.LlmConf m
  => LlmPlanRoot m
  where
    llmPlanDir
      :: m String

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmPlanRoot RIO
  )
  => LlmPlanRoot RIO
  where
    llmPlanDir :: RIO String
llmPlanDir = String -> RIO String
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"."

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

class
  EFF.LlmConf m
  => LlmPlanMask m
  where
    llmPlanMsk
      :: m [String]

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmPlanMask RIO
  )
  => LlmPlanMask RIO
  where
    llmPlanMsk :: RIO [String]
llmPlanMsk =
      [String] -> RIO [String]
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
        [ String
"*.org"
        , String
"*.md"
        ]

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

class
  ( EFF.LlmConf     m
  , EFF.LlmPlanRoot m
  , EFF.LlmPlanMask m
  , EFF.LlmCodeRead m
  )
  => LlmPlanRead m
  where
    llmPlanSeq
      :: Maybe LLM.Filter
      -> m (Either [String] LLM.FilePaths)
    llmPlanGet
      :: String
      -> m (Either String LLM.File)

instance
  ( EFF.LlmConf     RIO
  , EFF.LlmPlanRoot RIO
  , EFF.LlmPlanMask RIO
  , EFF.LlmCodeRead RIO
  )
  => LlmPlanRead RIO
  where
    llmPlanSeq :: Maybe Filter -> RIO (Either [String] FilePaths)
llmPlanSeq Maybe Filter
mfilter =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root)
-> (Maybe Root -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      case Maybe Root
ocwd of
        Just (LLM.Root String
root) ->
          RIO String
forall (m :: * -> *). LlmPlanRoot m => m String
EFF.llmPlanDir          RIO String
-> (String -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
pdir ->
          RIO [String]
forall (m :: * -> *). LlmPlanMask m => m [String]
EFF.llmPlanMsk          RIO [String]
-> ([String] -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ [String]
pmsk ->
          String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pdir) RIO (Either String String)
-> (Either String String -> RIO (Either [String] FilePaths))
-> RIO (Either [String] FilePaths)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            -- TODO: DRY
            Right String
fap ->
              ( \ case
                  ([], [[String]]
rs) -> FilePaths -> Either [String] FilePaths
forall a b. b -> Either a b
Right (FilePaths -> Either [String] FilePaths)
-> FilePaths -> Either [String] FilePaths
forall a b. (a -> b) -> a -> b
$ [String] -> FilePaths
LLM.FilePaths ([String] -> FilePaths) -> [String] -> FilePaths
forall a b. (a -> b) -> a -> b
$ [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [[String]]
rs
                  ([String]
ls, [[String]]
__) -> [String] -> Either [String] FilePaths
forall a b. a -> Either a b
Left                            [String]
ls
              )
              (([String], [[String]]) -> Either [String] FilePaths)
-> ([Either String [String]] -> ([String], [[String]]))
-> [Either String [String]]
-> Either [String] FilePaths
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Either String [String]] -> ([String], [[String]])
forall a b. [Either a b] -> ([a], [b])
partitionEithers
              ([Either String [String]] -> Either [String] FilePaths)
-> RIO [Either String [String]] -> RIO (Either [String] FilePaths)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> RIO (Either String [String]))
-> [String] -> RIO [Either String [String]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\ String
msk -> String -> String -> RIO (Either String [String])
findFiles String
fap (String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fil String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"*" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
msk)) [String]
pmsk
            Left String
err ->
              Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [String] FilePaths -> RIO (Either [String] FilePaths))
-> Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a b. (a -> b) -> a -> b
$ [String] -> Either [String] FilePaths
forall a b. a -> Either a b
Left [String
err]
        Maybe Root
Nothing ->
          Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either [String] FilePaths -> RIO (Either [String] FilePaths))
-> Either [String] FilePaths -> RIO (Either [String] FilePaths)
forall a b. (a -> b) -> a -> b
$ [String] -> Either [String] FilePaths
forall a b. a -> Either a b
Left [String
noLlmConf]
      where
        fil :: String
fil =
          case Maybe Filter
mfilter of
            Just (LLM.Filter String
f) ->  String
f
            Maybe Filter
Nothing             -> [ ]

    llmPlanGet :: String -> RIO (Either String File)
llmPlanGet String
abspath =
      RIO (Maybe Root)
forall (m :: * -> *). LlmConf m => m (Maybe Root)
EFF.llmPathCWD RIO (Maybe Root)
-> (Maybe Root -> RIO (Either String File))
-> RIO (Either String File)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe Root
ocwd ->
      RIO String
forall (m :: * -> *). LlmPlanRoot m => m String
EFF.llmPlanDir RIO String
-> (String -> RIO (Either String File)) -> RIO (Either String File)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ String
pdir ->
      case Maybe Root
ocwd of
        -- TODO: DRY
        Just (LLM.Root String
root) ->
          String -> RIO (Either String String)
realPath (String
root String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
pdir) RIO (Either String String)
-> (Either String String -> RIO (Either String File))
-> RIO (Either String File)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
efap ->
          case Either String String
efap of
            Right String
fap ->
              if String
fap String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
abspath then
                -- NOTE: Root relative path
                File -> Either String File
forall a b. b -> Either a b
Right (File -> Either String File)
-> (String -> File) -> String -> Either String File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [String]) -> File
LLM.File ((String, [String]) -> File)
-> (String -> (String, [String])) -> String -> File
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (,) (Int -> ShowS
forall a. Int -> [a] -> [a]
drop Int
len String
abspath) ([String] -> (String, [String]))
-> (String -> [String]) -> String -> (String, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
                (String -> Either String File)
-> RIO String -> RIO (Either String File)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO String
readFileStrict String
abspath
              else
                Either String File -> RIO (Either String File)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String File -> RIO (Either String File))
-> Either String File -> RIO (Either String File)
forall a b. (a -> b) -> a -> b
$ String -> Either String File
forall a b. a -> Either a b
Left (String -> Either String File) -> String -> Either String File
forall a b. (a -> b) -> a -> b
$ String -> String -> Mode -> String
notPrefixRootAndMode String
fap String
abspath Mode
LLM.Plan
            Left  String
err ->
              Either String File -> RIO (Either String File)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String File -> RIO (Either String File))
-> Either String File -> RIO (Either String File)
forall a b. (a -> b) -> a -> b
$ String -> Either String File
forall a b. a -> Either a b
Left String
err
            where
              len :: Int
len = String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
root
        Maybe Root
Nothing ->
          Either String File -> RIO (Either String File)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String File -> RIO (Either String File))
-> Either String File -> RIO (Either String File)
forall a b. (a -> b) -> a -> b
$ String -> Either String File
forall a b. a -> Either a b
Left String
noLlmConf

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

class
  ( EFF.LlmConf m
  , EFF.LlmPlanConf m
  )
  => LlmPlanConf m
  where
    llmPlanAPI
      :: m (Maybe String)
    llmPlanKey
      :: m (Maybe String)

instance
  ( EFF.LlmConf RIO
  , EFF.LlmPlanConf RIO
  )
  => LlmPlanConf RIO
  where
    llmPlanAPI :: RIO (Maybe String)
llmPlanAPI = String -> RIO (Maybe String)
getEnvVar String
"LLM_PLAN_LOCALHOST_API"
    llmPlanKey :: RIO (Maybe String)
llmPlanKey = Maybe String -> RIO (Maybe String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe String
forall a. Maybe a
Nothing

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

class
  ( EFF.LlmConf m
  , EFF.LlmPlanConf m
  )
  => LlmPlanPost m
  where
    llmPlanWeb
      :: String
      -> m (Either String String)

instance
  ( EFF.LlmConf RIO
  , EFF.LlmPlanConf RIO
  )
  => LlmPlanPost RIO
  where
    llmPlanWeb :: String -> RIO (Either String String)
llmPlanWeb String
json =
      RIO (Maybe String)
forall (m :: * -> *). LlmPlanConf m => m (Maybe String)
EFF.llmPlanAPI RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mapi ->
      RIO (Maybe String)
forall (m :: * -> *). LlmPlanConf m => m (Maybe String)
EFF.llmPlanKey RIO (Maybe String)
-> (Maybe String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Maybe String
mkey ->
      String
-> Maybe String -> Maybe String -> RIO (Either String String)
llmCurl String
json Maybe String
mapi Maybe String
mkey

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

-- HELPERS (public)

findFiles
  :: FilePath
  -> String
  -> RIO (Either String [String])
findFiles :: String -> String -> RIO (Either String [String])
findFiles String
path String
mask =
  -- NOTE: Remove any '\NUL` from filepaths
  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110
  ( \case
      Right String
str ->
        [String] -> Either String [String]
forall a b. b -> Either a b
Right
        -- NOTE: We use absolute paths, but, only show relative
        ([String] -> Either String [String])
-> [String] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\NUL'))
        ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ String -> [String]
lines String
str
      Left  String
err ->
        String -> Either String [String]
forall a b. a -> Either a b
Left String
err
  )
  (Either String String -> Either String [String])
-> RIO (Either String String) -> RIO (Either String [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
path String
"find"
        -- NOTE: Use -ipath and -iname (case insensitive) instead?
        [ String
path
          -- NOTE: Limit to files, excluding symbolic links
        , String
"-type", String
"f"
          -- NOTE: Exclude tmp folder
        , String
"-not"
        , String
"-path"
        , String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/tmp/*"
        , String
"-and"
          -- NOTE: Exclude llm tpl folder
        , String
"-not"
        , String
"-ipath"
        , String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/llm/*"
        , String
"-and"
          -- NOTE: Exclude dot files and hereby tmp Emacs files (.*#)
        , String
"-not"
        , String
"-name"
        , String
".*"
        , String
"-and"
          -- NOTE: Look for filter mask
        , String
"-path"
        , String
mask
        , String
"-print"
        ]

getEnvVar
  :: String
  -> RIO (Maybe String)
getEnvVar :: String -> RIO (Maybe String)
getEnvVar =
  IO (Maybe String) -> RIO (Maybe String)
forall a. IO a -> RIO a
RestrictedIO (IO (Maybe String) -> RIO (Maybe String))
-> (String -> IO (Maybe String)) -> String -> RIO (Maybe String)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO (Maybe String)
ENV.getEnv

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

-- HELPERS (private)

noLlmConf :: String
noLlmConf :: String
noLlmConf =
  String
"No EFF.LlmConf instance is defined."

notPrefixRootAndMode
  :: FilePath
  -> FilePath
  -> LLM.Mode
  -> String
notPrefixRootAndMode :: String -> String -> Mode -> String
notPrefixRootAndMode String
rpath String
apath Mode
mode =
  String
rpath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" is not a prefix of " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
apath String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" for: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Mode -> String
forall a. Show a => a -> String
show Mode
mode

gitExist
  :: FilePath
  -> RIO Bool
gitExist :: String -> RIO Bool
gitExist String
path =
  ( \case
      Right String
_ -> Bool
True
      Left  String
_ -> Bool
False
  )
  (Either String String -> Bool)
-> RIO (Either String String) -> RIO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
path String
"git"
        [ String
"status"
        ]

gitignoreTmp
  :: FilePath
  -> RIO Bool
gitignoreTmp :: String -> RIO Bool
gitignoreTmp String
path =
  (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"/tmp/") ([String] -> Bool) -> (String -> [String]) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines
  (String -> Bool) -> RIO String -> RIO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> RIO String
readFileStrict String
gi
  where
    gi :: String
gi = String
path String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/.gitignore"

gitWorktreeAdd
  :: FilePath
  -> String
  -> FilePath
  -> RIO (Either String String)
gitWorktreeAdd :: String -> String -> String -> RIO (Either String String)
gitWorktreeAdd String
root String
ts String
path =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
root String
"git"
    [ String
"worktree"
    , String
"add", String
"-b", String
ts
    , String
path
    ]

gitAddFiles
  :: FilePath
  -> RIO (Either String String)
gitAddFiles :: String -> RIO (Either String String)
gitAddFiles String
path =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
path String
"git"
    [ String
"add"
    , String
"."
    ]

gitCommit
  :: FilePath
  -> String
  -> RIO (Either String String)
gitCommit :: String -> String -> RIO (Either String String)
gitCommit String
root String
mesg =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
root String
"git"
    [ String
"commit"
    , String
"-m"
    , String
mesg
    ]

gitWorktreeRem
  :: FilePath
  -> FilePath
  -> RIO (Either String String)
gitWorktreeRem :: String -> String -> RIO (Either String String)
gitWorktreeRem String
root String
path =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
root String
"git"
    [ String
"worktree"
    , String
"remove"
    , String
path
    ]

gitBranchesDesc
  :: FilePath
  -> RIO (Either String String)
gitBranchesDesc :: String -> RIO (Either String String)
gitBranchesDesc String
root =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
root String
"git"
    [ String
"config"
    , String
"--get-regexp"
    , String
"branch.*.description"
    ]

gitUpdateBranchDesc
  :: FilePath
  -> String
  -> String
  -> RIO (Either String String)
gitUpdateBranchDesc :: String -> String -> String -> RIO (Either String String)
gitUpdateBranchDesc String
path String
ts String
desc =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
path String
"git"
    [ String
"config"
    , String
"branch." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ts String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
".description"
    , String
desc
    ]

llmCurl
  :: String
  -> Maybe String
  -> Maybe String
  -> RIO (Either String String)
llmCurl :: String
-> Maybe String -> Maybe String -> RIO (Either String String)
llmCurl String
json Maybe String
mapi Maybe String
mkey =
  case (Maybe String
mapi, Maybe String
mkey) of
    (Maybe String
Nothing, Maybe String
_ ) ->
      IO (Either String String) -> RIO (Either String String)
forall a. IO a -> RIO a
RestrictedIO (IO (Either String String) -> RIO (Either String String))
-> IO (Either String String) -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ 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
"No API address was provided"
    (Just String
api, Maybe String
Nothing) ->
      String -> [String] -> String -> RIO (Either String String)
withExitCodeStdIn String
"curl"
        ( [ -- "--verbose"
            String
"--silent"
          , String
"--show-error"
          ]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
hs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          [ -- NOTE: https://curl.se/docs/manpage.html#--json
            String
"--json", String
"@-"
          , String
api String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/chat/completions"
          ]
        )
        String
json
    (Just String
api, Just String
key) ->
      String -> [String] -> String -> RIO (Either String String)
withExitCodeStdIn String
"curl"
        ( [ --"--verbose"
            String
"--silent"
          , String
"--show-error"
          , String
"--header", String
"Authorization: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
key
          ]
          [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
hs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++
          [ -- NOTE: https://curl.se/docs/manpage.html#--json
            String
"--json", String
"@-"
          , String
api String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"/chat/completions"
          ]
        )
        String
json
    where
      hs :: [String]
hs =
        [ String
"--header" , String
"Accept: application/json"
        , String
"--header" , String
"Accept-Encoding: gzip, deflate, br"
        , String
"--header" , String
"Content-Type: application/json; charset=utf-8"
        , String
"--header" , String
"User-Agent: Λ-gent/0.11"
        ]

readFileStrict
  :: FilePath
  -> RIO String
readFileStrict :: String -> RIO String
readFileStrict String
path =
  -- TODO:
  --
  -- Refactor `RIO String` to `RIO (Either String String)`
  IO String -> RIO String
forall a. IO a -> RIO a
RestrictedIO (IO String -> RIO String) -> IO String -> RIO String
forall a b. (a -> b) -> a -> b
$
  do
    Either SomeException String
eproc <-
      IO String -> IO (Either SomeException String)
forall e a. Exception e => IO a -> IO (Either e a)
try
        ( IO String
aux
        ) :: IO (Either SomeException String)
    case Either SomeException String
eproc of
        Right String
txt -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
txt
        Left  SomeException
___ -> String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
  where
    aux :: IO String
aux =
      String -> IO String
readFile String
path IO String -> (String -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \String
cs ->
      String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
cs Int -> IO String -> IO String
forall a b. a -> b -> b
`seq` String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
cs

writeFileStrict
  :: FilePath
  -> String
  -> RIO (Either String String)
writeFileStrict :: String -> String -> RIO (Either String String)
writeFileStrict String
path String
txt =
  IO (Either String String) -> RIO (Either String String)
forall a. IO a -> RIO a
RestrictedIO (IO (Either String String) -> RIO (Either String String))
-> IO (Either String String) -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$
  do
    Either SomeException ()
eproc <-
      IO () -> IO (Either SomeException ())
forall e a. Exception e => IO a -> IO (Either e a)
try
        ( String -> String -> IO ()
writeFile String
path String
txt
        ) :: IO (Either SomeException ())
    case Either SomeException ()
eproc of
        Right ()
_ ->
          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
path
        Left  SomeException
e -> 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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e

realPath
  :: FilePath
  -> RIO (Either String String)
realPath :: String -> RIO (Either String String)
realPath String
path =
  -- NOTE: `realpath` removes any trailing '/' for directories
  --
  -- NOTE: Remove any '\NUL` from filepaths
  -- https://gitlab.haskell.org/ghc/ghc/-/merge_requests/10110
  ( \case
      Right String
str -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
str
      Left  String
err -> String -> Either String String
forall a b. a -> Either a b
Left String
err
  )
  (Either String String -> Either String String)
-> RIO (Either String String) -> RIO (Either String String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> RIO (Either String String)
withExitCode String
"realpath"
        [ String
path
        ]

ensureFolderPath
  :: FilePath
  -> FilePath
  -> RIO (Either String String)
ensureFolderPath :: String -> String -> RIO (Either String String)
ensureFolderPath String
root String
path =
  String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
root String
"dirname" [ String
path ] RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
eadp ->
  case Either String String
eadp of
    Right String
adp ->
      String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
root String
"mkdir" [ String
"-p", String
foo ] RIO (Either String String)
-> (Either String String -> RIO (Either String String))
-> RIO (Either String String)
forall a b. RIO a -> (a -> RIO b) -> RIO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \ Either String String
emeh ->
      case Either String String
emeh of
        Right String
_ -> Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. b -> Either a b
Right String
foo
        Left  String
e -> Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left  String
e
      where
        foo :: String
foo = (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') String
adp
    Left  String
err -> Either String String -> RIO (Either String String)
forall a. a -> RIO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String String -> RIO (Either String String))
-> Either String String -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$ String -> Either String String
forall a b. a -> Either a b
Left String
err

timestampUTC :: RIO (Maybe String)
timestampUTC :: RIO (Maybe String)
timestampUTC =
  ( \case
      Right String
cs -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter ( \ Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c ) String
cs
      Left  String
__ -> Maybe String
forall a. Maybe a
Nothing
  )
  (Either String String -> Maybe String)
-> RIO (Either String String) -> RIO (Maybe String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> RIO (Either String String)
withExitCode String
"date"
        [ String
"-u"
        , String
"+'%Y%m%d-%H%M%S-%N'"
        ]

withExitCode
  ::  String
  -> [String]
  -> RIO (Either String String)
withExitCode :: String -> [String] -> RIO (Either String String)
withExitCode String
cmd [String]
args =
  IO (Either String String) -> RIO (Either String String)
forall a. IO a -> RIO a
RestrictedIO (IO (Either String String) -> RIO (Either String String))
-> IO (Either String String) -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$
  do
    Either SomeException (ExitCode, String, String)
eproc <-
      IO (ExitCode, String, String)
-> IO (Either SomeException (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try
        ( String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
cmd [String]
args []
        ) :: IO (Either SomeException ((ExitCode, String, String)))
    case Either SomeException (ExitCode, String, String)
eproc of
        Right (ExitCode
exitcode, String
out, String
err) ->
          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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
err
        Left SomeException
e -> 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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e

withExitCodeStdIn
  ::  String
  -> [String]
  ->  String
  -> RIO (Either String String)
withExitCodeStdIn :: String -> [String] -> String -> RIO (Either String String)
withExitCodeStdIn String
cmd [String]
args String
txt =
  IO (Either String String) -> RIO (Either String String)
forall a. IO a -> RIO a
RestrictedIO (IO (Either String String) -> RIO (Either String String))
-> IO (Either String String) -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$
  do
    Either SomeException (ExitCode, String, String)
eproc <-
      IO (ExitCode, String, String)
-> IO (Either SomeException (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try
        ( IO (ExitCode, String, String)
aux
        ) :: IO (Either SomeException ((ExitCode, String, String)))
    case Either SomeException (ExitCode, String, String)
eproc of
        Right (ExitCode
exitcode, String
out, String
err) ->
          case ExitCode
exitcode of
            ExitCode
ExitSuccess ->
              -- NOTE: When debugging, ex: `curl`, add the `--verbose` flag,
              -- which uses `stderr`. Just combine `err` and `out` like this:
              --
              -- pure $ Right ("[DEBUG]: " ++ err ++ "\n" ++ out)
              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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
err
        Left SomeException
e -> 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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
    where
      raw :: CreateProcess
raw = String -> [String] -> CreateProcess
proc String
cmd [String]
args
      rcp :: CreateProcess
rcp =
        CreateProcess
raw
          { std_in  = CreatePipe
          , std_out = CreatePipe
          , std_err = CreatePipe
          }
      aux :: IO (ExitCode, String, String)
aux =
        do
          (Just Handle
hinp, Just Handle
hout, Just Handle
herr, ProcessHandle
ph) <- CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
createProcess CreateProcess
rcp
          Handle -> String -> IO ()
hPutStrLn Handle
hinp String
txt
          Handle -> IO ()
hClose    Handle
hinp
          String
out <- Handle -> IO String
hGetContents Handle
hout
          String
err <- Handle -> IO String
hGetContents Handle
herr
          ExitCode
exitcode <- ProcessHandle -> IO ExitCode
waitForProcess ProcessHandle
ph
          (ExitCode, String, String) -> IO (ExitCode, String, String)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ExitCode
exitcode, String
out, String
err)

withExitCodeCwd
  :: String
  -> String
  -> [String]
  -> RIO (Either String String)
withExitCodeCwd :: String -> String -> [String] -> RIO (Either String String)
withExitCodeCwd String
path String
cmd [String]
args =
  IO (Either String String) -> RIO (Either String String)
forall a. IO a -> RIO a
RestrictedIO (IO (Either String String) -> RIO (Either String String))
-> IO (Either String String) -> RIO (Either String String)
forall a b. (a -> b) -> a -> b
$
  do
    Either SomeException (ExitCode, String, String)
eproc <-
      IO (ExitCode, String, String)
-> IO (Either SomeException (ExitCode, String, String))
forall e a. Exception e => IO a -> IO (Either e a)
try
        ( CreateProcess -> String -> IO (ExitCode, String, String)
readCreateProcessWithExitCode CreateProcess
rcp []
        ) :: IO (Either SomeException ((ExitCode, String, String)))
    case Either SomeException (ExitCode, String, String)
eproc of
        Right (ExitCode
exitcode, String
out, String
err) ->
          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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
err
        Left SomeException
e -> 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 -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ SomeException -> String
forall a. Show a => a -> String
show SomeException
e
    where
      raw :: CreateProcess
raw = String -> [String] -> CreateProcess
proc String
cmd [String]
args
      rcp :: CreateProcess
rcp = CreateProcess
raw { cwd = Just path }