-----------------------------------------------------------------------------
-- |
-- Module      :  Lentil.Parse.Issue
-- Copyright   :  © 2015-2016 Francesco Ariis, Michał Antkiewi
-- License     :  GPLv3 (see the LICENSE file)
--
-- Issues parsing from comments
-----------------------------------------------------------------------------

module Lentil.Parse.Issue where

import Lentil.Types

import Text.Parsec

import Control.Applicative hiding ( (<|>), optional, many )

import qualified Data.Char as C
import qualified Data.String as S

import Prelude -- 7.8 hack


-----------
-- TYPES --
-----------

type ParIssue a = Parsec String () a

-- TODO: "feature" flagword could (in theory) clash with a free-text comment
--       (if it is present in the middle of a sentence at the beginning
--       of a line). Consider alternatives (as: making new words
--       configurable in .lentil dotfile. After checking the linux
--       kernel, it definitely is. Erase it and possibly make it
--       an option [design] [u:3] [bug]

-- issue flagword
data FlagWord = Todo | Fixme | Xxx deriving (Enum, Eq)


instance Show FlagWord where
  show Todo    = "todo"
  show Fixme   = "fixme"
  show Xxx     = "xxx"
  -- show Feature = "feature"

-- top-level constant to evaluate once
flagWords :: [String]
flagWords = map show (enumFrom Todo)

instance S.IsString FlagWord where
  fromString s = case map C.toLower s of
    "todo"    -> Todo
    "fixme"   -> Fixme
    "xxx"     -> Xxx
    -- "feature" -> Feature
    e         -> error ("unrecognised flag word: " ++ e)


---------------
-- PRIMITIVE --
---------------

-- a unix file is defined as many lines (each one ended by '\n')
-- this parser captures the definition and can be used as eof replacement too
eoft :: ParIssue ()
eoft = optional (char '\n') *> eof

-- case insensitive string, lifted from Text.ParserCombinators.Parsec.Rfc2234
ciString :: String -> ParIssue String
ciString s = mapM ciChar s <?> "case insensitive string"
    where ciChar :: Char -> ParIssue Char
          ciChar c = char (C.toLower c) <|> char (C.toUpper c)

-- i.e. remove unneeded whitespace
htmlify :: String -> String
htmlify cs = unwords . words $ cs

-- a blank line of text (even at eof)
blankline :: ParIssue ()
blankline = char '\n' *> (() <$ char '\n' <|> eof)
-- blankline = () <$ string "\n\n"


----------
-- TAGS --
----------

-- simple tags parsing

-- tag only
tag :: ParIssue Tag
tag = Tag <$> (openPar *> tagLabel <* closePar) <?> "tag"

-- anything goes, apart from ' '
tagLabel :: ParIssue String
tagLabel = many1 (satisfy sf) <?> "tag label"
    where sf :: Char -> Bool
          sf c | c == closeDel = False
               | C.isSpace c   = False
               | otherwise     = True

openPar, closePar :: ParIssue Char
openPar  = char openDel  <?> "open-tag delimiter"
closePar = char closeDel <?> "close-tag delimiter"


-------------
-- INCIPIT --
-------------

-- optional ws + flagwords (case unsensitive) + optional ':' ++ optional1 ws
-- incipit have to be bound at the beginning of line (won't pick up stuff
-- in the middle of a sentence)
incipit :: ParIssue FlagWord
incipit = char '\n' >> spaces    >>
          fwpar                  >>= \fw ->
          optional (char ':')    >>
          notFollowedBy alphaNum >> -- real todo, not todoodle
          return fw
          <?> "incipit"
    where
          fwpar = choice (map (try . ciString) flagWords) >>=
                  return . S.fromString


------------
-- ISSUES --
------------

-- simple issue parsing

-- an issue is a flagword, followed by : , followed by some description and
-- ended optionally by some tags (No t/f? End by whiteline or eof or
-- another TODO).
-- tags can be placed *before* description, too
issue :: ParIssue Issue
issue = (mkIssue <$> incipit
                 <*> fmap sourceName getPosition
                 <*> fmap sourceLine getPosition
                 <*> option [] (try tags)
                 <*> freeText
                 <*> option [] (try tags))
        <?> "issue"
    where
          mkIssue fw fp ln tg1 ds tg2 = Issue fp ln ds (addTag fw (tg1++tg2))

          addTag Todo tgs = tgs
          addTag fw   tgs = (Tag $ show fw) : tgs



-- any text. Since tags/fields at the end of the issue are optional, we need
-- a way to delimit this. Delimiters are: eof, tags/fields, blank line
freeText :: ParIssue (Maybe Description)
freeText = fmap htmlify (manyTill anyChar end) >>= \t ->
           case t of
             [] -> return Nothing
             _  -> return $ Just t

         <?> "free text"
    where vp p      = try . parsecMap (const ()) $ p
          end       = lookAhead $ choice [vp (spaces1 *> tag),
                                          vp blankline, -- \n\n or \neof
                                          vp incipit,   -- another issue
                                          vp eof]
          spaces1 = space *> spaces

tags :: ParIssue [Tag]
tags = many1 (try $ spaces *> tag) <?> "tags"


-- parses a number of issues from a given line-of-text
issues :: ParIssue [Issue]
issues = many (try $ manyTill anyChar (lookAhead $ try incipit) *> issue)
         <?> "issues"