never executed always true always false

    1 module PureClaw.Memory.Markdown
    2   ( -- * Construction
    3     mkMarkdownMemoryHandle
    4   ) where
    5 
    6 import Data.IORef
    7 import Data.List
    8 import Data.Map.Strict (Map)
    9 import Data.Map.Strict qualified as Map
   10 import Data.Text (Text)
   11 import Data.Text qualified as T
   12 import Data.Text.IO qualified as TIO
   13 import Data.Time
   14 import System.Directory
   15 import System.FilePath
   16 
   17 import PureClaw.Core.Types
   18 import PureClaw.Handles.Memory
   19 
   20 -- | Create a file-based markdown memory handle. Each memory entry is
   21 -- stored as a markdown file in the given directory. Search is a simple
   22 -- case-insensitive substring match (no embeddings).
   23 mkMarkdownMemoryHandle :: FilePath -> IO MemoryHandle
   24 mkMarkdownMemoryHandle dir = do
   25   createDirectoryIfMissing True dir
   26   counterRef <- newIORef (0 :: Int)
   27   pure MemoryHandle
   28     { _mh_search = searchMemories dir
   29     , _mh_save   = saveMemory dir counterRef
   30     , _mh_recall = recallMemory dir
   31     }
   32 
   33 -- | Save a memory entry as a markdown file.
   34 saveMemory :: FilePath -> IORef Int -> MemorySource -> IO (Maybe MemoryId)
   35 saveMemory dir counterRef source = do
   36   n <- atomicModifyIORef' counterRef (\i -> (i + 1, i + 1))
   37   now <- getCurrentTime
   38   let mid = MemoryId (T.pack (show n))
   39       filename = T.unpack (unMemoryId mid) <> ".md"
   40       path = dir </> filename
   41       content = renderEntry mid now source
   42   TIO.writeFile path content
   43   pure (Just mid)
   44 
   45 -- | Search memories by case-insensitive substring match.
   46 searchMemories :: FilePath -> Text -> SearchConfig -> IO [SearchResult]
   47 searchMemories dir query config = do
   48   exists <- doesDirectoryExist dir
   49   if not exists
   50     then pure []
   51     else do
   52       files <- listDirectory dir
   53       let mdFiles = filter (".md" `isSuffixOf`) files
   54       results <- mapM (matchFile dir queryLower) mdFiles
   55       pure $ take (_sc_maxResults config)
   56            $ sortOn (negate . _sr_score)
   57            $ concatMap (filter (\r -> _sr_score r >= _sc_minScore config)) results
   58   where
   59     queryLower = T.toLower query
   60 
   61 -- | Check if a file matches the query.
   62 matchFile :: FilePath -> Text -> FilePath -> IO [SearchResult]
   63 matchFile dir queryLower filename = do
   64   content <- TIO.readFile (dir </> filename)
   65   let bodyText = extractBody content
   66       mid = MemoryId (T.pack (takeBaseName filename))
   67   if queryLower `T.isInfixOf` T.toLower bodyText
   68     then pure [SearchResult mid bodyText 1.0]
   69     else pure []
   70 
   71 -- | Recall a specific memory by ID.
   72 recallMemory :: FilePath -> MemoryId -> IO (Maybe MemoryEntry)
   73 recallMemory dir mid = do
   74   let path = dir </> T.unpack (unMemoryId mid) <> ".md"
   75   exists <- doesFileExist path
   76   if not exists
   77     then pure Nothing
   78     else do
   79       content <- TIO.readFile path
   80       pure (Just (parseEntry mid content))
   81 
   82 -- | Render a memory entry as markdown.
   83 renderEntry :: MemoryId -> UTCTime -> MemorySource -> Text
   84 renderEntry mid now source = T.unlines $
   85   [ "---"
   86   , "id: " <> unMemoryId mid
   87   , "created: " <> T.pack (formatTime defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" now)
   88   ]
   89   ++ renderMetadata (_ms_metadata source)
   90   ++ [ "---"
   91      , ""
   92      , _ms_content source
   93      ]
   94 
   95 renderMetadata :: Map Text Text -> [Text]
   96 renderMetadata m = [ k <> ": " <> v | (k, v) <- Map.toList m ]
   97 
   98 -- | Extract the body (after frontmatter) from a markdown file.
   99 extractBody :: Text -> Text
  100 extractBody content =
  101   case T.stripPrefix "---\n" content of
  102     Nothing -> content
  103     Just rest ->
  104       case T.breakOn "---\n" rest of
  105         (_, after) -> T.strip (T.drop 4 after)
  106 
  107 -- | Parse a markdown file into a MemoryEntry.
  108 parseEntry :: MemoryId -> Text -> MemoryEntry
  109 parseEntry mid content =
  110   let body = extractBody content
  111       metadata = parseFrontmatter content
  112       created = case Map.lookup "created" metadata of
  113         Just ts -> case parseTimeM True defaultTimeLocale "%Y-%m-%dT%H:%M:%SZ" (T.unpack ts) of
  114           Just t  -> t
  115           Nothing -> UTCTime (fromGregorian 2000 1 1) 0
  116         Nothing -> UTCTime (fromGregorian 2000 1 1) 0
  117   in MemoryEntry
  118     { _me_memoryId  = mid
  119     , _me_content   = body
  120     , _me_metadata  = Map.delete "id" (Map.delete "created" metadata)
  121     , _me_createdAt = created
  122     }
  123 
  124 -- | Parse frontmatter key-value pairs from markdown.
  125 parseFrontmatter :: Text -> Map Text Text
  126 parseFrontmatter content =
  127   case T.stripPrefix "---\n" content of
  128     Nothing -> Map.empty
  129     Just rest ->
  130       case T.breakOn "---\n" rest of
  131         (fm, _) ->
  132           Map.fromList
  133             [ (T.strip k, T.strip v)
  134             | line <- T.lines fm
  135             , let (k, rawV) = T.breakOn ":" line
  136             , not (T.null rawV)
  137             , let v = T.drop 1 rawV
  138             ]
  139