module Load where
import ImperativeState
import Tools
import UrlAnalyse
import Control.Monad.State
import Control.Monad.Error
import Text.ParserCombinators.Parsec hiding (try)
import Text.Parsec.Prim
import Codec.Binary.UTF8.String
import Data.String.HT
import Data.ByteString
hiding (takeWhile, isInfixOf, intercalate, concat, map, sort)
import Data.List.Split
import Data.Map as Map hiding (map)
import Data.List hiding (lookup)
import MagicStrings
import SimpleContributors
import WikiHelper
import MediaWikiParseTree
import MediaWikiParser
import Compiler
import Network.URL
import Control.Concurrent
import Parallel
notendyet ::
(String -> ImperativeMonad String) ->
ParsecT String () ImperativeMonad String ->
ParsecT String () ImperativeMonad String ->
String -> ParsecT String () ImperativeMonad String
notendyet action sstart eend aku
= try
(do eof
return aku)
<|>
try
(do _ <- eend
r <- startToEnd action sstart eend
a <- lift (action aku)
return (a ++ r))
<|>
do a <- anyChar
notendyet action sstart eend (aku ++ [a])
beginning ::
(String -> ImperativeMonad String) ->
ParsecT String () ImperativeMonad String ->
ParsecT String () ImperativeMonad String ->
ParsecT String () ImperativeMonad [Char]
beginning action sstart eend
= try
(do eof
return [])
<|>
do _ <- sstart
ne <- notendyet action sstart eend []
return (ne)
startToEnd ::
(String -> ImperativeMonad String) ->
ParsecT String () ImperativeMonad String ->
ParsecT String () ImperativeMonad String ->
ParsecT String () ImperativeMonad String
startToEnd action sstart eend
= try
(do eof
return [])
<|> try (beginning action sstart eend)
<|>
do a <- anyChar
s <- startToEnd action sstart eend
return (a : s)
zeroAction :: (Monad m) => t -> t1 -> m [Char]
zeroAction _ _ = return ""
runAction ::
String ->
String ->
(String -> ImperativeMonad String) ->
String -> ImperativeMonad String
runAction sstart eend action text
= do x <- (runParserT
(startToEnd action (string sstart) (string eend))
()
""
text)
case x of
Left _ -> return ""
Right xs -> return xs
chapterAction :: WikiUrl -> String -> ImperativeMonad String
chapterAction wurl text
= do pp <- liftIO (getpage d (wurl))
case pp of
Just p -> do _ <- addContributors d Nothing
noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p)
_ -> return ""
where d = (trim (takeWhile (/= '|') text))
chapterAction2 :: FullWikiUrl -> String -> ImperativeMonad String
chapterAction2 fu text
= do pp <- liftIO (getpage d (wurl))
case pp of
Just p -> do _ <- addContributors d Nothing
noinclude wurl
("\n\ndhunparserurl " ++ d ++ "\n\n" ++ "= " ++ e ++ " =\n" ++ p)
_ -> return ""
where e = (trim (takeWhile (/= '|') text))
d = (removePrintVersion (lemma fu)) ++ "/" ++ e
wurl = wikiUrl fu
includeAction :: WikiUrl -> String -> ImperativeMonad String
includeAction = qIncludeAction
qIncludeAction :: WikiUrl -> String -> ImperativeMonad String
qIncludeAction wurl text
= do pp <- liftIO (getpage d (wurl))
case pp of
Just p -> do _ <- addContributors d Nothing
noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p)
_ -> return ""
where d = (trim (takeWhile (/= '|') text))
makeUrl :: String -> String -> String -> [Char]
makeUrl lang theFam thePage
= (unify . exportURL)
(if isInfixOf "commons" lang then
(URL{url_path = "~daniel/WikiSense/Contributors.php",
url_params =
[("wikifam", "commons.wikimedia.org"), ("page", thePage),
("since", ""), ("until", ""), ("grouped", "on"),
("hideanons", "on"), ("max", "100000"), ("format", "html")],
url_type =
Absolute
(Host{protocol = HTTP True, host = "toolserver.org",
port = Nothing})})
else
(URL{url_path = "~daniel/WikiSense/Contributors.php",
url_params =
[("wikilang", lang), ("wikifam", theFam), ("page", thePage),
("since", ""), ("until", ""), ("grouped", "on"),
("hideanons", "on"), ("max", "100000"), ("format", "html")],
url_type =
Absolute
(Host{protocol = HTTP True, host = "toolserver.org",
port = Nothing})}))
langau :: Map String String
langau
= fromList
[("hi", "\2354\2375\2326\2325"), ("ja", "\33879\32773"),
("pl", "Autorzy"),
("lo", "\3737\3761\3713\3739\3760\3742\3761\3737"),
("fi", "Tekij\228"), ("sv", "F\246rfattare"), ("pt", "Autores"),
("ru", "\1040\769\1074\1090\1086\1088\1099"),
("ko", "\51200\51088"), ("tr", "Yazar"), ("sk", "Avtor"),
("hy", "\1344\1381\1394\1387\1398\1377\1391"), ("lt", "Autorius"),
("ta", "\2986\2975\3016\2986\3021\2986\3006\2995\2992\3021"),
("en", "Contributors"), ("ro", "Autor"), ("it", "Autori"),
("hr", "\192utor"), ("vo", "Lautan"), ("eo", "Verkinto"),
("hu", "Szerz\337"), ("is", "H\246fundur"), ("gd", "\217ghdar"),
("de", "Autoren"), ("ca", "Autor"),
("el", "\931\965\947\947\961\945\966\941\945\962"),
("bg", "\1040\1074\1090\1086\1088"),
("ce", "\1071\1079\1076\1072\1088\1093\1086"), ("nl", "Auteurs"),
("es", "Autores"), ("eu", "Egile"), ("fr", "Auteurs"),
("cs", "Autor"), ("br", "Aozer")]
makeHeader :: FullWikiUrl -> Maybe String -> [Char]
makeHeader fullurl m
= let mmm = m >>= (\ yy -> Map.lookup yy langau) in
"\\chapter{" ++
(case
mmm `mplus`
(case splitOn "." (hostname fullurl) of
(x : _) -> Map.lookup x langau
_ -> Nothing)
`mplus` (Map.lookup "en" langau)
of
Just x -> x
_ -> "Contributors")
++
"}\n" ++
"\\label{Contributors}\n" ++
"\\begin{longtable}{rp{0.6\\linewidth}}\n" ++
"\\textbf{Edits}&\\textbf{User}\\\\\n"
makeBody :: (Ord t) => Map t Contributor -> URL -> [Char]
makeBody m u = concat (map go (sort (toList m)))
where fun ('/' : xs) = xs
fun xs = xs
go (_, v)
= (show (edits v)) ++
"& \\myhref{" ++
(concat
(map chartransforlink (exportURL (u{url_path = (fun (href v))}))))
++ "}{" ++ (concat (map chartrans (name v))) ++ "}\\\\\n"
makeContributors :: Maybe URL -> ImperativeMonad String
makeContributors uu
= do st <- get
li <- liftIO (mapM readMVar (audict st))
let myaudict = contribsum li
let theUrl
= case uu of
Just u -> exportURL u
_ -> makeUrl3 (lemma (fullUrl st)) (hostname (fullUrl st))
yy <- liftIO $ geturl theUrl
let lang
= case (deepGet2 "html" (parseit minparsers yy)) of
((Environment Tag (TagAttr _ m) _) : []) -> Map.lookup "lang" m
_ -> Nothing
return
((makeHeader (fullUrl st) lang) ++
(makeBody (myaudict) (url (fullUrl st))) ++
"\\end{longtable}\n" ++ "\\pagebreak\n")
parseUrl :: String -> ImperativeMonad FullWikiUrl
parseUrl u
= case analyseFull u of
Just x -> return x
_ -> throwError (WikiUrlParseError u)
getContributors ::
[String] ->
ImperativeMonad
(MVar ([MVar (Map String Contributor)], [MVar (Maybe String)]))
getContributors u
= do st <- get
put imperativeStateZero
au <- mapM go u
newState <- get
put st
rr <- liftIO (newMVar (audict newState, au))
return rr
where go uu
= do purl <- parseUrl uu
sst <- get
put sst{fullUrl = purl}
addContributors (lemma purl) (Just (UrlAnalyse.url purl))
addContributors ::
[Char] -> Maybe URL -> ImperativeMonad (MVar (Maybe String))
addContributors theLemma uu
= do sst <- get
let st = fullUrl sst
thetheLemma <- liftIO . base $ theLemma
thetheHostname <- liftIO . base . hostname $ st
thetheUU <- liftIO . base $ uu
au <- (liftIO (((liftA3 fun) thetheLemma thetheHostname thetheUU)))
:: ImperativeMonad (MVar (Map String Contributor, Maybe String))
auau <- liftIO ((liftA (return . fst)) au)
lic <- liftIO ((liftA (return . snd)) au)
put sst{audict = auau : (audict sst)}
return lic
where fun lem ho uuu
= do xx <- simpleContributors lem ho uuu
return (Data.List.foldl runGo2 Map.empty xx, myvalue xx)
runGo2 mymap (author, theHref, theEdits, _)
= Map.alter (infun author theHref (fromIntegral theEdits)) author
mymap
myvalue yy
= case yy of
[(_, __, _, Just lic)] -> (Just lic)
_ -> Nothing
infun ::
String ->
String -> Integer -> Maybe Contributor -> Maybe Contributor
infun a h e xx
= case xx of
Nothing -> Just Contributor{name = a, href = h, edits = e}
Just old -> Just old{edits = (edits old) + e}
noinclude :: t -> String -> ImperativeMonad [Char]
noinclude wurl
= runAction "<noinclude>" "</noinclude>" (zeroAction wurl)
runActions :: FullWikiUrl -> String -> ImperativeMonad String
runActions fu text
= do x <- noinclude wurl text
y <- runAction "{{Druckversion Kapitel|" "}}" (chapterAction wurl)
x
z <- runAction "{{print entry|" "}}" (chapterAction2 fu) y
a <- runAction "{{Print entry|" "}}" (chapterAction wurl) z
b <- runAction "{{:" "}}" (includeAction wurl) a
c <- runAction "{{:" "}}" (qIncludeAction wurl) b
d <- runAction "{{:" "}}" (qIncludeAction wurl) c
e <- runAction "{{:" "}}" (qIncludeAction wurl) d
f <- runAction "{{:" "}}" (qIncludeAction wurl) e
g <- runAction "{{:" "}}" (qIncludeAction wurl) f
h <- runAction "{{:" "}}" (qIncludeAction wurl) g
i <- runAction "{{:" "}}" (qIncludeAction wurl) g
j <- runAction "{{:" "}}" (qIncludeAction wurl) h
_ <- runAction "{{:" "}}" (qIncludeAction wurl) i
runAction "{{:" "}}" (qIncludeAction wurl) j
where wurl = wikiUrl fu
replacements :: String -> String
replacements x
= replace2
(replace2
(replace2
(replace2 x "[[Image:Nuvola apps noatun.png|left|20px|Aufgabe]]"
"{{Ubung}}")
"[[Image:Yes_check.svg|12px]]"
"{{TickYes}}")
"{{col-break}}"
"\n|")
"{{Fortran:Vorlage: Table}}"
"prettytable"
loadPlain :: ImperativeState -> Maybe URL -> ImperativeMonad [Char]
loadPlain st uu
= let fu = fullUrl st in
do pp <- liftIO (getpage (lemma fu) (wikiUrl fu))
case pp of
Just p -> do _ <- addContributors (lemma fu) uu
runActions fu p
_ -> throwError (DownloadError (lemma fu) (exportURL (url fu)))
loadHTML :: ImperativeState -> ImperativeMonad String
loadHTML st
= let fu = fullUrl st in
do _ <- loadPlain st (Just (url fu))
x <- liftIO (geturl2 (exportURL (url fu)))
return . decode . unpack $ x
loadMediaWiki :: ImperativeState -> ImperativeMonad [Char]
loadMediaWiki st
= let fu = fullUrl st in
do pp <- liftIO (getpage2 (lemma fu) (wikiUrl fu))
case pp of
Just (ss, u) -> do _ <- addContributors (lemma fu) Nothing
s <- liftIO
(getExpandedPage (lemma fu)
(replace2
(replace2
(replace2 ss "<ref name=" "dhunnamedrefopendhun")
"<ref"
"dhunrefopendhun")
"</ref>"
"dhunrefclosedhun")
u)
case s of
Just sss -> return
(multireplace sss
[("<", "<"), (">", ">"), ("&", "&"),
("dhunrefopendhun", "<ref"),
("dhunnamedrefopendhun", "<ref name="),
("dhunrefclosedhun", "</ref>")])
_ -> do liftIO (print "Error")
throwError
(DownloadError (lemma fu) (exportURL (url fu)))
_ -> throwError (DownloadError (lemma fu) (exportURL (url fu)))
load :: RunMode -> ImperativeMonad String
load theRunMode
= do st <- get
case theRunMode of
HTML -> loadHTML st
UserTemplateFile _ -> loadPlain st Nothing
StandardTemplates -> loadPlain st Nothing
ExpandedTemplates -> loadMediaWiki st