module Main where
 
{-
    Parses rAthenas script_commands.txt and builds a HTML page from it
    
    If you want to add types, you need to change
    - Content data type
    - addContent function
    - parseContent function
    - printContent function
    - Add a function which gives the layout
    
    If you want to change how anything is viewed, go to the bottom and
     change p<Type>
-}
 
import System.IO
import Data.List
import Data.Char
import Control.Monad    (when)
 
data Content = Title String Content
             | Text  String Content
             | Code  String Content
             | Desc  String Content
             | Def String String Content
             | EOC -- End of Content
  deriving (Eq, Show)
 
  
{- MAIN PART -}
 
-- Takes care of file handle, function that is run with .exe
main :: IO ()
main = do doc <- openFile "script_commands.txt" ReadMode
          web <- openFile "script_commands.html" WriteMode
          
          hSetEncoding doc utf8_bom
          hSetEncoding web utf8_bom
          contentStr <- hGetContents doc
          let content = lines $ safeHTML contentStr
          
          let (about, rest) = toNextTitle content
          printTitle web "rAthena Script Documentation"
          printContent web $ foldr addContent EOC $ map (\x->(Text x EOC)) about
          
          parse web rest
          putStrLn "Done parsing 'script_commands.txt'"
          hClose web
          hClose doc
          
-- Escapes HTML signs so they are visible as text
safeHTML :: String -> String
safeHTML []      = []
safeHTML ('&':s) = "&amp;" ++ safeHTML s
safeHTML ('<':s) = "&lt;"  ++ safeHTML s
safeHTML ('>':s) = "&gt;"  ++ safeHTML s
safeHTML ( c :s) = c        : safeHTML s
          
          
{- GOOD TO HAVE FUNCTIONS PART -}
 
-- Removes whitespace on both sides of string
clean :: String -> String
clean = reverse . clean' . reverse . clean'
  where clean' = dropWhile (\x -> x == ' ' || x == '\t')
  
-- Adds Content, in the order given
addContent :: Content -> Content -> Content
addContent EOC end = end
addContent (Title s content) end = Title s $ addContent content end
addContent (Text  s content) end = Text  s $ addContent content end
addContent (Code  s content) end = Code  s $ addContent content end
addContent (Desc  s content) end = Desc  s $ addContent content end
addContent (Def s1 s2 content) end = Def s1 s2 $ addContent content end
 
-- Gets all content to the next title
-- A title is the line above a line made of arbita '-------'
toNextTitle :: [String] -> ([String],[String])
toNextTitle c = (take (delimPos - 1) c, drop (delimPos - 1) c)
  where checkDelim r = [] /= (filter (/='-') . clean . sort) r || clean r == []
        delimPos = length $ takeWhile (checkDelim) c
 
 
{- PARSING PART -}
 
-- Function that reads content and parses what it gets
parse :: Handle -> [String] -> IO ()
parse web []         = return ()                                   -- Near EOF
parse web (s:[])     = printContent web $ parseContent [s]         -- Near EOF
parse web (s1:s2:[]) = printContent web $ parseContent $ s1:[s2]   -- Near EOF
parse web (s:d:c) = do when (or $ map isAlpha s) $ printTitle web s -- Print the title
                       let (content, rest) = toNextTitle c          -- Get the content
                       printContent web $ parseContent content      -- Parse and print the content
                       parse web rest   --^ Recursive call
 
-- Converts text to the different Content types
parseContent :: [String] -> Content
parseContent []    = EOC
parseContent t@(s:c)
  | clean s == []    = Text s EOC `addContent` parseContent c
  | take 2 s == "**" = Title (drop 2 s) EOC `addContent` parseContent c
  | head s == '*'    = Code (tail s) EOC `addContent` parseContent c
  | take 4 s == "    " = Desc (drop 4 s) EOC `addContent` parseContent c
  | otherwise        = Text s EOC `addContent` parseContent c
  
{- PRINTING PART -}
 
-- Print string to file
pF :: Handle -> String -> IO ()
pF = hPutStrLn
 
-- Handles the type of print and calls the right function
printContent :: Handle -> Content -> IO ()
printContent _ EOC = return ()
printContent web (Title s c)   = do pF web $ pTitle s;   printContent web c
printContent web (Text s c)    = do pF web $ pText s;    printContent web c
printContent web (Code s c)    = do pF web $ pCode s;    printContent web c
printContent web (Desc s c)    = do pF web $ pDesc s;    printContent web c
printContent web (Def s1 s2 c) = do pF web $ pDef s1 s2; printContent web c
 
-- Print with 1 parameter
pTitle, pText, pCode, pDesc :: String -> String
pTitle s = "<b>" ++ s ++ "</b><br />"
pText  s = s ++ "<br />"
pCode  s = "<font color=\"#FF0000\">" ++ s ++ "</font><br />"
pDesc  s = "<font color=\"#CCCCCC\">" ++ s ++ "</font><br />"
 
-- Print with 2 parameters
pDef :: String -> String -> String
pDef s1 s2 = s1 ++ " -|- " ++ s2 ++ "<br />"
 
-- Prints title
printTitle :: Handle -> String -> IO ()
printTitle web title = pF web $ "<h1>" ++ title ++ "</h1>"