content: {-# 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
  