{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
module Language.Haskell.Brittany.Internal.Components.BriDoc where

import Language.Haskell.Brittany.Internal.Prelude

import Data.Generics.Uniplate.Direct as Uniplate
import qualified Data.Data
import GHC (RealSrcLoc, LEpaComment)



-- isomorphic to BriDocF Identity. Provided for ease of use, as we do a lot
-- of transformations on `BriDocF Identity`s and it is really annoying to
-- `Identity`/`runIdentity` everywhere.
data BriDoc
  = -- BDWrapAnnKey AnnKey BriDoc
    BDEmpty
  | BDLit !Text
  | BDSeq [BriDoc] -- elements other than the last should
                   -- not contains BDPars.
  | BDCols ColSig [BriDoc] -- elements other than the last
                         -- should not contains BDPars
  | BDSeparator -- semantically, space-unless-at-end-of-line.
  | BDAddBaseY BrIndent BriDoc
  | BDBaseYPushCur BriDoc
  | BDBaseYPop BriDoc
  | BDIndentLevelPushCur BriDoc
  | BDIndentLevelPop BriDoc
  | BDPar
    { _bdpar_indent :: BrIndent
    , _bdpar_restOfLine :: BriDoc -- should not contain other BDPars
    , _bdpar_indented :: BriDoc
    }
  -- | BDAddIndent BrIndent (BriDocF f)
  -- | BDNewline
  | BDAlt [BriDoc]
  | BDForwardLineMode BriDoc
  | BDExternal -- AnnKey
               -- (Set AnnKey) -- set of annkeys contained within the node
               --              -- to be printed via exactprint
               Bool -- should print extra comment ?
               Text
  | BDPlain !Text -- used for QuasiQuotes, content can be multi-line
                  -- (contrast to BDLit)
  | BDQueueComments [LEpaComment] BriDoc
      -- queue to be later flushed when the markers are reached
  | BDFlushCommentsPrior RealSrcLoc BriDoc
      -- process comments before loc from the queue
  | BDFlushCommentsPost RealSrcLoc BriDoc
      -- process comments before loc from the queue, but flow to end of
      -- child-nodes
  | BDLines [BriDoc]
  | BDEnsureIndent BrIndent BriDoc
  -- the following constructors are only relevant for the alt transformation
  -- and are removed afterwards. They should never occur in any BriDoc
  -- after the alt transformation.
  | BDForceMultiline BriDoc
  | BDForceSingleline BriDoc
  | BDNonBottomSpacing Bool BriDoc
  | BDSetParSpacing BriDoc
  | BDForceParSpacing BriDoc
  -- pseudo-deprecated
  | BDDebug String BriDoc
  deriving (Data.Data.Data, Eq, Ord)

data BriDocF f
  = -- BDWrapAnnKey AnnKey BriDoc
    BDFEmpty
  | BDFLit !Text
  | BDFSeq [f (BriDocF f)] -- elements other than the last should
                   -- not contains BDPars.
  | BDFCols ColSig [f (BriDocF f)] -- elements other than the last
                         -- should not contains BDPars
  | BDFSeparator -- semantically, space-unless-at-end-of-line.
  | BDFAddBaseY BrIndent (f (BriDocF f))
  | BDFBaseYPushCur (f (BriDocF f))
  | BDFBaseYPop (f (BriDocF f))
  | BDFIndentLevelPushCur (f (BriDocF f))
  | BDFIndentLevelPop (f (BriDocF f))
  | BDFPar
    { _bdfpar_indent :: BrIndent
    , _bdfpar_restOfLine :: f (BriDocF f) -- should not contain other BDPars
    , _bdfpar_indented :: f (BriDocF f)
    }
  -- | BDAddIndent BrIndent (BriDocF f)
  -- | BDNewline
  | BDFAlt [f (BriDocF f)]
  | BDFForwardLineMode (f (BriDocF f))
  | BDFExternal -- AnnKey
                -- (Set AnnKey) -- set of annkeys contained within the node
                --              -- to be printed via exactprint
                Bool -- should print extra comment ?
                Text
  | BDFPlain !Text -- used for QuasiQuotes, content can be multi-line
                   -- (contrast to BDLit)
  | BDFQueueComments [LEpaComment] (f (BriDocF f))
      -- ^ true = comments will be left in the queue when the node is left
  | BDFFlushCommentsPrior RealSrcLoc (f (BriDocF f))
      -- process comments before loc from the queue
  | BDFFlushCommentsPost RealSrcLoc (f (BriDocF f))
      -- process comments before loc from the queue, but flow to end of
      -- child-nodes
  | BDFLines [(f (BriDocF f))]
  | BDFEnsureIndent BrIndent (f (BriDocF f))
  | BDFForceMultiline (f (BriDocF f))
  | BDFForceSingleline (f (BriDocF f))
  | BDFNonBottomSpacing Bool (f (BriDocF f))
  | BDFSetParSpacing (f (BriDocF f))
  | BDFForceParSpacing (f (BriDocF f))
  | BDFDebug String (f (BriDocF f))

data BrIndent = BrIndentNone
              | BrIndentRegular
              | BrIndentSpecial Int
  deriving (Eq, Ord, Data.Data.Data, Show)

-- deriving instance Data.Data.Data (BriDocF Identity)
deriving instance Data.Data.Data (BriDocF ((,) Int))

type BriDocFInt = BriDocF ((,) Int)
type BriDocNumbered = (Int, BriDocFInt)

instance Uniplate.Uniplate BriDoc where
  uniplate x@BDEmpty{}               = plate x
  uniplate x@BDLit{}                 = plate x
  uniplate (BDSeq list     )         = plate BDSeq ||* list
  uniplate (BDCols sig list)         = plate BDCols |- sig ||* list
  uniplate x@BDSeparator             = plate x
  uniplate (BDAddBaseY ind bd      ) = plate BDAddBaseY |- ind |* bd
  uniplate (BDBaseYPushCur       bd) = plate BDBaseYPushCur |* bd
  uniplate (BDBaseYPop           bd) = plate BDBaseYPop |* bd
  uniplate (BDIndentLevelPushCur bd) = plate BDIndentLevelPushCur |* bd
  uniplate (BDIndentLevelPop     bd) = plate BDIndentLevelPop |* bd
  uniplate (BDPar ind line indented) = plate BDPar |- ind |* line |* indented
  uniplate (BDAlt             alts ) = plate BDAlt ||* alts
  uniplate (BDForwardLineMode bd   ) = plate BDForwardLineMode |* bd
  uniplate x@BDExternal{}            = plate x
  uniplate x@BDPlain{}               = plate x
  uniplate (BDQueueComments comms bd) =
    plate BDQueueComments |- comms |* bd
  uniplate (BDFlushCommentsPrior loc bd) =
    plate BDFlushCommentsPrior |- loc |* bd
  uniplate (BDFlushCommentsPost loc bd) =
    plate BDFlushCommentsPost |- loc |* bd
  uniplate (BDLines lines          ) = plate BDLines ||* lines
  uniplate (BDEnsureIndent ind bd  ) = plate BDEnsureIndent |- ind |* bd
  uniplate (BDForceMultiline  bd   ) = plate BDForceMultiline |* bd
  uniplate (BDForceSingleline bd   ) = plate BDForceSingleline |* bd
  uniplate (BDNonBottomSpacing b bd) = plate BDNonBottomSpacing |- b |* bd
  uniplate (BDSetParSpacing   bd   ) = plate BDSetParSpacing |* bd
  uniplate (BDForceParSpacing bd   ) = plate BDForceParSpacing |* bd
  uniplate (BDDebug s bd           ) = plate BDDebug |- s |* bd

-- this might not work. is not used anywhere either.
briDocSeqSpine :: BriDoc -> ()
briDocSeqSpine = \case
  BDEmpty                        -> ()
  BDLit _t                       -> ()
  BDSeq list                     -> foldl' ((briDocSeqSpine .) . seq) () list
  BDCols _sig list               -> foldl' ((briDocSeqSpine .) . seq) () list
  BDSeparator                    -> ()
  BDAddBaseY _ind bd             -> briDocSeqSpine bd
  BDBaseYPushCur       bd        -> briDocSeqSpine bd
  BDBaseYPop           bd        -> briDocSeqSpine bd
  BDIndentLevelPushCur bd        -> briDocSeqSpine bd
  BDIndentLevelPop     bd        -> briDocSeqSpine bd
  BDPar _ind line indented -> briDocSeqSpine line `seq` briDocSeqSpine indented
  BDAlt             alts         -> foldl' (\() -> briDocSeqSpine) () alts
  BDForwardLineMode bd           -> briDocSeqSpine bd
  BDExternal{}                   -> ()
  BDPlain{}                      -> ()
  BDQueueComments      _comms bd -> briDocSeqSpine bd
  BDFlushCommentsPrior _loc   bd -> briDocSeqSpine bd
  BDFlushCommentsPost  _loc   bd -> briDocSeqSpine bd
  BDLines lines                  -> foldl' (\() -> briDocSeqSpine) () lines
  BDEnsureIndent _ind bd         -> briDocSeqSpine bd
  BDForceMultiline  bd           -> briDocSeqSpine bd
  BDForceSingleline bd           -> briDocSeqSpine bd
  BDNonBottomSpacing _ bd        -> briDocSeqSpine bd
  BDSetParSpacing   bd           -> briDocSeqSpine bd
  BDForceParSpacing bd           -> briDocSeqSpine bd
  BDDebug _s bd                  -> briDocSeqSpine bd

briDocForceSpine :: BriDoc -> BriDoc
briDocForceSpine bd = briDocSeqSpine bd `seq` bd

isNotEmpty :: BriDoc -> Bool
isNotEmpty BDEmpty = False
isNotEmpty _       = True

-- TODO: rename to "dropLabels" ?
unwrapBriDocNumbered :: BriDocNumbered -> BriDoc
unwrapBriDocNumbered tpl = case snd tpl of
  BDFEmpty                       -> BDEmpty
  BDFLit t                       -> BDLit t
  BDFSeq list                    -> BDSeq $ rec <$> list
  BDFCols sig list               -> BDCols sig $ rec <$> list
  BDFSeparator                   -> BDSeparator
  BDFAddBaseY ind bd             -> BDAddBaseY ind $ rec bd
  BDFBaseYPushCur       bd       -> BDBaseYPushCur $ rec bd
  BDFBaseYPop           bd       -> BDBaseYPop $ rec bd
  BDFIndentLevelPushCur bd       -> BDIndentLevelPushCur $ rec bd
  BDFIndentLevelPop     bd       -> BDIndentLevelPop $ rec bd
  BDFPar ind line indented       -> BDPar ind (rec line) (rec indented)
  BDFAlt             alts        -> BDAlt $ rec <$> alts -- not that this will happen
  BDFForwardLineMode bd          -> BDForwardLineMode $ rec bd
  BDFExternal c t                -> BDExternal c t
  BDFPlain t                     -> BDPlain t
  BDFQueueComments      comms bd -> BDQueueComments comms $ rec bd
  BDFFlushCommentsPrior loc   bd -> BDFlushCommentsPrior loc $ rec bd
  BDFFlushCommentsPost  loc   bd -> BDFlushCommentsPost loc $ rec bd
  BDFLines lines                 -> BDLines $ rec <$> lines
  BDFEnsureIndent ind bd         -> BDEnsureIndent ind $ rec bd
  BDFForceMultiline  bd          -> BDForceMultiline $ rec bd
  BDFForceSingleline bd          -> BDForceSingleline $ rec bd
  BDFNonBottomSpacing b bd       -> BDNonBottomSpacing b $ rec bd
  BDFSetParSpacing   bd          -> BDSetParSpacing $ rec bd
  BDFForceParSpacing bd          -> BDForceParSpacing $ rec bd
  BDFDebug s bd -> BDDebug (s ++ "@" ++ show (fst tpl)) $ rec bd
  where rec = unwrapBriDocNumbered

data ColSig
  = ColTyOpPrefix
    -- any prefixed operator/paren/"::"/..
    -- expected to have exactly two colums.
    -- e.g. ":: foo"
    --       111222
    --      "-> bar asd asd"
    --       11122222222222
  | ColPatternsFuncPrefix
    -- pattern-part of the lhs, e.g. "func (foo a b) c _".
    -- Has variable number of columns depending on the number of patterns.
  | ColPatternsFuncInfix
    -- pattern-part of the lhs, e.g. "Foo a <> Foo b".
    -- Has variable number of columns depending on the number of patterns.
  | ColPatterns
  | ColCasePattern
  | ColBindingLine (Maybe Text)
    -- e.g. "func pat pat = expr"
    --       1111111111111222222
    -- or   "pat | stmt -> expr"
    --       111111111112222222
    -- expected to have exactly two columns.
  | ColGuard
    -- e.g. "func pat pat | cond = ..."
    --       11111111111112222222
    -- or   "pat | cond1, cond2 -> ..."
    --       1111222222222222222
    -- expected to have exactly two columns
  | ColGuardedBody
    -- e.g. | foofoo = 1
    --      | bar    = 2
    --      111111111222
    -- expected to have exactly two columns
  | ColBindStmt
  | ColDoLet -- the non-indented variant
  | ColRec
  | ColRecUpdate -- used for both RecCon and RecUpd. TODO: refactor to reflect?
  | ColRecDecl
  | ColListComp
  | ColList
  | ColApp Text
  | ColTuple
  | ColTuples
  | ColOpPrefix -- merge with ColList ? other stuff?
  | ColImport

  -- TODO
  deriving (Eq, Ord, Data.Data.Data, Show)