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 Data.List
import Control
.Monad (when
)
data Content
= Title
String Content
| EOC -- End of Content
{- MAIN PART -}
-- Takes care of file handle, function that is run with .exe
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 [] = []
safeHTML ('&':s) = "&" ++ safeHTML s
safeHTML ('<':s) = "<" ++ safeHTML s
safeHTML ('>':s) = ">" ++ safeHTML s
safeHTML ( c :s) = c : safeHTML s
{- GOOD TO HAVE FUNCTIONS PART -}
-- Removes whitespace on both sides of string
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 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 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 = 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 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 s1 s2 = s1 ++ " -|- " ++ s2 ++ "<br />"
-- Prints title
printTitle web title = pF web $ "<h1>" ++ title ++ "</h1>"