--
-- ConfigParser
-- Copyright (C) 2014 Ivan Cukic <ivan.cukic@kde.org>
--
-- Distributed under terms of the GPLv3 license.
--

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE LambdaCase #-}

module ConfigParser (
        Document
      , Statement(Include, Section)
      , Item(Item)
      , getGlobalSectionBody
      , getSectionBody
      , getSections
      , getValueFor
      , getValuesFor
      , parseFile
      , parseString
      , prettyPrint
      )
where

import Data.List (find)
import Data.Maybe

import qualified Text.ParserCombinators.Parsec as P
import qualified Text.ParserCombinators.Parsec.Token as T
import qualified Text.ParserCombinators.Parsec.Language as L

import Text.Parsec ((<|>), (<?>))
import Control.Monad (liftM)

import Debug.Trace

import qualified StringListParser as SL

-----------------------------------------------------------------------
-- Interface ----------------------------------------------------------
-----------------------------------------------------------------------

-- | Represents a configuration file
type Document = [Statement]

-- | The document is divided into sections, but also supports
-- | top-level includes
data Statement =
        Include String               -- what to import
      | Section String String [Item] -- type, payload, items
    deriving (Show, Eq)

-- | Key-value pair
data Item =
        Item String String           -- key value
    deriving (Show, Eq)


-- | Parses the input kdesrc-formatted file
parseString :: String -> IO (Maybe Document)
parseString input = do
        let result = P.parse parser "" input
        -- result <- P.parse parser "" input
        return ( case result of
                    Left err ->
                        trace ("Error parsing:" ++ show err) Nothing
                    Right (document, _) ->
                        Just document
               )


-- | Parses the specified file
parseFile :: String -> IO (Maybe Document)
parseFile filepath =
        readFile filepath >>= parseString


-- | Pretty printing for the document
prettyPrint :: Document -> String
prettyPrint document = unlines $ map ( \case
        Include file ->
            "include " ++ file
        Section sType sPayload sItems ->
            "section: " ++ sType ++ " (" ++ sPayload ++ ")\n" ++
                unlines (
                    map (\case Item key value -> "    " ++ key ++ " = " ++ value) sItems
                )
        ) document


-- | Returns items for a specified section
getSectionBody :: String -> String -> Document -> Maybe [Item]
getSectionBody sType sPayload document =
        listToMaybe $
        map ( \case
            Section _ _ i -> i
            Include _ -> []
        ) $
        filter ( \case
            Section t p _ -> sType == t && sPayload == p
            Include _ -> False
        )
        document


-- | Returns items for a specified section
getSections :: String -> Document -> [String]
getSections sType document =
        map ( \case
            Section _ p _ -> p
            Include _ -> []
        ) $
        filter ( \case
            Section t _ _ -> sType == t
            Include _ -> False
        )
        document


-- | Gets the global section
getGlobalSectionBody :: Document -> Maybe [Item]
getGlobalSectionBody = getSectionBody "global" ""


-- | Gets a value for the specified section and key
getValueFor :: String -> [Item] -> Maybe String
getValueFor key section = -- (.) listToMaybe . getValuesFor
        fmap (\case Item _ v -> v) $
        find (\case Item k _ -> key == k)
        section


-- | Gets a value for the specified section and key
getValuesFor :: String -> [Item] -> [String]
getValuesFor input items =
        case result of
            Nothing -> []
            Just value -> SL.parseString value
        where
            result = getValueFor input items

-----------------------------------------------------------------------
-- Language -----------------------------------------------------------
-----------------------------------------------------------------------

-- | The language definition. We are using some basics from here,
-- | but the most of our tokenization is custom
languageDef :: L.LanguageDef st
languageDef = L.emptyDef {
                T.commentStart = "#--"
              , T.commentEnd = "--#"
              , T.commentLine = "#"
              , T.identStart = P.alphaNum
              , T.identLetter = P.alphaNum <|> P.char '-' <|> P.char '_'
              , T.reservedNames = [
                                    "global"
                                  , "module-set"
                                  , "module"
                                  , "build-profile"
                                  , "end"
                                  ]
              , T.reservedOpNames = []
              , T.opStart = fail "no operators"
              , T.opLetter = fail "no operators"
              }


