{-| module to download the wiki source text form the wiki website -}
module Load where
import ImperativeState
import Tools
import Hex
import UrlAnalyse
import Control.Monad.State
import System.IO.Temp
import System.Directory
import System.FilePath.Posix
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 Network.URL
import Control.Monad.Except
import System.Process

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

chapterAction3 :: FullWikiUrl -> String -> ImperativeMonad String
chapterAction3 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
  = if isInfixOf "Vorlage" text then return ("{{" ++ text ++ "}}")
      else
      do pp <- (liftIO (print d)) >> 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))

qBookIncludeAction :: WikiUrl -> String -> ImperativeMonad String
qBookIncludeAction wurl text
  = if isInfixOf "Vorlage" text then return ("{{" ++ text ++ "}}")
      else
      do pp <- (liftIO (print d)) >> liftIO (getBookpage d (wurl))
         case pp of
             Just p -> do _ <- addContributors d Nothing
                          x <- noinclude wurl ("\n\ndhunparserurl " ++ d ++ "\n\n" ++ p)
                          st <- get
                          systempdir <- liftIO getTemporaryDirectory
                          tempdir <- liftIO $
                                       createTempDirectory systempdir "MediaWiki2LaTeXParser"
                          liftIO $ Tools.writeFile (tempdir </> "input") x
                          _ <- liftIO $
                                 system
                                   ("mediawiki2latex -x " ++
                                      (Hex.hex (show (fullconfigbase{compile = Just tempdir}))))
                          t <- liftIO $ Tools.readFile (tempdir </> "output")
                          put st{loadacu = ((read t) ++ (loadacu st) :: [Anything Char])}
                          return x
             _ -> 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"

makeHeaderHTML :: FullWikiUrl -> Maybe String -> [Char]
makeHeaderHTML fullurl m
  = let mmm = m >>= (\ yy -> Map.lookup yy langau) in
      "<h2>" ++
        (case
           mmm `mplus`
             (case splitOn "." (hostname fullurl) of
                  (x : _) -> Map.lookup x langau
                  _ -> Nothing)
             `mplus` (Map.lookup "en" langau)
           of
             Just x -> x
             _ -> "Contributors")
          ++
          "</h2>\n" ++
            "<table rules=\"all\">" ++ "<tr><td>Edits</td><td>User</td></tr>"

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"

makeBodyHTML :: (Ord t) => Map t Contributor -> URL -> [Char]
makeBodyHTML m u = concat (map go (sort (toList m)))
  where fun ('/' : xs) = xs
        fun xs = xs
        go (_, v)
          = "<tr><td>" ++
              (show (edits v)) ++
                "</td><td><a href=\"" ++
                  (((exportURL (u{url_path = (fun (href v))})))) ++
                    "\">" ++ (concat (map chartrans (name v))) ++ "</a></td></tr>"

makeContributors :: Maybe URL -> ImperativeMonad (String, String)
makeContributors uu
  = do st <- get
       li <- liftIO (return (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"),
          (makeHeaderHTML (fullUrl st) lang) ++
            (makeBodyHTML (myaudict) (url (fullUrl st))) ++ "</table>")

parseUrl :: String -> ImperativeMonad FullWikiUrl
parseUrl u
  = case analyseFull u of
        Just x -> return x
        _ -> throwError (WikiUrlParseError u)

getContributors ::
                [String] ->
                  ImperativeMonad (([(Map String Contributor)], [(Maybe String)]))
getContributors u
  = do st <- get
       stz <- liftIO imperativeStateZero
       put stz{counter = counter st}
       au <- mapM go u
       newState <- get
       put st
       rr <- liftIO (return (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 ((Maybe String))
addContributors theLemma uu
  = do sst <- get
       let st = fullUrl sst
       thetheLemma <- liftIO $ return theLemma
       thetheHostname <- liftIO $ return (hostname st)
       thetheUU <- liftIO $ return uu
       au <- (liftIO ((((fun sst)) thetheLemma thetheHostname thetheUU)))
               :: ImperativeMonad ((Map String Contributor, Maybe String))
       auau <- liftIO (((return . fst)) au)
       lic <- liftIO (((return . snd)) au)
       put sst{audict = auau : (audict sst)}
       return lic
  where fun ssst lem ho uuu
          = do xx <- simpleContributors lem ho uuu ssst
               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|" "}}" (chapterAction3 fu) x
       v <- runAction "{{Print entry|" "}}" (chapterAction2 fu) y
       z <- runAction "{{print entry|" "}}" (chapterAction2 fu) v
       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

runBookActions :: FullWikiUrl -> String -> ImperativeMonad String
runBookActions fu text
  = do x <- noinclude wurl text
       runAction "[[" "]]" (qBookIncludeAction wurl) x
  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)))

loadBook :: ImperativeState -> Maybe URL -> ImperativeMonad [Char]
loadBook 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
                          runBookActions fu p
             _ -> throwError (DownloadError (lemma fu) (exportURL (url fu)))

loadHTML :: ImperativeState -> ImperativeMonad String
loadHTML st
  = let fu = fullUrl st in
      do midst <- get
         (res, newst) <- liftIO
                           (runStateT (runExceptT (loadPlain st (Just (url fu)))) midst)
         case res of
             Right _ -> put newst
             _ -> return ()
         x <- liftIO (geturl2 (exportURL (url fu)))
         return . decode . unpack $ x

loadBookHTML :: ImperativeState -> ImperativeMonad String
loadBookHTML st
  = let fu = fullUrl st in
      do midst <- get
         (res, newst) <- liftIO
                           (runStateT (runExceptT (loadPlain st (Just (url fu)))) midst)
         case res of
             Right _ -> put newst
             _ -> return ()
         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
                                                     [("&lt;", "<"), ("&gt;", ">"), ("&amp;", "&"),
                                                      ("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)))

{-| main function to download images form the wiki. It takes the RunMode as only parameter. In case of HTML the html from the website is loaded. In all other cases the wiki source text is downloaded. In case of ExpandedTemplates the templates are also expanded by mediawiki running on the wiki website -}

load :: RunMode -> ImperativeMonad String
load theRunMode
  = do st <- get
       case theRunMode of
           HTML -> loadHTML st
           Book -> loadBook st Nothing
           UserTemplateFile _ -> loadPlain st Nothing
           StandardTemplates -> loadPlain st Nothing
           ExpandedTemplates -> loadMediaWiki st