{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeFamilies #-}
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, DeltaPos)



-- historical design note
--
-- We previously had
--   data BriDocF (f :: Type -> Type) = …
-- where instead of BriDocRec we used `f (BriDocF f)`.
-- This was very close to what we have now, because:
--   BriDocW Wrapped   ~ BriDocF ((,) Int)
--   BriDocW Unwrapped ~ BriDocF Identity
-- but the crucial (and annoying) difference is the existence of `Identity`
-- constructors that are required inside the `BriDocF Identity` values.
--
-- This new type-family based approach is much neater, yay!

data IsWrapped = Wrapped | Unwrapped
type family BriDocRec (w :: IsWrapped) where
  BriDocRec 'Wrapped   = (Int, BriDocW 'Wrapped)
  BriDocRec 'Unwrapped = BriDocW 'Unwrapped



data BriDocW (w :: IsWrapped)
  = -- BDWrapAnnKey AnnKey BriDoc
    BDEmpty
  | BDLit !Text
  | BDSeq [BriDocRec w] -- elements other than the last should
                   -- not contains BDPars.
  | BDCols ColSig [BriDocRec w] -- elements other than the last
                         -- should not contains BDPars
  | BDSeparator -- semantically, space-unless-at-end-of-line.
  | BDAddBaseY BrIndent (BriDocRec w)
  | BDBaseYPushCur (BriDocRec w)
  | BDIndentLevelPushCur (BriDocRec w)
  | BDIndentLevelPop (BriDocRec w)
  | BDPar
    { _bdpar_indent :: BrIndent
    , _bdpar_restOfLine :: BriDocRec w -- should not contain other BDPars
    , _bdpar_indented :: BriDocRec w
    }
  -- | BDAddIndent BrIndent (BriDocRec w)
  -- | BDNewline
  | BDAlt [BriDocRec w]
  | BDForwardLineMode (BriDocRec w)
  | 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] (BriDocRec w)
      -- queue to be later flushed when the markers are reached
  | BDFlushCommentsPrior RealSrcLoc (BriDocRec w)
      -- process comments before loc from the queue
  | BDFlushCommentsPost RealSrcLoc Bool (BriDocRec w)
      -- process comments before loc from the queue, but flow to end of
      -- child-nodes. The boolean determines whether we set this location for
      -- purposes of multiple-line DP calculations. This determines whether
      -- empty lines after this element will be retained in the output.
  | BDEntryDelta DeltaPos (BriDocRec w)
      -- Move to the specified delta position before rendering the inner
      -- element. Currently this only ever respects newlines, i.e. Sameline
      -- is ignored and only the `n` of DifferentLine n _ is used.
      -- Purpose is to retain some spacing in the formatted code, inside
      -- a particular declaration - on the top-level spacing is retained by
      -- other means.
      -- The deltas should in general derived via `obtainAnnDeltaPos`.
  | BDLines [(BriDocRec w)]
  | BDEnsureIndent BrIndent (BriDocRec w)
  -- the following constructors are only relevant for the alt transformation
  -- and are removed afterwards. They should never occur in any (BriDocRec w)
  -- after the alt transformation.
  | BDForceAlt ForceAlt (BriDocRec w)
  -- pseudo-deprecated
  | BDDebug String (BriDocRec w)

deriving instance Data.Data.Data (BriDocW 'Unwrapped)
deriving instance Data.Data.Data (BriDocW 'Wrapped)

type BriDoc         = BriDocW 'Unwrapped
type BriDocWrapped  = BriDocW 'Wrapped
type BriDocNumbered = (Int, BriDocWrapped)

data ForceAlt
  = ForceMultiline
  | ForceSingleline
  | NonBottomSpacing Bool
  | SetParSpacing
  | ForceParSpacing
  | ForceZeroAdd
  deriving (Eq, Ord, Data.Data.Data, Show)


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

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 (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 shouldMark bd) =
    plate BDFlushCommentsPost |- loc |- shouldMark |* bd
  uniplate (BDEntryDelta dp bd     ) = plate BDEntryDelta |- dp |* bd
  uniplate (BDLines lines          ) = plate BDLines ||* lines
  uniplate (BDEnsureIndent ind bd  ) = plate BDEnsureIndent |- ind |* bd
  uniplate (BDForceAlt forceFlag bd) = plate BDForceAlt |- forceFlag |* 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
  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 _m bd -> briDocSeqSpine bd
  BDEntryDelta _dp bd            -> briDocSeqSpine bd
  BDLines lines                  -> foldl' (\() -> briDocSeqSpine) () lines
  BDEnsureIndent _ind bd         -> briDocSeqSpine bd
  BDForceAlt _ 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
  BDEmpty                        -> BDEmpty
  BDLit t                        -> BDLit t
  BDSeq list                     -> BDSeq $ rec <$> list
  BDCols sig list                -> BDCols sig $ rec <$> list
  BDSeparator                    -> BDSeparator
  BDAddBaseY ind bd              -> BDAddBaseY ind $ rec bd
  BDBaseYPushCur       bd        -> BDBaseYPushCur $ rec bd
  BDIndentLevelPushCur bd        -> BDIndentLevelPushCur $ rec bd
  BDIndentLevelPop     bd        -> BDIndentLevelPop $ rec bd
  BDPar ind line indented        -> BDPar ind (rec line) (rec indented)
  BDAlt             alts         -> BDAlt $ rec <$> alts -- not that this will happen
  BDForwardLineMode bd           -> BDForwardLineMode $ rec bd
  BDExternal c t                 -> BDExternal c t
  BDPlain t                      -> BDPlain t
  BDQueueComments      comms bd  -> BDQueueComments comms $ rec bd
  BDFlushCommentsPrior loc   bd  -> BDFlushCommentsPrior loc $ rec bd
  BDFlushCommentsPost loc mrk bd -> BDFlushCommentsPost loc mrk $ rec bd
  BDEntryDelta dp bd             -> BDEntryDelta dp $ rec bd
  BDLines lines                  -> BDLines $ rec <$> lines
  BDEnsureIndent ind bd          -> BDEnsureIndent ind $ rec bd
  BDForceAlt forceFlag bd        -> BDForceAlt forceFlag $ rec bd
  BDDebug 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)