-- | Get the tokenizer defaults
lexer :: T.TokenParser ()
lexer = T.makeTokenParser languageDef


-- | Language identifier
identifier :: P.Parser String
identifier = T.identifier lexer


-- | A reserved keyword
reserved :: String -> P.Parser ()
reserved s = spaces NoNewline >> P.string s >> spaces NoNewline >> return ()


-- | Parses the document, and returns the unparsed part of the input.
-- | Useful for debugging
parser :: P.Parser (Document, String)
parser = do
        document <- documentParser
        rest <- P.many P.anyChar
        return (document, rest)


-- | Parses the document
documentParser :: P.Parser Document
documentParser = do
        statements <- P.many (spaces AllWhitespace >> statement)
        return $ catMaybes statements


-- | Parses the document statement
statement :: P.Parser (Maybe Statement)
statement = (comment >> return Nothing)
        <|> liftM Just includeStatement
        <|> liftM Just sectionStatement


-- | Matches the include statement. Returns the path to the included file.
includeStatement :: P.Parser Statement
includeStatement = do
        reserved "include"
        what <- restOfLine
        return $ Include what


-- | Matches the section
sectionStatement :: P.Parser Statement
sectionStatement = do
        (section, payload) <- sectionStart
        items <- sectionBody
        _ <- sectionEnd
        return $ Section section payload $ catMaybes items


-- | Matches a start of a module/module-set/global/build-profile section
sectionStart :: P.Parser (String, String)
sectionStart = do
        section <- sectionStartHead
        payload <- restOfLine
        return (section, payload)


-- | Matches the keyword that starts the section
sectionStartHead :: P.Parser String
sectionStartHead = (reserved "global"        >> return "global")
               <|> (reserved "module"        >> return "module")
               <|> (reserved "module-set"    >> return "module-set")
               <|> (reserved "build-profile" >> return "build-profile")


-- | Matches the end of a section, ignores the rest of the line
sectionEnd :: P.Parser String
sectionEnd = do
        _ <- reserved "end"
        restOfLine


-- | Matches section items
sectionBody :: P.Parser [Maybe Item]
sectionBody = P.many $
                liftM Just sectionItem
            <|> (comment >> return Nothing)


-- | Matches a key-value pair of a section item
sectionItem :: P.Parser Item
sectionItem = do
        key <- identifier
        value <- restOfLine
        return $ Item key value


-----------------------------------------------------------------------
-- Utility functions --------------------------------------------------
-----------------------------------------------------------------------

-- | Function reads and returns the rest of the current line.
-- | It supports escaping eol using a back-slash. The escaped
-- | eol is replaced with a ' '
restOfLine :: P.Parser String
restOfLine = do
        line <- P.many (
                        P.noneOf "\n\r\\"
                    <|> P.try ( P.string "\\\n" >> spaces NoNewline >> return ' ' )
                    <|> P.char '\\'
                    <?> "The rest of the line"
            )
        _ <- spaces AllWhitespace
        return line


-- | Skips the hash-based line comment
comment:: P.Parser ()
comment = do
        _ <- P.char '#'
        _ <- restOfLine
        return ()


-- | Different types of whitespace
data WhitespaceType = NoNewline | Newline | AllWhitespace


-- | Skips a space character
space :: WhitespaceType -> P.Parser Char
space NoNewline = P.char ' '
              <|> P.char '\t'
              <?> "space, no newline"

space Newline   = P.try (P.string "\n\r" >> return '\n')
              <|> P.try (P.string "\r\n" >> return '\n')
              <|> P.char '\n'
              <|> P.char '\r'
              <?> "end of line"

space _         = space NoNewline
              <|> space Newline
              <?> "whitespace including newline"


-- | Skips many space characters, but only those specified
spaces :: WhitespaceType -> P.Parser String
spaces wst = do
        ss <- P.many $ space wst
        return $ take 1 ss