{-# LANGUAGE OverloadedStrings #-}

module MdBlocks.Parser
  ( parseFile
  )
where

import qualified Data.Text as T
import Data.Text (Text)

import MdBlocks.Metadata
import MdBlocks.Types


data State
  = Normal
  | InFence FenceState
  | InIndented IndentedState

data FenceState = FenceState
  { fsStartLine :: !Int
  , fsFenceTok  :: !Text
  , fsHeader    :: !Text
  , fsLines     :: [Text]
  }

data IndentedState = IndentedState
  { isStartLine :: !Int
  , isLines     :: [Text]
  }

data ParseState = ParseState
  { psFile   :: FilePath
  , psMode   :: State
  , psBlocks :: [Block]
  }


parseFile
  :: FilePath
  -> Text
  -> [Block]
parseFile fp txt =
    assignNumbers
  $ finalize
  $ foldl step initial numbered
  where
    numbered =
      zip [1..] (T.lines txt)

    initial =
      ParseState
        { psFile = fp
        , psMode = Normal
        , psBlocks = []
        }


assignNumbers :: [Block] -> [Block]
assignNumbers =
  zipWith
    (\n b -> b { blockNumber = n })
    [1..]


isIndented :: Text -> Bool
isIndented =
  ("    " `T.isPrefixOf`)

stripIndent :: Text -> Text
stripIndent =
  T.drop 4


fenceStart :: Text -> Maybe (Text, Text)
fenceStart line =
  let s = T.stripStart line
  in if "```" `T.isPrefixOf` s
       then Just ("```", T.drop 3 s)
       else Nothing


fenceEnd :: Text -> Text -> Bool
fenceEnd marker line =
    marker `T.isPrefixOf`
      T.stripStart line


step
  :: ParseState
  -> (Int, Text)
  -> ParseState

step st@(ParseState _ Normal _) (ln,txt)

  | Just (marker,hdr) <- fenceStart txt =
      st
        { psMode =
            InFence
              FenceState
                { fsStartLine = ln
                , fsFenceTok  = marker
                , fsHeader    = T.strip hdr
                , fsLines     = []
                }
        }

  | isIndented txt =
      st
        { psMode =
            InIndented
              IndentedState
                { isStartLine = ln
                , isLines =
                    [stripIndent txt]
                }
        }

  | otherwise =
      st

step st@(ParseState fp (InFence fs) acc) (ln,txt)

  | fenceEnd (fsFenceTok fs) txt =
      st
        { psMode = Normal
        , psBlocks =
            mkFenceBlock fp fs ln
            : acc
        }

  | otherwise =
      st
        { psMode =
            InFence
              fs
                { fsLines =
                    txt : fsLines fs
                }
        }

step st@(ParseState fp (InIndented is) acc) current@(ln,txt)

  | isIndented txt =
      st
        { psMode =
            InIndented
              is
                { isLines =
                    stripIndent txt
                    : isLines is
                }
        }

  | otherwise =
      let block =
            mkIndentedBlock
              fp
              is
              (ln - 1)

          reset =
            st
              { psMode = Normal
              , psBlocks = block : acc
              }

      in step reset current


finalize :: ParseState -> [Block]

finalize (ParseState _ Normal xs) =
  reverse xs

finalize (ParseState fp (InFence fs) xs) =
  reverse
    ( mkFenceBlock fp fs (fsStartLine fs)
    : xs
    )

finalize (ParseState fp (InIndented is) xs) =
  reverse
    ( mkIndentedBlock fp is (isStartLine is)
    : xs
    )


mkFenceBlock
  :: FilePath
  -> FenceState
  -> Int
  -> Block
mkFenceBlock fp fs endLine =
  Block
    { blockFile    = fp
    , blockNumber  = 0
    , blockKind    = Fenced
    , blockMeta    = meta
    , blockStart   = fsStartLine fs
    , blockEnd     = endLine
    , blockContent = body
    }
  where
    body =
      T.unlines
        (reverse (fsLines fs))

    meta =
      parseMetadataLine
        ("@" <> fsHeader fs)


mkIndentedBlock
  :: FilePath
  -> IndentedState
  -> Int
  -> Block
mkIndentedBlock fp is endLine =
  Block
    { blockFile    = fp
    , blockNumber  = 0
    , blockKind    = Indented
    , blockMeta    = meta
    , blockStart   = isStartLine is
    , blockEnd     = endLine
    , blockContent = code
    }
  where
    raw =
      T.unlines
        (reverse (isLines is))

    (meta, code) =
      splitIndentedMetadata raw


splitIndentedMetadata
  :: Text
  -> (Metadata, Text)
splitIndentedMetadata txt =
  case T.lines txt of

    [] ->
      (emptyMetadata, "")

    firstLine : rest
      | "@" `T.isPrefixOf` firstLine ->
          ( parseMetadataLine firstLine
          , T.unlines rest
          )

      | otherwise ->
          ( emptyMetadata
          , txt
          )