{-# LANGUAGE CPP #-}
{-
Copyright (C) 2009 John MacFarlane <jgm@berkeley.edu>

This program is free software; you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
the Free Software Foundation; either version 2 of the License, or
(at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}

{- Functions for translating between Page structures and raw
-  text strings.  The strings may begin with a metadata block,
-  which looks like this (it is valid YAML):
-
-  > ---
-  > title: Custom Title
-  > format: markdown+lhs
-  > toc: yes
-  > categories: foo bar baz
-  > ...
-
-  This would tell gitit to use "Custom Title" as the displayed
-  page title (instead of the page name), to interpret the page
-  text as markdown with literate haskell, to include a table of
-  contents, and to include the page in the categories foo, bar,
-  and baz.
-
-  The metadata block may be omitted entirely, and any particular line
-  may be omitted. The categories in the @categories@ field should be
-  separated by spaces. Commas will be treated as spaces.
-
-  Metadata value fields may be continued on the next line, as long as
-  it is nonblank and starts with a space character.
-
-  Unrecognized metadata fields are simply ignored.
-}

module Network.Gitit.Page ( stringToPage
                          , pageToString
                          , readCategories
                          )
where
import Network.Gitit.Types
import Network.Gitit.Util (trim, splitCategories, parsePageType)
import Text.ParserCombinators.Parsec
import Data.Char (toLower)
import Data.ByteString.UTF8 (toString)
import qualified Data.ByteString as B
import qualified Data.ByteString.Char8 as BC
import System.IO (withFile, Handle, IOMode(..))
import Prelude hiding (catch)
import Control.Exception (catch, throwIO)
import System.IO.Error (isEOFError)
#if MIN_VERSION_base(4,5,0)
#else
import Codec.Binary.UTF8.String (encodeString)
#endif

parseMetadata :: String -> ([(String, String)], String)
parseMetadata raw =
  case parse pMetadataBlock "" raw of
    Left _           -> ([], raw)
    Right (ls, rest) -> (ls, rest)

pMetadataBlock :: GenParser Char st ([(String, String)], String)
pMetadataBlock = try $ do
  _ <- string "---"
  _ <- pBlankline
  ls <- many pMetadataLine
  _ <- string "..."
  _ <- pBlankline
  skipMany pBlankline
  rest <- getInput
  return (ls, rest)

pBlankline :: GenParser Char st Char
pBlankline = try $ many (oneOf " \t") >> newline

pMetadataLine :: GenParser Char st (String, String)
pMetadataLine = try $ do
  first <- letter
  rest <- many (letter <|> digit <|> oneOf "-_")
  let ident = first:rest
  skipMany (oneOf " \t")
  _ <- char ':'
  rawval <- many $ noneOf "\n\r"
                 <|> (try $ newline >> notFollowedBy pBlankline >>
                            skipMany1 (oneOf " \t") >> return ' ')
  _ <- newline
  return (ident, trim rawval)

-- | Read a string (the contents of a page file) and produce a Page
-- object, using defaults except when overridden by metadata.
stringToPage :: Config -> String -> String -> Page
stringToPage conf pagename raw =
  let (ls, rest) = parseMetadata raw
      page' = Page { pageName        = pagename
                   , pageFormat      = defaultPageType conf
                   , pageLHS         = defaultLHS conf
                   , pageTOC         = tableOfContents conf
                   , pageTitle       = pagename
                   , pageCategories  = []
                   , pageText        = filter (/= '\r') rest
                   , pageMeta        = ls }
  in  foldr adjustPage page' ls

adjustPage :: (String, String) -> Page -> Page
adjustPage ("title", val) page' = page' { pageTitle = val }
adjustPage ("format", val) page' = page' { pageFormat = pt, pageLHS = lhs }
    where (pt, lhs) = parsePageType val
adjustPage ("toc", val) page' = page' {
  pageTOC = map toLower val `elem` ["yes","true"] }
adjustPage ("categories", val) page' =
   page' { pageCategories = splitCategories val ++ pageCategories page' }
adjustPage (_, _) page' = page'

-- | Write a string (the contents of a page file) corresponding to
-- a Page object, using explicit metadata only when needed.
pageToString :: Config -> Page -> String
pageToString conf page' =
  let pagename   = pageName page'
      pagetitle  = pageTitle page'
      pageformat = pageFormat page'
      pagelhs    = pageLHS page'
      pagetoc    = pageTOC page'
      pagecats   = pageCategories page'
      metadata'  = (if pagename /= pagetitle
                       then "!title: " ++ pagetitle ++ "\n"
                       else "") ++
                   (if pageformat /= defaultPageType conf ||
                          pagelhs /= defaultLHS conf
                       then "!format: " ++
                            map toLower (show pageformat) ++
                            if pagelhs then "+lhs\n" else "\n"
                       else "") ++
                   (if pagetoc /= tableOfContents conf
                       then "!toc: " ++
                            (if pagetoc then "yes" else "no") ++ "\n"
                       else "") ++
                   (if not (null pagecats)
                       then "!categories: " ++ unwords pagecats ++ "\n"
                       else "")
  in  metadata' ++ (if null metadata' then "" else "\n") ++ pageText page'

-- | Read categories from metadata strictly.
readCategories :: FilePath -> IO [String]
readCategories f =
#if MIN_VERSION_base(4,5,0)
  withFile f ReadMode $ \h ->
#else
  withFile (encodeString f) ReadMode $ \h ->
#endif
    catch (do fl <- B.hGetLine h
              if dashline fl
                 then do -- get rest of metadata
                   rest <- hGetLinesTill h dotline
                   let (md,_) = parseMetadata $ unlines $ "---":rest
                   return $ concatMap (splitCategories . snd)
                          $ filter (("categories"==) . fst) md
                 else return [])
       (\e -> if isEOFError e then return [] else throwIO e)

dashline :: B.ByteString -> Bool
dashline x =
  case BC.unpack x of
       ('-':'-':'-':xs) | all (==' ') xs -> True
       _ -> False

dotline :: B.ByteString -> Bool
dotline x =
  case BC.unpack x of
       ('.':'.':'.':xs) | all (==' ') xs -> True
       _ -> False

hGetLinesTill :: Handle -> (B.ByteString -> Bool) -> IO [String]
hGetLinesTill h end = do
  next <- B.hGetLine h
  if end next
     then return [toString next]
     else do
       rest <- hGetLinesTill h end
       return (toString next:rest)
