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
                                                     [("&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)))
 
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