never executed always true always false

    1 module PureClaw.Agent.Identity
    2   ( -- * Identity types
    3     AgentIdentity (..)
    4   , defaultIdentity
    5     -- * Loading
    6   , loadIdentity
    7   , loadIdentityFromText
    8     -- * System prompt generation
    9   , identitySystemPrompt
   10   ) where
   11 
   12 import Data.Maybe
   13 import Data.Text (Text)
   14 import Data.Text qualified as T
   15 import Data.Text.IO qualified as TIO
   16 import System.Directory
   17 
   18 -- | Agent identity loaded from a SOUL.md file or configured defaults.
   19 -- Controls the agent's system prompt, personality, and behavioral constraints.
   20 data AgentIdentity = AgentIdentity
   21   { _ai_name         :: Text
   22   , _ai_description  :: Text
   23   , _ai_instructions :: Text
   24   , _ai_constraints  :: [Text]
   25   }
   26   deriving stock (Show, Eq)
   27 
   28 -- | A minimal default identity for when no SOUL.md is provided.
   29 defaultIdentity :: AgentIdentity
   30 defaultIdentity = AgentIdentity
   31   { _ai_name         = "PureClaw"
   32   , _ai_description  = "A helpful AI assistant."
   33   , _ai_instructions = ""
   34   , _ai_constraints  = []
   35   }
   36 
   37 -- | Load an identity from a SOUL.md file at the given path.
   38 -- Returns 'defaultIdentity' if the file does not exist.
   39 loadIdentity :: FilePath -> IO AgentIdentity
   40 loadIdentity path = do
   41   exists <- doesFileExist path
   42   if exists
   43     then do
   44       content <- TIO.readFile path
   45       pure (loadIdentityFromText content)
   46     else pure defaultIdentity
   47 
   48 -- | Parse identity from SOUL.md markdown content. Extracts sections
   49 -- by heading:
   50 --
   51 -- @
   52 -- # Name
   53 -- Agent name here
   54 --
   55 -- # Description
   56 -- What this agent does.
   57 --
   58 -- # Instructions
   59 -- How the agent should behave.
   60 --
   61 -- # Constraints
   62 -- - Do not do X
   63 -- - Always do Y
   64 -- @
   65 loadIdentityFromText :: Text -> AgentIdentity
   66 loadIdentityFromText content =
   67   let sections = parseSections content
   68       get key = fromMaybe "" (lookup key sections)
   69       constraints = maybe [] parseConstraints (lookup "constraints" sections)
   70   in AgentIdentity
   71     { _ai_name         = T.strip (get "name")
   72     , _ai_description  = T.strip (get "description")
   73     , _ai_instructions = T.strip (get "instructions")
   74     , _ai_constraints  = constraints
   75     }
   76 
   77 -- | Generate a system prompt from an identity.
   78 identitySystemPrompt :: AgentIdentity -> Text
   79 identitySystemPrompt ident =
   80   let parts = filter (not . T.null)
   81         [ if T.null (_ai_name ident)
   82             then ""
   83             else "You are " <> _ai_name ident <> "."
   84         , _ai_description ident
   85         , _ai_instructions ident
   86         , if null (_ai_constraints ident)
   87             then ""
   88             else "Constraints:\n" <> T.unlines (map ("- " <>) (_ai_constraints ident))
   89         ]
   90   in T.intercalate "\n\n" parts
   91 
   92 -- | Parse markdown into sections keyed by lowercase heading text.
   93 -- Lines before the first heading are ignored.
   94 parseSections :: Text -> [(Text, Text)]
   95 parseSections content =
   96   let ls = T.lines content
   97   in go Nothing [] ls []
   98   where
   99     go :: Maybe Text -> [Text] -> [Text] -> [(Text, Text)] -> [(Text, Text)]
  100     go currentKey accLines [] result =
  101       case currentKey of
  102         Nothing -> result
  103         Just k  -> result ++ [(k, T.unlines (reverse accLines))]
  104     go currentKey accLines (l:rest) result
  105       | Just heading <- parseHeading l =
  106           let result' = case currentKey of
  107                 Nothing -> result
  108                 Just k  -> result ++ [(k, T.unlines (reverse accLines))]
  109           in go (Just (T.toLower heading)) [] rest result'
  110       | otherwise = go currentKey (l : accLines) rest result
  111 
  112     parseHeading :: Text -> Maybe Text
  113     parseHeading line =
  114       let stripped = T.stripStart line
  115       in if T.isPrefixOf "# " stripped
  116          then Just (T.strip (T.drop 2 stripped))
  117          else Nothing
  118 
  119 -- | Parse constraint lines from a markdown list.
  120 -- Each line starting with @-@ is a constraint.
  121 parseConstraints :: Text -> [Text]
  122 parseConstraints content =
  123   [ T.strip (T.drop 1 line)
  124   | line <- T.lines content
  125   , let trimmed = T.stripStart line
  126   , T.isPrefixOf "- " trimmed
  127   ]