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