A-gent-0.11.0.19: src/Internal/LLM.hs
{-# OPTIONS_GHC -Wall -Werror #-}
{-# LANGUAGE NoGeneralizedNewtypeDeriving #-}
{-# LANGUAGE Safe #-}
--------------------------------------------------------------------------------
-- |
-- Copyright : (c) 2026 SPISE MISU ApS
-- License : SSPL-1.0 OR AGPL-3.0-only
-- Maintainer : SPISE MISU <mail+hackage@spisemisu.com>
-- Stability : experimental
--------------------------------------------------------------------------------
module Internal.LLM
( UUID (..)
, Root (..)
, Filter (..)
, Mode (..)
, Chit (..)
, Chat
, History (..)
, Mask (..)
, File (..)
, Files (..)
, FileLine
, FilePaths (..)
, Jobs (..)
, AbsoluteFilePath (..)
, Template (..)
, modes
, tpl2xmls
)
where
--------------------------------------------------------------------------------
import Agent.Control.Concurrent ( Task )
--------------------------------------------------------------------------------
newtype UUID = UUID String
newtype Root = Root FilePath deriving Eq
newtype Filter = Filter String
data Mode
= Auto
| Chat
| Code
| Docs
| Echo
| Plan
| Test
deriving (Bounded, Enum, Eq, Read, Show)
data Chit =
Chit
{ prev :: ![String]
, next :: ![String]
}
type Chat = [String]
data History =
History
{ chit :: !Chit
, chat :: !Chat
}
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
newtype Mask = Mask [String]
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
type Markdown = String
type FileLine = String
newtype File = File (FilePath, [FileLine])
--------------------------------------------------------------------------------
newtype Files = Files [File]
instance Semigroup Files where
Files xs <> Files ys =
Files (xs ++ ys)
instance Monoid Files where
mempty = Files []
--------------------------------------------------------------------------------
newtype AbsoluteFilePath = AbsoluteFilePath FilePath
--------------------------------------------------------------------------------
-- NOTE: Then use `mconcat` to combine
data FilePaths = FilePaths { filePaths :: [FilePath] }
instance Semigroup FilePaths where
FilePaths xs <> FilePaths ys =
FilePaths (xs ++ ys)
instance Monoid FilePaths where
mempty = FilePaths []
--------------------------------------------------------------------------------
newtype Jobs a = Jobs [(UUID, Task a)]
--------------------------------------------------------------------------------
data Template =
Template
{ purpose :: !String
, instructions :: ![String]
, examples :: ![Markdown]
, files :: ![File]
}
--------------------------------------------------------------------------------
--------------------------------------------------------------------------------
modes :: [Mode]
modes =
[ minBound .. maxBound ]
tpl2xmls
:: Template
-> [String]
tpl2xmls tpl =
[ ( if eis && ees && efs then
pur
else
"<purpose>" ++ pur ++ "</purpose>"
) ++
( if eis then
[]
else
"<instructions>" ++
tis ++
"</instructions>"
) ++
( if ees then
[]
else
"<examples>" ++
tes ++
"</examples>"
) ++
( if efs then
[]
else
"<files>" ++
concatMap aux tfs ++
"</files>"
)
]
where
pur =
purpose tpl ++
( if eis then
[]
else
". Follow the specified `instructions`"
) ++
( if ees then
[]
else
". Output MUST match scaffolding from provided `examples`"
) ++
( if efs then
[]
else
". Apply to each of the `files`"
)
eis = null tis
ees = null tes
efs = null tfs
tis =
concatMap (\ x -> "<instruction>" ++ x ++ "</instruction>")
$ instructions tpl
tes =
concatMap (\ x -> "<example>" ++ x ++ "</example>")
$ examples tpl
tfs = zip [0 :: Int ..] $ files tpl
aux (i, File (src, ls)) =
"<file index=\"" ++ show i ++ "\">" ++
"<source>" ++ src ++ "</source>" ++
"<content>" ++ unlines ls ++ "</content>" ++
"</file>"