Update MDict.hs

2026-01-20 03:43:49 +00:00
1 changed files with 55 additions and 64 deletions
--- a/MDict.hs
+++ b/MDict.hs
@ -34,22 +34,27 @@ import qualified Data.ByteString.Char8 as BSC
 import Data.Word (Word64)
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
 import qualified Data.Conduit.Combinators as CC
 import Data.Conduit
 import Conduit
 import Data.Char (toLower)
 import System.FilePath (takeExtension)
 import Text.HTML.Scalpel
 import Data.Maybe (fromMaybe)
-import Data.List (isInfixOf, intercalate, foldl')
+import Data.List (isInfixOf, intercalate)
 import Data.List.Split (splitOn)
 import System.Directory (doesFileExist)
 import System.FilePath ((</>), takeDirectory)
 import Control.Monad
 import Control.Applicative
 import System.FilePath (replaceExtension)
 import Control.DeepSeq (NFData, deepseq)
-import Data.Bool (Bool)
+import qualified Data.Conduit.Combinators as CC
 import Data.Conduit
 import Conduit
 listFiles :: FilePath -> IO [FilePath]
 listFiles dir = runConduitRes $
       CC.sourceDirectoryDeep False dir
  .|   filterC (\fp -> takeExtension fp == ".mdx")
  .|   CC.sinkList
 -- C-compatible struct
 data SimpleKeyItem = SimpleKeyItem
@ -241,62 +246,54 @@ listAllKeys dict = do
 -- Media related functions:
-findLocalImages :: String -> [String]
+-- | Replace all local <img> sources with base64 content from .mdd
 findLocalImages html =
  let urlsRaw = scrapeStringLike html $ chroots "img" $ attr "src" anySelector
      allUrls = fromMaybe [] urlsRaw
  in filter isLocal allUrls
 findcss :: String -> [String]
 findcss html =
  let urlsRaw = scrapeStringLike html $ chroots "link" $ liftA2 (,) (attr "rel" anySelector) (attr "href" anySelector) >>= \(rel, href) -> guard (rel == "stylesheet") >> pure href
      allUrls = fromMaybe [] urlsRaw
  in filter isLocal allUrls
 isLocal :: String -> Bool
 isLocal url = not ("://" `isInfixOf` url)
 -- Takes a list of paths, looks them up in the MDD, returns pairs of (Path, Base64)
 fetchResources :: FilePath -> [String] -> IO [(String, String)]
 fetchResources mddFile paths = do
    mapM (\path -> do
        let query = "\\" ++ map slashToBack path
        base64 <- lookupMedia mddFile query
        return (path, base64)
         ) paths
 -- Replaces every occurrence of 'path' with 'base64' in the HTML
 injectResources :: String -> [(String, String)] -> String
 injectResources  =
    foldl' applyReplacement
  where
    applyReplacement currentHtml (path, base64) =
        if null base64 
           then currentHtml
           else replaceSrc ["src", "href"] path base64 currentHtml
 replaceMedia :: FilePath -> String -> IO String
 replaceMedia mdxFile html = do
    let mddFile = replaceExtension mdxFile ".mdd"
        mdxDir  = takeDirectory mdxFile
-    -- Get all CSS and HTML paths 
+    -- Phase 1: Replace <img src="..."> media
-    let allPaths = findLocalImages html ++ findcss html
+    let urlsRaw = scrapeStringLike html $ chroots "img" $ attr "src" anySelector
        urls = fromMaybe [] urlsRaw
        localPaths = filter (not . isInfixOf "://") urls
    html' <- foldM (replaceOne mddFile) html localPaths
    -- Phase 2: Handle CSS
    let cssRaw = scrapeStringLike html' $ chroots "link" $ do
            rel  <- attr "rel" anySelector
            href <- attr "href" anySelector
            if rel == "stylesheet" then return href else fail "not css"
        cssFiles = fromMaybe [] cssRaw
        localCssFiles = filter (not . isInfixOf "://") cssFiles
    -- Lookup each CSS in the dictionary or read from local file
    cssBlocks <- mapM (\css -> do
                          let localPath = mdxDir </> css
                          exists <- doesFileExist localPath
                          if exists
                             then readFile localPath
                             else lookupMedia mddFile css
                      ) localCssFiles
    let cssTag = concatMap (\c -> if null c then "" else "<style>" ++ c ++ "</style>") cssBlocks
    -- Inject all CSS into <head> if exists, otherwise prepend
    let maybeHead = scrapeStringLike html' (chroot "head" (return ()))
        htmlWithCss =
            if maybeHead /= Nothing
               then intercalate ("<head>" ++ cssTag) (splitOn "<head>" html')
               else cssTag ++ html'
    return htmlWithCss
    resources <- fetchResources mddFile allPaths
    pure $ injectResources html resources
 -- | Replace a single <img> src with base64 content
 replaceOne :: FilePath -> String -> String -> IO String
 replaceOne mddFile html orig = do
    let lookupQuery = "\\" ++ map slashToBack orig
    base64 <- lookupMedia mddFile lookupQuery
-    return $ replaceSrc [orig] base64 html html
+    return $ replaceSrc orig base64 html
 -- | Helper: convert '/' to '\'
 slashToBack :: Char -> Char
@ -304,15 +301,12 @@ slashToBack '/' = '\\'
 slashToBack c   = c
 -- | Replace the original src attribute with the base64 string
-- attrs is the list, e.g., ["src", "href"]
+replaceSrc :: String -> String -> String -> String
-replaceSrc :: [String] -> String -> String -> String -> String
+replaceSrc orig base64 html =
-replaceSrc attrs orig base64 html =
+    T.unpack $ T.replace (T.pack $ "src=\"" ++ orig ++ "\"")
-  foldl' uAttr html attrs
+                         (T.pack $ "src=\"" ++ base64 ++ "\"")
-  where
+                         (T.pack html)
-    uAttr chtml attr =
+
      T.unpack $ T.replace (T.pack $ attr ++ "=\"" ++ orig ++ "\"" )
                           (T.pack $ attr ++ "=\"" ++ base64 ++ "\"" )
                           (T.pack chtml)
 -- | Lookup the actual media in a .mdd using your MDict bindings
 lookupMedia :: FilePath -> String -> IO String
@ -328,12 +322,6 @@ lookupMedia mddFile query = do
              --  putStrLn $ "DEBUG: Found media for " ++ query
                return base64
 listFiles :: FilePath -> IO [FilePath]
 listFiles dir = runConduitRes $
       CC.sourceDirectoryDeep False dir
  .|   filterC (\fp -> takeExtension fp == ".mdx")
  .|   CC.sinkList
 processDictionary :: FilePath -> String -> IO (Either String String)
 processDictionary dictFile queryKey =
@ -351,7 +339,10 @@ lookupInCollection dir queryKey = do
    files <- listFiles dir
    forM_ files $ \file -> do
        putStrLn $ "Processing: " ++ file
-        html <- lookupWordAtomic file queryKey -- needs to combine with replaceMedia
+        res <- processDictionary file queryKey
        html <- case res of
            Left err -> error $ "Error: " ++ err
            Right h  -> return h
        putStrLn html
        putStrLn "-----"