diff --git a/MDict.hs b/MDict.hs
index 406bbba..ed63e16 100644
--- 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]
-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
-
+-- | Replace all local ![]()
sources with base64 content from .mdd
replaceMedia :: FilePath -> String -> IO String
replaceMedia mdxFile html = do
let mddFile = replaceExtension mdxFile ".mdd"
mdxDir = takeDirectory mdxFile
- -- Get all CSS and HTML paths
- let allPaths = findLocalImages html ++ findcss html
+ -- 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
-- 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 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 -> 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)
+replaceSrc :: String -> String -> String -> String
+replaceSrc orig base64 html =
+ T.unpack $ T.replace (T.pack $ "src=\"" ++ orig ++ "\"")
+ (T.pack $ "src=\"" ++ base64 ++ "\"")
+ (T.pack html)
+
-- | 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 "-----"
-