diff --git a/MDict.hs b/MDict.hs
index 0bd271a..ec4fc26 100644
--- a/MDict.hs
+++ b/MDict.hs
@@ -34,18 +34,22 @@ 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)
+import Data.List (isInfixOf, intercalate, foldl')
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 Wazahs
+import Data.Bool (Bool)
-- C-compatible struct
data SimpleKeyItem = SimpleKeyItem
@@ -237,54 +241,62 @@ listAllKeys dict = do
-- Media related functions:
--- | Replace all local ![]()
sources with base64 content from .mdd
+findLocalImages :: String -> [String]
+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
- -- Phase 1: Replace 
media
- 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
+ -- Get all CSS and HTML paths
+ let allPaths = findLocalImages html ++ findcss html
-- 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 "") cssBlocks
-
- -- Inject all CSS into if exists, otherwise prepend
- let maybeHead = scrapeStringLike html' (chroot "head" (return ()))
- htmlWithCss =
- if maybeHead /= Nothing
- then intercalate ("" ++ cssTag) (splitOn "" html')
- else cssTag ++ html'
-
- return htmlWithCss
+ resources <- fetchResources mddFile allPaths
+ pure $ injectResources html resources
-- | Replace a single ![]()
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
+ return $ replaceSrc [orig] base64 html html
-- | Helper: convert '/' to '\'
slashToBack :: Char -> Char
@@ -292,12 +304,15 @@ slashToBack '/' = '\\'
slashToBack c = c
-- | Replace the original src attribute with the base64 string
-replaceSrc :: String -> String -> String -> String
-replaceSrc orig base64 html =
- T.unpack $ T.replace (T.pack $ "src=\"" ++ orig ++ "\"")
- (T.pack $ "src=\"" ++ base64 ++ "\"")
- (T.pack html)
-
+-- attrs is the list, e.g., ["src", "href"]
+replaceSrc :: [String] -> String -> String -> String -> String
+replaceSrc attrs orig base64 html =
+ foldl' uAttr html attrs
+ where
+ 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
@@ -313,6 +328,12 @@ 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 =
diff --git a/cli-example/Main.hs b/cli-example/Main.hs
index 1babcda..99cc0d0 100644
--- a/cli-example/Main.hs
+++ b/cli-example/Main.hs
@@ -1,15 +1,9 @@
{-# LANGUAGE OverloadedStrings #-}
-import Text.HTML.Scalpel
-import Data.Maybe (fromMaybe)
-import Data.List (isInfixOf)
-import qualified Data.Text as T
import System.Environment (getArgs)
import System.Exit (exitFailure)
-import Control.Monad
-import System.FilePath (replaceExtension)
-import MDict
-
+import Control.Monad (when)
+import MDict (lookupInCollection)
main :: IO ()
main = do
@@ -21,5 +15,5 @@ main = do
let dictDir = args !! 0
queryKey = args !! 1
- -- Process all files (lookupInCollection lists files itself)
+ -- Process all files
lookupInCollection dictDir queryKey