packages feed

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>"