content: {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module Parse where
  
  import           Types
  
  
  import           Data.Functor
  import           Data.List                  (find)
  import           Data.Maybe                 (fromJust, fromMaybe, isJust,
                                               isNothing)
  import           Data.Text                  (Text)
  import qualified Data.Text                  as T
  import           Data.Void                  (Void)
  import           Text.Megaparsec
  import           Text.Megaparsec.Char
  import qualified Text.Megaparsec.Char.Lexer as L
  import           Text.Printf
  import           Text.Read
  
  type Parser = Parsec Void Text
  
  symbol :: Text -> Parser Text
  symbol = L.symbol space
  
  parseComment :: TodoParserState -> Text -> Parser TodoEntry
  parseComment state fileExtension =
    if state == ParseStateMultiLineComment
      then do
        let closingParser = symbol $ getMultiClosingForFileType fileExtension
        lineWithClosing <- optional . try $ manyTill anyChar closingParser
        lineWithOutClosing <- optional $ many anyChar
        return $ TodoBodyLine (T.pack (fromMaybe (fromJust lineWithOutClosing) lineWithOutClosing)) False (isJust lineWithClosing)
      else do
        single <- optional . try $ manyTill anyChar (symbol $ getCommentForFileType fileExtension)
        multi <-
          if isJust single
          then return Nothing
          else
            optional . try $ manyTill anyChar (symbol $ getMultiOpeningForFileType fileExtension)
        if isJust single || isJust multi
          then do
            b <- many anyChar
            return $ TodoBodyLine (T.pack b) (isJust  multi) (getMultiClosingForFileType fileExtension `T.isInfixOf` T.pack b)
          else
            fail "No open comment marker found"
  
  getCommentForFileType :: Text -> Text
  getCommentForFileType fileExtension =
    getCommentForFileTypeWithDefault singleCommentStart fileExtension
  
  getMultiClosingForFileType :: Text -> Text
  getMultiClosingForFileType fileExtension =
    getCommentForFileTypeWithDefault multiLineClose fileExtension
  
  getMultiOpeningForFileType :: Text -> Text
  getMultiOpeningForFileType fileExtension =
    getCommentForFileTypeWithDefault multiLineOpen fileExtension
  
  getCommentForFileTypeWithDefault :: (FileTypeDetails -> Maybe Text) -> Text -> Text
  getCommentForFileTypeWithDefault getter fileExtension =
      fromMaybe unkownMarker (getter =<< find (\a -> extension a == adjustedExtension) fileTypeToComment)
      where
      adjustedExtension =
          if T.isPrefixOf "." fileExtension
              then fileExtension
              else "." <> fileExtension
  
  integer :: Parser Integer
  integer = lexeme $ L.signed space L.decimal
  
      where
      lexeme :: Parser a -> Parser a
      lexeme = L.lexeme space
  
  parseAssignee :: Parser String
  parseAssignee = many (noneOf [')', '|', '='])
  
  -- TODO (avi|p=3|#cleanup) - fix and type this better
  parseDetails :: Text -> (Maybe Text, Maybe Text, [(Text, Text)], [Text])
  parseDetails toParse =
    let dataTokens = T.splitOn "|" toParse
        assigneeTo =
          find
            (\t ->
               not (T.null t) &&
               not (T.isInfixOf "=" t) && not (T.isPrefixOf "#" t))
            dataTokens
        allDetails =
          map (\[a, b] -> (a, b)) $ filter (\t -> length t == 2) $
          map (T.splitOn "=") dataTokens
        priorityVal = snd <$> find (\t -> T.strip (fst t) == "p") allDetails
        filteredDetails = filter (\t -> T.strip (fst t) /= "p") allDetails
        entryTags = filter (T.isPrefixOf "#") dataTokens
    in (assigneeTo, priorityVal, filteredDetails, entryTags)
  
  -- | parse "hard-coded" flags, and user-defined flags if any
  parseFlag :: [UserFlag] -> Parser Flag
  parseFlag = foldr (\a b -> b <|> foo a) (try parseFlagHardcoded)
    where
      foo :: UserFlag -> Parser Flag
      foo (UserFlag x) = try (symbol x $> (UF $ UserFlag x))
  
  -- | parse flags TODO, FIXME, XXX
  parseFlagHardcoded :: Parser Flag
  parseFlagHardcoded =
        try (symbol "TODO"  $> TODO )
    <|> try (symbol "FIXME" $> FIXME)
    <|>     (symbol "XXX"   $> XXX  )
  
  newtype MultineCommentEnclosing = MultineCommentEnclosing (Text, Text)
  
  data FileTypeDetails = FileTypeDetails
    { extension          :: Text
    , singleCommentStart :: Maybe Text
    , multilineEnclosing :: Maybe MultineCommentEnclosing
    }
  
  multiLineClose :: FileTypeDetails -> Maybe Text
  multiLineClose (FileTypeDetails _ _ (Just (MultineCommentEnclosing (_, b)))) = Just b
  multiLineClose _ = Nothing
  
  multiLineOpen :: FileTypeDetails -> Maybe Text
  multiLineOpen (FileTypeDetails _ _ (Just (MultineCommentEnclosing (a, _)))) = Just a
  multiLineOpen _ = Nothing
  
  enclosing :: (Text, Text) -> Maybe MultineCommentEnclosing
  enclosing = Just . MultineCommentEnclosing
  
  slashStar :: Maybe MultineCommentEnclosing
  slashStar = enclosing ("/*", "*/")
  
  fileTypeToComment :: [FileTypeDetails]
  fileTypeToComment =
    [ FileTypeDetails ".c" (Just "//") slashStar
    , FileTypeDetails ".cc" (Just "//") slashStar
    , FileTypeDetails ".clj" (Just ";;") Nothing
    , FileTypeDetails ".cpp" (Just "//") slashStar
    , FileTypeDetails ".cxx" (Just "//") slashStar
    , FileTypeDetails ".c++" (Just "//") slashStar
    , FileTypeDetails ".cs" (Just "//") slashStar
    , FileTypeDetails ".css" Nothing slashStar
    , FileTypeDetails ".ex" (Just "#") Nothing
    , FileTypeDetails ".erl" (Just "%") Nothing
    , FileTypeDetails ".go" (Just "//") slashStar
    , FileTypeDetails ".h" (Just "//") slashStar
    , FileTypeDetails ".hh" (Just "//") slashStar
    , FileTypeDetails ".hpp" (Just "//") slashStar
    , FileTypeDetails ".hs" (Just "--") (enclosing ("{-", "-}"))
    , FileTypeDetails ".html" Nothing (enclosing ("<!--", "-->"))
    , FileTypeDetails ".hxx" (Just "//") slashStar
    , FileTypeDetails ".h++" (Just "//") slashStar
    , FileTypeDetails ".java" (Just "//") slashStar
    , FileTypeDetails ".js" (Just "//") slashStar
    , FileTypeDetails ".jsx" (Just "//") slashStar
    , FileTypeDetails ".kt" (Just "//") slashStar
    , FileTypeDetails ".kts" (Just "//") slashStar
    , FileTypeDetails ".lua" (Just "--") (enclosing ("--[[", "]]"))
    , FileTypeDetails ".m" (Just "//") slashStar
    , FileTypeDetails ".php" (Just "//") slashStar
    , FileTypeDetails ".proto" (Just "//") slashStar
    , FileTypeDetails ".py" (Just "#") (enclosing ("\"\"\"", "\"\"\""))
    , FileTypeDetails ".rb" (Just "#") (enclosing ("=begin", "=end"))
    , FileTypeDetails ".rs" (Just "//") slashStar
    , FileTypeDetails ".scss" Nothing slashStar
    , FileTypeDetails ".scala" (Just "//") slashStar
    , FileTypeDetails ".sh" (Just "#") slashStar
    , FileTypeDetails ".swift" (Just "///") slashStar
    , FileTypeDetails ".ts" (Just "//") slashStar
    , FileTypeDetails ".tsx" (Just "//") slashStar
    , FileTypeDetails ".txt" (Just "") Nothing
    , FileTypeDetails ".vue" (Just "//") slashStar
    , FileTypeDetails ".yaml" (Just "#") Nothing
    ]
  
  singleLineCommentForExtension :: Text -> Maybe Text
  singleLineCommentForExtension fileExtension =
    find (\f -> extension f == fileExtension) fileTypeToComment >>= singleCommentStart
  
  multiLineOpenCommentForExtension :: Text -> Maybe Text
  multiLineOpenCommentForExtension fileExtension =
    find (\f -> extension f == fileExtension) fileTypeToComment >>=
    multilineEnclosing >>=
    (\(MultineCommentEnclosing a) -> return $ fst a)
  
  -- Higher order function returning our folder.
  fileParseFoldFn ::
    -- partial fn params
       [UserFlag]
    -> FilePath
    -- returns a fold function of:
    -> (TodoParserState, [Maybe TodoEntry])
    -> (Integer, Text)
    -> (TodoParserState, [Maybe TodoEntry])
  fileParseFoldFn userFlags file (currentLineState, pastList) (lineNum, line) =
    let parsedLine = parseMaybe (parseTodo currentLineState userFlags file lineNum) line
        newState = nextState currentLineState parsedLine in
    (newState, pastList ++ [parsedLine])
  
  nextState :: TodoParserState -> Maybe TodoEntry -> TodoParserState
  nextState _ Nothing                            = ParseStateUnknown
  nextState _ (Just (TodoBodyLine _ _ True))     = ParseStateUnknown
  nextState _ (Just (TodoBodyLine _ True False)) = ParseStateMultiLineComment
  nextState s (Just (TodoBodyLine _ False False)) = s
  nextState _ (Just (TodoEntryHead _ _ _ _ _ _ _ _ _ _ _ True False)) = ParseStateMultiLineComment
  nextState _ (Just (TodoEntryHead _ _ _ _ _ _ _ _ _ _ MultiLine _ False)) = ParseStateMultiLineComment
  nextState _ (Just TodoEntryHead {}) = ParseStateUnknown
  nextState a b = error ("No next state for " ++ show a ++ "   " ++ show b)
  
  runTodoParser :: [UserFlag] -> SourceFile -> [TodoEntry]
  runTodoParser us (SourceFile path ls) =
    let parsedTodoLines =
          foldl
            (fileParseFoldFn
            us
            path)
            (ParseStateUnknown, [])
            (zip [1 ..] ls)
        groupedTodos = foldl foldTodoHelper ([], False) (snd parsedTodoLines)
    in fst groupedTodos
  
    where
      -- fold fn to concatenate todos that a multiple, single line comments
      foldTodoHelper :: ([TodoEntry], Bool) -> Maybe TodoEntry -> ([TodoEntry], Bool)
      foldTodoHelper (todoEntries, currentlyBuildingTodoLines) maybeTodo
          -- We're not on a todo line, keep going
          | isNothing maybeTodo = (todoEntries, False)
          -- We see the start of a new todo
          | isEntryHead $ fromJust maybeTodo = (todoEntries ++ [fromJust maybeTodo], True)
          -- We a body line of a todo to concatenate to the current one
          | isBodyLine (fromJust maybeTodo) && currentlyBuildingTodoLines =
              (init todoEntries ++ [combineTodo (last todoEntries) (fromJust maybeTodo)], True)
          | otherwise = (todoEntries, False)
  
            where
              isEntryHead :: TodoEntry -> Bool
              isEntryHead TodoEntryHead {} = True
              isEntryHead _                = False
  
              isBodyLine :: TodoEntry -> Bool
              isBodyLine TodoBodyLine {} = True
              isBodyLine _               = False
  
              combineTodo :: TodoEntry -> TodoEntry -> TodoEntry
              combineTodo (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText t isOpened _) (TodoBodyLine l _ isClosed) =
                  TodoEntryHead i (b ++ [l]) a p n entryPriority f attrs entryTags entryLeadingText t isOpened isClosed
              combineTodo  (TodoBodyLine l isOpened _) (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText t _ isClosed) =
                  TodoEntryHead i (l : b) a p n entryPriority f attrs entryTags entryLeadingText t isOpened isClosed
              combineTodo (TodoBodyLine l isOpened _) (TodoBodyLine r _ isClosed) =
                TodoBodyLineCombined (l : [r]) isOpened isClosed
              combineTodo (TodoBodyLineCombined l isOpened _) (TodoBodyLine r _ isClosed) =
                TodoBodyLineCombined (l ++ [r]) isOpened isClosed
              combineTodo (TodoBodyLineCombined l isOpened _) (TodoEntryHead i b a p n entryPriority f attrs entryTags entryLeadingText t _ isClosed) =
                  TodoEntryHead i (l ++ b) a p n entryPriority f attrs entryTags entryLeadingText t isOpened isClosed
              combineTodo _ _ = error "Can't combine todoEntry of these types"
  
  getExtension :: FilePath -> Text
  getExtension path = last $ T.splitOn "." (T.pack path)
  
  stringToMaybe :: Text -> Maybe Text
  stringToMaybe t =
    if T.null t
      then Nothing
      else Just t
  
  fst4 :: (a, b, c, d) -> a
  fst4 (x, _, _, _) = x
  
  snd4 :: (a, b, c, d) -> b
  snd4 (_, x, _, _) = x
  
  thd4 :: (a, b, c, d) -> c
  thd4 (_, _, x, _) = x
  
  fth4 :: (a, b, c, d) -> d
  fth4 (_, _, _, x) = x
  
  unkownMarker :: Text
  unkownMarker = "UNKNOWN-DELIMETER-UNKNOWN-DELIMETER-UNKNOWN-DELIMETER"
  
  data TodoParserState
    = ParseStateUnknown
    | ParseStateSource
    | ParseStateSingleComment
    | ParseStateMultiLineComment deriving (Eq, Show)
  
  data LeadingTextKind = SingleLT | MultiLT | NonOpenedComment deriving (Eq, Show)
  
  takeShorter :: String -> String -> String
  takeShorter singleLeadingText multiLeadingText
    | length singleLeadingText == length multiLeadingText = ""
    | null singleLeadingText                              = multiLeadingText
    | null multiLeadingText                               = singleLeadingText
    | length singleLeadingText > length multiLeadingText  = multiLeadingText
    | length singleLeadingText < length multiLeadingText  = singleLeadingText
    | otherwise  = ""
  
  parseTodo :: TodoParserState -> [UserFlag] -> FilePath -> LineNumber -> Parser TodoEntry
  parseTodo state us path lineNum = try (parseTodoEntryHead us)
                              <|> parseComment state (getExtension path)
    where
      parseTodoEntryHead :: [UserFlag] -> Parser TodoEntry
      parseTodoEntryHead uf =
        if state == ParseStateMultiLineComment
          then do
            leadingTextMulti <- optional (try $ many spaceChar)
            parseEntryHead NonOpenedComment (fromMaybe "" leadingTextMulti)
          else do
            entryLeadingTextSingle <- optional (try (manyTill anyChar (lookAhead . prefixParserForFileType $ getExtension path)))
            entryLeadingTextMulti <-
              if isNothing entryLeadingTextSingle
              then
                optional (manyTill anyChar (lookAhead . multiPrefixParserForFileType $ getExtension path))
              else
                return Nothing
  
            commentOpenSingle <- optional . try $ prefixParserForFileType $ getExtension path
            commentOpenMulti <- optional . try $ multiPrefixParserForFileType $ getExtension path
            let leadingTextKind = case (commentOpenSingle, commentOpenMulti) of
                  (Just _, Nothing)  -> SingleLT
                  (Nothing, Just _)  -> MultiLT
                  (Nothing, Nothing) -> NonOpenedComment
                  err                -> error . printf "Error: unexpected value in leading text pattern match: %s. Please report this bug https://github.com/aviaviavi/toodles" $ show err
  
                -- select the shorter leading text, and update leadingTextKind enum accordingly
                matchingLeadingText = takeShorter (fromMaybe "" entryLeadingTextSingle) (fromMaybe "" entryLeadingTextMulti)
  
            parseEntryHead leadingTextKind matchingLeadingText
  
            where
  
            parseEntryHead leadingTextCharsKind leadingTextChars = do
              f <- parseFlag uf
              entryDetails <- optional $ try (inParens $ many (noneOf [')', '(']))
              let parsedDetails = parseDetails . T.pack <$> entryDetails
                  entryPriority = (readMaybe . T.unpack) =<< (snd4 =<< parsedDetails)
                  otherDetails = maybe [] thd4 parsedDetails
                  entryTags = maybe [] fth4 parsedDetails
              _ <- optional $ symbol "-"
              _ <- optional $ symbol ":"
              let closingParser = symbol $ getMultiClosingForFileType (getExtension path)
              lineWithClosing <- optional . try $ manyTill anyChar closingParser
              lineWithOutClosing <- optional $ many anyChar
              return $
                  TodoEntryHead
                  0
                  [T.pack (fromMaybe (fromJust lineWithOutClosing) lineWithClosing)]
                  (stringToMaybe . T.strip $ fromMaybe "" (fst4 =<< parsedDetails))
                  path
                  lineNum
                  entryPriority
                  f
                  otherDetails
                  entryTags
                  (T.pack leadingTextChars)
                  (if leadingTextCharsKind == SingleLT then SingleLine else MultiLine)
                  (leadingTextCharsKind == MultiLT)
                  (isJust lineWithClosing)
  
            inParens :: Parser a -> Parser a
            inParens = between (symbol "(") (symbol ")")
  
            prefixParserForFileType :: Text -> Parser Text
            prefixParserForFileType fileExtension = symbol . getCommentForFileType $ fileExtension
  
            multiPrefixParserForFileType :: Text -> Parser Text
            multiPrefixParserForFileType fileExtension = symbol . getMultiOpeningForFileType $ fileExtension
  