module Rakka.Wiki.Parser
    ( wikiPage
    )
    where

import           Data.Maybe
import           Rakka.Wiki
import           Text.ParserCombinators.Parsec


wikiPage :: Parser WikiPage
wikiPage = do xs <- many (try blockElement)
              skipMany ( comment
                         <|>
                         (newline >> return ())
                       )
              eof
              return xs


blockElement :: Parser BlockElement
blockElement = skipMany ( comment
                          <|>
                          (newline >> return ())
                        )
               >>
               ( heading
                 <|>
                 horizontalLine
                 <|>
                 listElement
                 <|>
                 leadingSpaced
                 <|>
                 paragraph
               )


heading :: Parser BlockElement
heading = foldr (<|>) pzero (map heading' [1..5])
          <?>
          "heading"
    where
      heading' :: Int -> Parser BlockElement
      heading' n = do try $ do count n (char '=')
                               notFollowedBy (char '=')
                      ws
                      x  <- notFollowedBy (char '=') >> anyChar
                      xs <- manyTill anyChar (try $ ws >> ( count n (char '=')
                                                            <?>
                                                            ("trailing " ++ take n (repeat '='))
                                                          )
                                             )
                      ws
                      eol
                      return (Heading n (x:xs))


horizontalLine :: Parser BlockElement
horizontalLine = try $ do count 4 (char '-')
                          many (char '-')
                          ws
                          eol
                          return HorizontalLine


listElement :: Parser BlockElement
listElement = listElement' [] >>= return . List
    where
      listElement' :: [Char] -> Parser ListElement
      listElement' stack
          = try $ do t  <- oneOf "*#"
                     ws
                     xs <- items (stack ++ [t])
                     return (ListElement (toType t) xs)

      -- ListItem の終了條件は、
      items :: [Char] -> Parser [ListItem]
      items stack = do xs     <- many1 inlineElement
                       nested <- option Nothing
                                 $ try $ do newline
                                            string stack
                                            listElement' stack >>= return . Just
                       rest <- items stack
                       return $ (map Right xs ++ map Left (catMaybes [nested])) : rest
                    <|>
                    (try $ do newline
                              string stack
                              ws
                              items stack
                    )
                    <|>
                    return []
{-
      items stack = do nested <- listElement' stack
                       rest   <- items stack
                       return (Left nested : rest)
                    <|>
                    do xs   <- many1 inlineElement
                       rest <- items stack
                       return (Right xs : rest)
                    <|>
                    try ( newline
                          >>
                          string stack
                          >>
                          items stack
                        )
                    <|>
                    return []
-}

      toType :: Char -> ListType
      toType '*' = Bullet
      toType '#' = Numbered


leadingSpaced :: Parser BlockElement
leadingSpaced = char ' ' >> leadingSpaced' >>= return . LeadingSpaced
    where
      leadingSpaced' :: Parser [InlineElement]
      leadingSpaced' = do x  <- inlineElement
                          xs <- leadingSpaced'
                          return (x:xs)
                       <|>
                       try ( newline
                             >>
                             char ' '
                             >>
                             leadingSpaced'
                             >>=
                             return . (Text "\n" :)
                           )
                       <|>
                       return []


blockTag :: Parser BlockElement
blockTag = pzero -- not implemented


paragraph :: Parser BlockElement
paragraph = paragraph' >>= return . Paragraph
    where
      paragraph' :: Parser [InlineElement]
      paragraph' = do x  <- inlineElement
                      xs <- try ( do newline
                                     eof
                                     return []
                                  -- \n で文字列が終はってゐたら、ここ
                                  -- で終了。
                                )
                            <|>
                            try ( do newline
                                     ((oneOf ('\n':blockSymbols) >> pzero) <|> return ())
                                     ((blockTag                  >> pzero) <|> return ())
                                     ys <- (paragraph' <|> return [])
                                     return (Text "\n" : ys)
                                  -- \n があり、その次に \n、ブロックタ
                                  -- グまたは blockSymbols があれば、
                                  -- fail して 最初の newline を讀んだ
                                  -- 所まで卷き戻す。
                                )
                            <|>
                            try paragraph'
                            -- それ以外の場合は次の inlineElement から
                            -- を讀んで見る。但し一つも無くても良い。
                            <|>
                            return [] -- 全部失敗したらここで終了。
                      return (x:xs)


inlineElement :: Parser InlineElement
inlineElement = skipMany comment
                >>
                ( try text
                  <|>
                  try pageLink
                )


text :: Parser InlineElement
text = many1 (noneOf ('\n':inlineSymbols)) >>= return . Text


pageLink :: Parser InlineElement
pageLink = do string "[["
              page     <- option Nothing 
                          (many1 (noneOf "#|]") >>= return . Just)
              fragment <- option Nothing
                          (char '#' >> many1 (noneOf "|]") >>= return . Just)
              text     <- option Nothing
                          (char '|' >> many1 (noneOf "]") >>= return . Just)

              case (page, fragment) of
                (Nothing, Nothing) -> pzero
                (_, _)             -> return ()

              string "]]"
              return $ PageLink page fragment text
           <?>
           "page link"


comment :: Parser ()
comment = (try (string "<!--") >> skipTillEnd 1)
          <?>
          "comment"
    where
      skipTillEnd :: Int -> Parser ()
      skipTillEnd level = ( (try (string "<!--") >> skipTillEnd (level + 1))
                            <|>
                            (try (string "-->") >> case level of
                                                     1 -> return ()
                                                     n -> skipTillEnd (n - 1))
                            <|>
                            (anyChar >> skipTillEnd level)
                          )


blockSymbols :: [Char]
blockSymbols = " =-*#"


inlineSymbols :: [Char]
inlineSymbols = "<["

-- white space
ws :: Parser ()
ws = skipMany ( (oneOf " \t" >> return ())
                <|>
                comment
              )

-- end of line
eol :: Parser ()
eol = ( (newline >> return ())
        <|>
        eof
      )