module All where import System.Directory.Tree import Data.String.HT import Logger import Control.Exception import ImperativeState import UrlAnalyse hiding (url) import Load import Compiler import GetImages import MakeChess import Join import Control.Monad.State hiding (join) import Tools import Data.ByteString hiding (take, reverse, dropWhile, takeWhile, drop, map, concat, elem, zip, intercalate) import System.Directory import System.IO.Temp import WikiHelper import System.Info import System.Process hiding (cwd) import Static import Data.List.Split import MagicStrings import Codec.Binary.UTF8.String import Data.Map hiding (map) import Data.List.HT (dropWhileRev) import Data.ByteString.UTF8 (toString) import Data.List import Data.Maybe import Data.Char import MediaWikiParseTree import MediaWikiParser import SimpleContributors import UrlAnalyse import Network.URL import System.FilePath import Control.Concurrent.MVar import Parallel getExtension :: String -> String getExtension s = normalizeExtension2 (map toLower (reverse . (takeWhile (/= '.')) . reverse $ s)) getConvert :: FilePath -> String getConvert p = if os == "linux" then convert else (getPathPrefix p) ++ convert where convert = if os == "linux" then "convert " else "convert.exe " makeTitle :: CompileResult -> FullWikiUrl -> [Char] makeTitle result fu = theTitle where theTitle = if (Compiler.title result) == "" then pub ++ tit else pub ++ (Compiler.title result) pub = "\\publishers{" ++ (concat (map chartrans (UrlAnalyse.hostname fu))) ++ "}\n" tit = "\\title{" ++ (concat (map (chartrans) ((removePrintVersion (lemma fu))))) ++ "}\n" getPathPrefix :: FilePath -> String getPathPrefix p = if os == "linux" then "" else (p ++ "..\\lib\\") runFileMods :: FilePath -> String -> String -> Integer -> [Integer] -> Integer -> String -> IO () runFileMods p filenamebase extension theResolution gals imageNumber pathname = case extension of ('s' : ('v' : ('g' : _))) -> do _ <- system ((getPathPrefix p) ++ "rsvg-convert -o " ++ pngfilename ++ " -a -w 1250 " ++ filename) postprocpng pngfilename _ <- system ((getPathPrefix p) ++ "rsvg-convert --format=pdf -o " ++ (filenamebase ++ "." ++ "pdf") ++ " -a -w 1250 " ++ filename) return () ('g' : ('i' : ('f' : _))) -> do stdfun b <- doesFileExist firstpngfilename if b then copyFile firstpngfilename newfilename else return () postprocpng newfilename ('t' : ('i' : ('f' : _))) -> do stdfun postprocpng newfilename ('j' : ('p' : ('g' : _))) -> postprocjpg filename ('p' : ('n' : ('g' : _))) -> postprocpng filename _ -> return () where firstpngfilename = (reverse . (drop 4) . reverse $ newfilename) ++ "-0.png" newfilename = filenamebase ++ "." ++ (normalizeExtension extension) filename = filenamebase ++ "." ++ extension stdfun = do _ <- system ((getConvert p) ++ "\"" ++ filename ++ "\" \"" ++ newfilename ++ "\"") return () postprocpng fn = do _ <- background fn dither fn return () postprocjpg fn = do _ <- system ((getConvert p) ++ "-verbose " ++ fn ++ " " ++ fn) dither fn return () background fn = system ((getConvert p) ++ fn ++ " -background white -flatten " ++ fn) pngfilename = filenamebase ++ "." ++ "png" dither :: String -> IO () dither fn = do _ <- system ((getConvert p) ++ "-verbose " ++ fn ++ " -format '%w' " ++ pathname ++ "nullfile.bmp" ++ " > " ++ pathname ++ "dump2 2> " ++ pathname ++ "dump") dump <- Tools.readFile (pathname ++ "dump") case reverse (Prelude.filter (\ x -> (trim x) /= "") (splitOn "\n" dump)) of (x : _) -> case splitOn " " x of (_ : (_ : (y : _))) -> case splitOn "x" y of (z : _) -> case reads z of [(ii, _)] -> do runDither fn (if imageNumber `elem` gals then galleryWidth else imageWidth) ii _ -> return () _ -> return () _ -> return () _ -> return () runDither :: String -> Integer -> Integer -> IO () runDither fn newSize oldSize = if newSize < oldSize then system ((getConvert p) ++ fn ++ " -resize " ++ (show newSize) ++ " " ++ fn) >> return () else return () textWidth = 10.5 galleryImageWidth = 5.0 centimetersPerInch :: Double centimetersPerInch = 2.54 galleryWidth :: Integer galleryWidth = round ((fromIntegral theResolution) * galleryImageWidth / centimetersPerInch) imageWidth :: Integer imageWidth = round ((fromIntegral theResolution) * textWidth / centimetersPerInch) writeFiles :: FilePath -> FilePath -> String -> [Maybe (String, Integer, [String])] -> Integer -> [Integer] -> IO () writeFiles dir p pathname theImages theResolution gals = mapM_ go (Prelude.zip ([1 ..] :: [Integer]) theImages) where go (i, Just (n, ii, _)) = do let filenamebase = (pathname ++ (show i)) let filename = filenamebase ++ "." ++ (getExtension n) filecontent <- Data.ByteString.readFile (dir (show ii)) Data.ByteString.writeFile filename filecontent runFileMods p filenamebase (getExtension n) theResolution gals i pathname go _ = return () makeBabel :: Maybe String -> [Char] -> String makeBabel b x = case Data.Map.lookup (fromMaybe xx b) m of Just v -> decode . unpack $ v _ -> case Data.Map.lookup "en" m of Just w -> decode . unpack $ w _ -> "" where m = fromList babelFiles xx = case splitOn "." x of (z : _) -> z _ -> "en" data LatexConfig = LatexConfig{figures :: [Maybe (String, Integer, [String])], title :: String, fullConfig :: FullConfig, content :: String, hostname :: String, theResult :: CompileResult, onlyTables :: Bool, lang :: Maybe String, theTempDir :: String} runLaTeX :: LatexConfig -> ImperativeMonad ByteString runLaTeX config = liftIO (withSystemTempDirectory "MediaWiki2LaTeX" (runLaTeXCallback config)) runLaTeXCallback :: LatexConfig -> FilePath -> IO ByteString runLaTeXCallback config pathname = do extract pathname Tools.writeFile (pathname ++ "/document/main/main.tex") (content config) Tools.writeFile (pathname ++ "/document/headers/svg.tex") (if vector (fullConfig config) then "\\newcommand{\\SVGExtension}{pdf}" else "\\newcommand{\\SVGExtension}{png}") Tools.writeFile (pathname ++ "/document/headers/title.tex") (All.title config) Tools.writeFile (pathname ++ "/document/headers/babel.tex") (makeBabel (lang config) (All.hostname config)) Tools.writeFile (pathname ++ "/document/headers/paper.tex") ("\\KOMAoption{paper}{" ++ (paper (fullConfig config)) ++ "}") if (onlyTables config) then return () else All.writeFiles (theTempDir config) (mainPath (fullConfig config)) (pathname ++ "/document/images/") (figures config) (resolution (fullConfig config)) (galleryNumbers (theResult config)) cwd <- getCurrentDirectory setCurrentDirectory (pathname ++ "/document/main") case (ImperativeState.copy (fullConfig config)) of Just x -> do d <- readDirectoryWith Data.ByteString.readFile "../../document/" _ <- writeDirectoryWith Data.ByteString.writeFile d{anchor = x} return () _ -> return () _ <- forM ((if onlyTables config then [1] else [1, 2]) :: [Integer]) (\ _ -> system ((if os == "linux" then "xelatex" else (mainPath (fullConfig config)) ++ "..\\miktex\\miktex\\bin\\pdflatex.exe") ++ " --interaction=nonstopmode main.tex")) _ <- ((if onlyTables config then return () else system ((if os == "linux" then "makeindex" else (mainPath (fullConfig config)) ++ "..\\miktex\\miktex\\bin\\makeindex.exe") ++ " main")>> return ())) _ <- forM ((if onlyTables config then [] else [1, 2]) :: [Integer]) (\ _ -> system ((if os == "linux" then "xelatex" else (mainPath (fullConfig config)) ++ "..\\miktex\\miktex\\bin\\pdflatex.exe") ++ " --interaction=nonstopmode main.tex")) result <- if (onlyTables config) then do _ <- system ((if os == "linux" then "" else (mainPath (fullConfig config)) ++ "..\\pdftotext\\") ++ "pdftotext main.pdf main.txt") te <- Control.Exception.catch (Tools.readFile ("main.txt")) catchFun case splitOn "\n" te of (x : _) -> return (pack (encode (strip "pt\r" x))) _ -> return (pack (encode "")) else Data.ByteString.readFile "main.pdf" setCurrentDirectory cwd return result getLang :: URL -> IO (Maybe String) getLang u = let theUrl = exportURL u in do yy <- geturl theUrl case (deepGet2 "html" (parseit minparsers yy)) of ((Environment Tag (TagAttr _ m) _) : []) -> return $ Data.Map.lookup "lang" m _ -> return $ Nothing catchFun :: IOException -> IO String catchFun _ = return "" strip :: (Eq a) => [a] -> [a] -> [a] strip l = dropWhileRev isBad . dropWhile isBad where isBad x = x `elem` l latexPostamble :: String latexPostamble = "\n\\end{longtable}\n\\pagebreak" imgContrib :: MVar [Maybe (String, Integer, [String])] -> ImperativeMonad (MVar (Maybe (String, Maybe String))) imgContrib z = do x <- liftIO (readMVar z) xx <- mapM imgContrib2 x li <- liftIO (liftList (return . msum) xx) liftIO (liftA go li) where go (Just xxx) = return (Just xxx) go _ = return (Just ("", Nothing)) imgContrib2 :: Maybe (String, Integer, [String]) -> ImperativeMonad (MVar (Maybe (String, Maybe String))) imgContrib2 (Just (_, _, x)) = do img <- getContributors x ffi <- liftIO $ liftA (return . fst) img fif <- liftIO (liftList2 (return . ffun . contribsum) ffi) ssn <- liftIO $ liftA (return . snd) img sns <- liftIO (liftList2 (return . msum) ssn) liftIO (liftA2 fun fif sns) where ffun :: Map String Contributor -> String ffun i = intercalate ", " (keys (i)) fun :: String -> Maybe String -> IO (Maybe (String, Maybe String)) fun fi sn = return (Just (fi, sn)) imgContrib2 _ = liftIO (base Nothing) makeImgList :: [MVar [Maybe (String, Integer, [String])]] -> ImperativeMonad String makeImgList imgs2 = do ccontrib <- mapM (imgContrib) imgs2 cccontrib <- liftIO (liftList (return . id) ccontrib) contrib <- liftIO (readMVar cccontrib) imgs <- liftIO (mapM readMVar imgs2) let z = concat (map go (zip (zip ([1 ..] :: [Integer]) contrib) (concat imgs))) return ((toString latexPreamble) ++ z ++ (latexPostamble)) where go (((i, Just (con, lic)), Just (_, _, (_ : (u : _))))) = "\\href{" ++ (replace2 (replace2 (concat (map chartransforlink u)) "//" "/") "http:/" "http://") ++ "}{" ++ (show i) ++ "}& " ++ con ++ "&" ++ (fromMaybe "" lic) ++ "\\\\ \\hline \n" go (((i, _), _)) = (show i) ++ "&&\\\\ \\hline \n" all :: FullConfig -> ImperativeMonad () all cfg = do systempdir <- liftIO getTemporaryDirectory tempdir <- liftIO $ createTempDirectory systempdir "MediaWiki2LaTeXImages" st <- get templates <- case runMode cfg of UserTemplateFile filename -> liftIO (Tools.readFile filename) _ -> return userTemplates let uurl = replace2 (if (take 8 (inputUrl cfg)) == "https://" then "http://" ++ (drop 8 (inputUrl cfg)) else if (take 7 (inputUrl cfg)) == "http://" then (inputUrl cfg) else "http://" ++ (inputUrl cfg)) "_" " " purl <- parseUrl uurl language <- liftIO $ getLang (UrlAnalyse.url purl) put st{fullUrl = purl} minInit text <- load (runMode cfg) result <- compile (runMode cfg) text templates [] theImages <- getImages tempdir (images result) (wikiUrl purl) joined <- join (body result) "" makeChess let theConfig = LatexConfig{content = joined, figures = [], All.title = (makeTitle result purl), fullConfig = cfg, All.hostname = (UrlAnalyse.hostname purl), theResult = result, onlyTables = True, lang = language, theTempDir = tempdir} tabs <- mapM (\ x -> mapM (\ y -> runLaTeX theConfig{content = (toString (latexTableHeader)) ++ y ++ (toString latexTableFooter)}) x) (tablelist result) newResult <- compile (runMode cfg) text templates tabs pp <- makeImgList theImages contrib <- makeContributors (Just (UrlAnalyse.url purl)) newContent <- join (body newResult) (contrib ++ pp) thetheImages <- liftIO $ do ii <- mapM (readMVar) theImages return (concat ii) pdf <- runLaTeX theConfig{onlyTables = False, theResult = newResult, content = newContent, figures = thetheImages} liftIO (Data.ByteString.writeFile (outputFilename cfg) pdf) liftIO $ removeDirectoryRecursive tempdir