{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}

module Text.Heterocephalus.Parse.Doc where

#if MIN_VERSION_base(4,9,0)
#else
import Control.Applicative ((*>), (<*), pure)
#endif
import Control.Monad (void)
import Data.Data (Data)
import Data.Typeable (Typeable)
import Text.Parsec
       (Parsec, ParseError, SourcePos, (<|>), eof, incSourceLine, many,
        many1, optional, optionMaybe, parse, tokenPrim)
import Text.Shakespeare.Base (Deref)

import Text.Hamlet.Parse
import Text.Heterocephalus.Parse.Control (Content(..), Control(..))

data Doc = DocForall Deref Binding [Doc]
         | DocCond [(Deref, [Doc])] (Maybe [Doc])
         | DocCase Deref [(Binding, [Doc])]
         | DocContent Content
    deriving (Data, Eq, Read, Show, Typeable)

type DocParser = Parsec [Control] ()

parseDocFromControls :: [Control] -> Either ParseError [Doc]
parseDocFromControls = parse (docsParser <* eof) ""

docsParser :: DocParser [Doc]
docsParser = many docParser

docParser :: DocParser Doc
docParser = forallDoc <|> condDoc <|> caseDoc <|> contentDoc

forallDoc :: DocParser Doc
forallDoc = do
  ControlForall deref binding <- forallControlStatement
  innerDocs <- docsParser
  void endforallControlStatement
  pure $ DocForall deref binding innerDocs

condDoc :: DocParser Doc
condDoc = do
  ControlIf ifDeref <- ifControlStatement
  ifInnerDocs <- docsParser
  elseIfs <- condElseIfs
  maybeElseInnerDocs <- optionMaybe $ elseControlStatement *> docsParser
  void endifControlStatement
  let allConds = (ifDeref, ifInnerDocs) : elseIfs
  pure $ DocCond allConds maybeElseInnerDocs

caseDoc :: DocParser Doc
caseDoc = do
  ControlCase caseDeref <- caseControlStatement
  -- Ignore a single, optional NoControl statement (with whitespace that will be
  -- ignored).
  optional contentDoc
  caseOfs <- many1 $ do
    ControlCaseOf caseBinding <- caseOfControlStatement
    innerDocs <- docsParser
    pure (caseBinding, innerDocs)
  void endcaseControlStatement
  pure $ DocCase caseDeref caseOfs

contentDoc :: DocParser Doc
contentDoc = primControlStatement $ \case
  NoControl content -> Just $ DocContent content
  _ -> Nothing

condElseIfs :: DocParser [(Deref, [Doc])]
condElseIfs = many $ do
  ControlElseIf elseIfDeref <- elseIfControlStatement
  elseIfInnerDocs <- docsParser
  pure (elseIfDeref, elseIfInnerDocs)

ifControlStatement :: DocParser Control
ifControlStatement = primControlStatement $ \case
  ControlIf deref -> Just $ ControlIf deref
  _ -> Nothing

elseIfControlStatement :: DocParser Control
elseIfControlStatement = primControlStatement $ \case
  ControlElseIf deref -> Just $ ControlElseIf deref
  _ -> Nothing

elseControlStatement :: DocParser Control
elseControlStatement = primControlStatement $ \case
  ControlElse -> Just ControlElse
  _ -> Nothing

endifControlStatement :: DocParser Control
endifControlStatement = primControlStatement $ \case
  ControlEndIf -> Just ControlEndIf
  _ -> Nothing

caseControlStatement :: DocParser Control
caseControlStatement = primControlStatement $ \case
  ControlCase deref -> Just $ ControlCase deref
  _ -> Nothing

caseOfControlStatement :: DocParser Control
caseOfControlStatement = primControlStatement $ \case
  ControlCaseOf binding -> Just $ ControlCaseOf binding
  _ -> Nothing

endcaseControlStatement :: DocParser Control
endcaseControlStatement = primControlStatement $ \case
  ControlEndCase -> Just ControlEndCase
  _ -> Nothing

forallControlStatement :: DocParser Control
forallControlStatement = primControlStatement $ \case
  ControlForall deref binding -> Just $ ControlForall deref binding
  _ -> Nothing

endforallControlStatement :: DocParser Control
endforallControlStatement = primControlStatement $ \case
  ControlEndForall -> Just ControlEndForall
  _ -> Nothing

primControlStatement :: (Control -> Maybe x)-> DocParser x
primControlStatement = tokenPrim show incSourcePos

incSourcePos :: SourcePos -> a -> b -> SourcePos
incSourcePos sourcePos _ _ = incSourceLine sourcePos 1