A-gent-0.11.0.19: src/Agent/LLM.hs
{-# OPTIONS_GHC -Wall -Werror #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE RankNTypes #-}
--------------------------------------------------------------------------------
-- |
-- Copyright : (c) 2026 SPISE MISU ApS
-- License : SSPL-1.0 OR AGPL-3.0-only
-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>
-- Stability : experimental
--
-- Polite and well educated LLM agent with excellent manners that always behaves
-- well.
--------------------------------------------------------------------------------
module Agent.LLM
( -- * Modes
Mode(..)
-- * Context
, Context(..)
, AbsoluteFilePath
, Chat
, Chit
, File
, FileLine
, FilePaths
, Files
, Filter
, History
, Load
, Mask
, Root
, Template
, UUID
-- * Paramenters
, Eval
-- * Methods
, repl
, replWithMode
)
where
--------------------------------------------------------------------------------
import Prelude hiding ( head, print, read )
import Data.Char ( toLower, toUpper )
import Data.Maybe ( fromMaybe )
import GHC.IO.Encoding ( setLocaleEncoding )
import System.Environment ( getProgName )
import qualified System.Environment.Blank as ENV
import System.Exit
( ExitCode (ExitFailure, ExitSuccess)
)
import System.IO
( BufferMode (LineBuffering, NoBuffering)
, hFlush
, hSetBuffering
, hSetEcho
, stderr
, stdin
, stdout
, utf8
)
import System.Process ( readProcessWithExitCode )
import Text.Read ( readMaybe )
import Internal.LLM
( AbsoluteFilePath
, Chat
, Chit (..)
, File
, FileLine
, FilePaths
, Files
, Filter
, History (..)
, Jobs
, Mask
, Mode (..)
, Root
, Template
, UUID
, modes
)
import qualified Internal.LLM as INT
import Internal.LLM.Action ( Action (..) )
import Internal.RIO
( RIO (..)
, fork
, input
, output
, terr
, timestampUTC
, tkil
, tnum
, tval
, tvar
, wait
)
import qualified Internal.Utils as UTL
import qualified Agent.Data.ANSI.EscapeCode as AEC
import qualified Agent.LLM.Message as MSG
import Agent.Data.JSON ( Data )
import Agent.LLM.Message ( Message )
--------------------------------------------------------------------------------
type Load a =
( Data a
, Show a
)
=> Maybe a
data Context a =
Context
{ mode :: !Mode
, load :: !(Load a)
, hist :: !History
, list :: !(Maybe Filter)
, pile :: !(Maybe FilePaths)
, ruck :: !(Maybe Files)
, jobs :: !(Maybe (Jobs (Context a)))
}
type Eval a =
Context a
-> Message
-> RIO (Context a, Action)
--------------------------------------------------------------------------------
repl
:: Eval a
-> IO ()
repl =
replWithMode INT.Chat
replWithMode
:: INT.Mode
-> Eval a
-> IO ()
replWithMode mode' proc =
do
constraint <- integrity
case constraint of
Right __ ->
do
setLocaleEncoding utf8
hSetBuffering stderr NoBuffering
hSetBuffering stdin NoBuffering
-- NOTE: logic based on `hFlush stdout`
hSetBuffering stdout LineBuffering
-- NOTE: No default output when typing
hSetEcho stdin False
putStrLn head >> hFlush stdout
run $ loop ctx proc >> pure ()
Left err ->
putStrLn err >> hFlush stdout
where
ctx =
Context
{ mode = mode'
, load = Nothing
, hist =
History
{ chit =
Chit
{ prev = []
, next = []
}
, chat = []
}
, list = Nothing
, pile = Just $ INT.FilePaths []
, ruck = Just $ INT.Files []
, jobs = Just $ INT.Jobs []
}
--------------------------------------------------------------------------------
-- HELPERS (private)
{- NOTE: Doesn't seem to work
-- ctrlC :: IO () -> IO ()
ctrlC task =
-- NOTE: Catch CTRL+C
-- https://neilmitchell.blogspot.com/2015/05/handling-control-c-in-haskell.html
join . (:[]) <$> fork task
-}
head :: String
head =
"# Exit Λ-gent with /e or /exit. For more commands, type /? or /help."
help :: String
help =
unlines
[ "# Supported commands:"
, ds
, "/? or /help | This message"
, "/e or /exit | Exit Λ-gent"
, "/w or /wipe | Wipe screen"
, "/d or /drop | Drop end-user data load"
, ds
, "/m m or /mode m | Change to {" ++ ms ++ "}. Ex: /mode plan"
, ds
, "/h or /hist | View history (input & output)"
, " /chit | View history (only input) "
, " /chat | View history (only output)"
, ds
, "/l f or /list f | List of files, limited by mode, file masks & filter"
, "/p or /pile | Show stored list of files in pile. See /list above"
, "/f i or /file i | Show file with the provided index. See /pile above"
, "/n i or /nums i | Show file (idx) with line numbers. See /file above"
, ds
, "/s m or /send m | Sending /pile to LLM as context to the message"
, "/r o or /ruck o | View files (opt index) from LLM response. See /send above"
, "/a d or /atom d | Atomically save /ruck files to a GIT branch (+ description)"
, " /repo | List GIT branches, including description. See /atom above"
, ds
, "/t m or /task m | Fork /send m jobs for files. See /pile above"
, "/j or /jobs | Show info for executed jobs. See /task above"
, " /sync | Join contexts, if no errors. See /jobs above"
, " /stop | Kill or abort, current jobs. See /jobs above"
, ds
, " /exec | Execute the automated mode. See /mode auto"
, " /halt | Bring automation to a halt. See /mode auto"
, ds
]
where
ds = replicate 80 '-'
ms =
foldl1 (\ x y -> x ++ "|" ++ y) $ map (map toLower . show) modes
--------------------------------------------------------------------------------
loop
:: Context a
-> Eval a
-> RIO (Context a)
loop ctx eval =
print prompt >>
read hps hns >>= \ txt ->
printLn [ ] >>
timestampUTC >>= \ outs ->
loopHelper (prv txt ctx) eval (action ctx txt) outs
where
-- TODO: Refactoring needed
his = hist ctx
chi = chit his
hps = prev chi
hns = next chi
-- TODO: Refactoring needed
prv p c =
c
{ hist =
h
{ chit =
(chit $ hist c)
{ prev = p : hps
}
}
}
where
h = hist c
-- TODO: Refactoring needed
prompt =
(show . AEC.bold . AEC.sgr)
("Λ-" ++ (map toLower . show . mode) ctx ++ "> ")
read = input
loopHelper
:: Context a
-> Eval a
-> Action
-> Maybe String
-> RIO (Context a)
loopHelper ctx eval act_ outs =
case act_ of
-- TODO: Refactoring needed
-- Nested -- Start
None ->
loop ctx eval
File _ ->
loop ctx eval
Template _ _ _ _ ->
loop ctx eval
-- Nested -- Stop
Exit -> caseExit
Help -> caseHelp
Drop -> caseDrop
Hist (chits, chats) -> caseHist chits chats
Mode c cs -> caseMode c cs
Paths (INT.FilePaths fps) -> casePaths fps
Pile -> casePile
Ruck mdix -> caseRuck mdix
Wipe -> caseWipe
UnknownCmd cmd -> caseUnknownCmd cmd
Branch msg fs ->
eval ctx (MSG.Atom msg fs) >>= \ (upd, act) ->
case act of
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
Prompt msg ->
eval ctx (MSG.Tmpl afps) >>= \ (upd0, act0) ->
case act0 of
Template p is es fs ->
eval upd0 (MSG.Send xml) >>= \ (upd1, act1) ->
case act1 of
Message (MSG.Text cs) ->
printLn cs >>
loop
( nxt
( upd1 { ruck = Just $ pfs }
)
( Just cs
)
) eval
where
pfs =
case (map INT.File . p) cs of
[] -> INT.Files []
xs -> INT.Files xs
None ->
loop (nxt upd1 Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd1 (Just [])) eval
where
ils = map ( \ (INT.File (_, ls)) -> unlines ls) is
els = map ( \ (INT.File (_, ls)) -> unlines ls) es
tpl = INT.Template msg ils els fs
xml = INT.tpl2xmls tpl
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd0 (Just cs)) eval
None ->
loop (nxt upd0 Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd0 (Just [])) eval
where
afps =
( \ (INT.FilePaths fps) -> map INT.AbsoluteFilePath fps
)
<$> pile ctx
Batch msg ->
case (null ejs, outs) of
( True, Just uts) ->
( eval ctx (MSG.Tmpl aps) >>= \ (upd0, act0) ->
case act0 of
Template p is es fs ->
let
ils = map ( \ (INT.File (_, ls)) -> unlines ls) is
els = map ( \ (INT.File (_, ls)) -> unlines ls) es
in
mapM
( \ f ->
let
tpl = INT.Template msg ils els [f]
xml = INT.tpl2xmls tpl
in
fork
( eval upd0 ( MSG.Send xml ) >>= \ (upd1, act1) ->
case act1 of
Message (MSG.Text cs) ->
pure
( nxt
( upd1
{ ruck = Just $ pfs
}
)
( Just cs
)
)
where
pfs =
case (map INT.File . p) cs of
[] -> INT.Files []
xs -> INT.Files xs
_____________________ ->
pure upd1
)
)
fs
___________________ ->
pure []
) >>= \ js ->
printLn ("Batched tasks unique identifier: " ++ uts) >>
loop ctx { jobs = Just (njs (INT.UUID uts) js) } eval
( False, _) ->
printLn "Current batch is unsynchronized. See /help for info" >>
loop ctx eval
( _, Nothing) ->
printLn "Missing unique identifier UTC-timestamp." >>
loop ctx eval
where
aps =
( \ (INT.FilePaths fps) -> map INT.AbsoluteFilePath fps
)
<$> pile ctx
ojs = jobs ctx
ejs =
case ojs of
Nothing -> []
Just (INT.Jobs js) -> js
njs uuid js =
INT.Jobs $ zip (repeat uuid) js
Status ->
mapM
( \ (INT.UUID uid, j) ->
tnum j >>= \ num ->
tvar j >>= \ var ->
if not var then
pure (uid, num, "RUNNING")
else
tval j >>= \ val ->
case val of
Nothing ->
terr j >>= \ err ->
pure (uid, num, "FAILURE" ++ " | " ++ (fromMaybe [] err))
Just __ ->
pure (uid, num, "STOPPED")
) njs >>= \ logs ->
mapM_
( \ (uid, tid, status) ->
printLn $ uid ++ " | " ++ tid ++ " | " ++ status
) logs >>
loop ctx eval
where
njs =
case jobs ctx of
Nothing -> []
Just (INT.Jobs js) -> js
Sync ->
mapM
( \ (_, j) ->
tvar j >>= \ var ->
if not var then
pure var
else
tval j >>= \ val ->
case val of
Nothing -> pure $ var && False
Just __ -> pure $ var && True
) njs >>= \ succeeded ->
if all id succeeded then
mapM (wait . snd) njs >>= \ ctxs ->
let
(skipped, merged) =
foldl
( \ (bs, a) x ->
let
ars =
case ruck a of
Just (INT.Files rs) -> rs
Nothing -> []
xrs =
case ruck x of
Just (INT.Files rs) -> rs
Nothing -> []
in
( bs ++ [null xrs]
, a { ruck = Just $ INT.Files $ ars ++ xrs}
)
)
( []
, ctx { jobs = Just $ INT.Jobs [] }
)
ctxs
in
mapM
( \ ((INT.UUID uid, j), skip) ->
tnum j >>= \ num ->
if skip then
pure (uid, num, "SKIPPED")
else
pure (uid, num, "BLENDED")
) (zip njs skipped) >>= \ logs ->
mapM_
( \ (uid, tid, status) ->
printLn $ uid ++ " | " ++ tid ++ " | " ++ status
) logs >>
loop merged eval
else
loopHelper ctx eval Status outs
where
njs =
case jobs ctx of
Nothing -> []
Just (INT.Jobs js) -> js
Stop ->
mapM
( \ (INT.UUID uid, j) ->
tvar j >>= \ var ->
if not var then
tkil j >>= \ num ->
pure (uid, num, "STOPPED")
else
tnum j >>= \ num ->
pure (uid, num, "SKIPPED")
) njs >>= \ logs ->
mapM_
( \ (uid, tid, status) ->
printLn $ uid ++ " | " ++ tid ++ " | " ++ status
) logs >>
loop ctx { jobs = Just $ INT.Jobs [] } eval
where
njs =
case jobs ctx of
Nothing -> []
Just (INT.Jobs js) -> js
Message (MSG.Path ns afp) ->
eval ctx (MSG.Path ns afp) >>= \ (upd, act) ->
case act of
File (INT.File (_,ls)) ->
caseFile ns ls
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
Message (MSG.List fil) ->
eval ctx (MSG.List fil) >>= \ (upd, act) ->
case act of
Paths (INT.FilePaths fps) ->
casePaths fps
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
Message MSG.Repo ->
eval ctx MSG.Repo >>= \ (upd, act) ->
case act of
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
Message msg ->
eval ctx msg >>= \ (upd, act) ->
case act of
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
where
-- TODO: Refactoring needed
nxt c o =
c
{ hist =
h
{ chat =
case o of
Nothing -> chat $ hist c
Just r -> (r:) $ chat $ hist c
}
}
where
h = hist c
caseExit =
printLn "Λ-gent will shutdown" >>
return ctx
caseDrop =
printLn ("Dropping end-user data load") >>
loop
( ctx
{ load = Nothing
}
) eval
-- TODO: Refactoring needed
caseMode c cs =
case mmod of
Just mode' ->
printLn ("Changed to " ++ low ++ "-mode") >>
loop
( ctx
{ mode = mode'
, pile = Just $ INT.FilePaths []
, ruck = Just $ INT.Files []
}
) eval
where
low = map toLower $ show mode'
Nothing ->
printLn ("Invalid mode: " ++ c:cs) >>
loop ctx eval
where
mmod = readMaybe (toUpper c : map toLower cs) :: Maybe INT.Mode
caseHist chits chats =
( if chits then
printLn "* Chits:" >>
( mapM_ printLn . UTL.combine . UTL.chits True . prev . chit . hist
) ctx
else
pure ()
) >>
( if chats then
printLn "* Chats:" >>
( mapM_ printLn . UTL.combine . UTL.chats True . chat . hist
) ctx
else
pure ()
) >>
loop ctx eval
caseFile ns ls =
( mapM_ printLn .
UTL.combine .
UTL.file ns
) (unlines ls) >>
loop ctx eval
caseHelp =
printLn help >>
loop ctx eval
casePaths fps =
eval ctx MSG.Root >>= \ (upd, act) ->
case act of
Paths (INT.FilePaths rfps) ->
( case rfps of
[cwd] ->
mapM_ printLn .
UTL.combine .
UTL.files [] True .
-- NOTE: Show relative paths
map (drop (length cwd)) $
fps
_____ ->
printLn "Missing root path"
) >>
loop
( (nxt upd Nothing)
{ pile = Just $ INT.FilePaths fps
}
) eval
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
casePile =
eval ctx MSG.Root >>= \ (upd, act) ->
case act of
Paths (INT.FilePaths fps) ->
( case fps of
[cwd] ->
mapM_ printLn .
UTL.combine .
UTL.files [] True .
-- NOTE: Show relative paths
map (drop (length cwd)) .
concatMap INT.filePaths .
pile $
upd
_____ ->
printLn "Missing root path"
) >>
loop (nxt upd Nothing) eval
Message (MSG.Text cs) ->
printLn cs >>
loop (nxt upd (Just cs)) eval
None ->
loop (nxt upd Nothing) eval
_________________________ ->
-- NOTE: Unexpected error
printLn "Unexpected error" >>
loop (nxt upd (Just [])) eval
caseRuck midx =
( if null midx then
-- NOTE: If no optional index provided, show only paths
( mapM_ printLn .
UTL.combine .
UTL.files [] True .
concatMap fps .
ruck
) ctx
else
-- NOTE: Otherwise, show content or index error
( case idx of
Just i ->
if 0 <= i && i < len then
( mapM_ printLn .
UTL.combine .
UTL.file True .
concatMap f .
ruck
) ctx
else
let
m = "Index (" ++ show i ++ ") is out of bounds."
in
printLn m
where
f (INT.Files fs) =
case fs !! i of
INT.File (_,ls) -> unlines ls
Nothing ->
printLn "Invalid use of /ruck. Use space between cmd and index"
)
) >>
loop ctx eval
where
idx =
case midx of
[ ] -> Nothing
' ':cs -> readMaybe cs :: Maybe Int
______ -> Nothing
len =
case ruck ctx of
Just (INT.Files fs) -> length fs
Nothing -> 0
fps (INT.Files fs) =
map ( \ (INT.File (p,_)) -> p) fs
caseWipe =
printLn clear >>
loop ctx eval
caseUnknownCmd cmd =
printLn msg >>
loop ctx eval
where
msg = "Command not recognized: " ++ cmd
-- NOTE: Clear screen & Move top-left
clear = "\^[[H\^[[2J" -- NOTE: See `infocmp -x`
print
:: String
-> RIO ()
print =
output . show . AEC.faint . AEC.sgr
printLn
:: String
-> RIO ()
printLn x =
print $ x ++ "\n"
{-
printLn
:: Bool
-> String
-> RIO ()
printLn n x =
if not n then
print $ x ++ "\n"
else
pure ()
-}
action
:: Context a
-> String
-> Action
action ctx txt =
-- TODO: Refactoring needed
case txt of
'/':'m':'o':'d':'e':' ':c:cs -> Mode c cs
'/':'m' :' ':c:cs -> Mode c cs
'/':'l':'i':'s':'t' :mfil ->
-- TODO: DRY
Message (MSG.List fil)
where
fil =
case mfil of
[ ] -> Just $ INT.Filter mfil
' ':cs -> Just $ INT.Filter cs
______ -> Nothing
'/':'l' :mfil ->
-- TODO: DRY
Message (MSG.List fil)
where
fil =
case mfil of
[ ] -> Just $ INT.Filter mfil
' ':cs -> Just $ INT.Filter cs
______ -> Nothing
'/':'f':'i':'l':'e':' ':midx ->
-- TODO: DRY
case oidx of
Nothing ->
Message (MSG.Path False Nothing)
Just idx ->
if 0 <= idx && idx < length pfs then
Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))
else
Message (MSG.Path False Nothing)
where
pfs = concatMap INT.filePaths $ pile ctx
where
oidx =
case midx of
[] -> Nothing
cs -> readMaybe cs :: Maybe Int
'/':'f' :' ':midx ->
-- TODO: DRY
case oidx of
Nothing ->
Message (MSG.Path False Nothing)
Just idx ->
if 0 <= idx && idx < length pfs then
Message (MSG.Path False (Just $ INT.AbsoluteFilePath $ pfs !! idx))
else
Message (MSG.Path False Nothing)
where
pfs = concatMap INT.filePaths $ pile ctx
where
oidx =
case midx of
[] -> Nothing
cs -> readMaybe cs :: Maybe Int
'/':'n':'u':'m':'s':' ':midx ->
-- TODO: DRY
case oidx of
Nothing ->
Message (MSG.Path True Nothing)
Just idx ->
if 0 <= idx && idx < length pfs then
Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))
else
Message (MSG.Path True Nothing)
where
pfs = concatMap INT.filePaths $ pile ctx
where
oidx =
case midx of
[] -> Nothing
cs -> readMaybe cs :: Maybe Int
'/':'n' :' ':midx ->
-- TODO: DRY
case oidx of
Nothing ->
Message (MSG.Path True Nothing)
Just idx ->
if 0 <= idx && idx < length pfs then
Message (MSG.Path True (Just $ INT.AbsoluteFilePath $ pfs !! idx))
else
Message (MSG.Path True Nothing)
where
pfs = concatMap INT.filePaths $ pile ctx
where
oidx =
case midx of
[] -> Nothing
cs -> readMaybe cs :: Maybe Int
'/':'s':'e':'n':'d':' ':mesg -> Prompt mesg
'/':'s' :' ':mesg -> Prompt mesg
'/':'t':'a':'s':'k':' ':mesg -> Batch mesg
'/':'t' :' ':mesg -> Batch mesg
'/':'j':'o':'b':'s':[ ] -> Status
'/':'j' :[ ] -> Status
'/':'s':'y':'n':'c':[ ] -> Sync
'/':'s':'t':'o':'p':[ ] -> Stop
'/':'a':'t':'o':'m':' ':mesg ->
-- TODO: DRY
Branch mesg fs
where
fs = fromMaybe (INT.Files []) (ruck ctx)
'/':'a' :' ':mesg ->
-- TODO: DRY
Branch mesg fs
where
fs = fromMaybe (INT.Files []) (ruck ctx)
'/':'r':'e':'p':'o' :[ ] -> Message MSG.Repo
'/':'r':'u':'c':'k' :midx -> Ruck midx
'/':'r' :midx -> Ruck midx
"/exit" -> Exit
"/e" -> Exit
"/help" -> Help
"/?" -> Help
"/drop" -> Drop
"/d" -> Drop
"/hist" -> Hist ( True, True )
"/h" -> Hist ( True, True )
"/chit" -> Hist ( True, False )
"/chat" -> Hist ( False, True )
"/pile" -> Pile
"/p" -> Pile
"/wipe" -> Wipe
"/w" -> Wipe
'/':cmd -> UnknownCmd cmd
____________________________ -> Message (MSG.Text txt)
--------------------------------------------------------------------------------
integrity :: IO (Either String ())
integrity =
do
ohi <- ENV.getEnv "LLM_SIGN_SHA"
case ohi of
Nothing -> pure $ Right ()
Just hi ->
do
op <- cwd
pn <- getProgName
case op of
Left e -> pure $ Left e
Right p ->
do
ehf <- sha ap
case ehf of
Left ef -> pure $ Left ef
Right hf ->
if hi == h64 then
pure $ Right ()
else
pure $
Left $
"# Λ-gent integrity failed:\n" ++
"> " ++ hi ++ " (expected)\n" ++
"> " ++ h64 ++ " (observed)"
where
h64 = take 64 hf
where
ap =
concatMap id
$ lines p ++ [ "/" ] ++ lines pn
where
-- TODO: Move "HELPERS (private)" private out from Internal/RIO.hs to
-- Internal/IO.hs and then just wrap them with `RestrictedIO`. This will
-- allow for logic like this to be simplified
cwd =
do
-- NOTE: inconsistency between `linux` and `macOS`:
--
-- - If no option is specified, -P is assumed (linux)
--
-- - If no options are specified, the -L option is assumed (macOS)
--
-- -L, --logical use PWD from environment, even if it contains symlinks
--
-- -P, --physical resolve all symlinks
(exitcode, out, err) <- readProcessWithExitCode "pwd" [ "-P" ] []
case exitcode of
ExitSuccess ->
pure $ Right out
ExitFailure _ ->
pure $ Left err
sha p =
do
(exitcode, out, err) <- readProcessWithExitCode "sha256sum" [ p ] []
case exitcode of
ExitSuccess ->
pure $ Right out
ExitFailure _ ->
pure $ Left err