{-# LANGUAGE NoImplicitPrelude #-}

module Language.Haskell.Brittany.Internal.WriteBriDoc.Operators
  ( layoutWriteEnsureNewlineBlock
  , layoutWriteEnsureAbsoluteN
  , layoutWriteEnsureBlock
  -- , layoutIndentRestorePostComment
  , layoutRemoveIndentLevelLinger
  , layoutWriteAppend
  , layoutAddSepSpace
  , layoutBaseYPushCur
  , layoutBaseYPop
  , layoutWithAddBaseCol
  , layoutWithAddBaseColN
  , layoutIndentLevelPushCur
  , layoutIndentLevelPop
  , layoutWriteNewline
  , layoutWriteNewlines
  , layoutWriteComment
  , layoutFlushLine
  , layoutSetMarker
  , layoutUpdateMarker
  )
where

import Language.Haskell.Brittany.Internal.Prelude

import qualified Data.Maybe
import qualified Data.Text                     as Text
import qualified Data.Text.Lazy.Builder        as Text.Builder
import qualified GHC.OldList                   as List
import qualified GHC.Parser.Annotation         as GHC
import           GHC                            ( RealSrcLoc )

import           Language.Haskell.Brittany.Internal.Config.Types
import           Language.Haskell.Brittany.Internal.WriteBriDoc.Types



traceLocal :: (MonadMultiState LayoutState m) => a -> m ()
traceLocal _ = return ()
-- traceLocal :: (MonadMultiState LayoutState m, Show a) => a -> m ()
-- traceLocal x = trace (show x) $ pure ()


layoutWriteAppend
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => Text
  -> m ()
layoutWriteAppend t = do
  state <- mGet
  traceLocal
    ( "layoutWriteAppend"
    , t
    , _lstate_plannedSpace state
    )
  case _lstate_plannedSpace state of
    PlannedNone -> do
      mTell $  Text.Builder.fromText t
      mSet state { _lstate_curY = _lstate_curY state + Text.length t }
    PlannedSameline x -> do
      mTell $ Text.Builder.fromString $ replicate x ' '
      mTell $ Text.Builder.fromText t
      mSet state
        { _lstate_plannedSpace = PlannedNone
        , _lstate_curY          = _lstate_curY state
                                  + x
                                  + Text.length t
        }
    PlannedNewline l -> do
      mTell
        $  Text.Builder.fromString
        $  replicate l '\n'
        ++ replicate (lstate_baseY state)   ' '
      mTell $ Text.Builder.fromText t
      mSet state { _lstate_plannedSpace   = PlannedNone
                 , _lstate_curY = lstate_baseY state + Text.length t
                 }
    PlannedDelta l i -> do
      mTell
        $  Text.Builder.fromString
        $  replicate l '\n'
        ++ replicate i   ' '
      mTell $ Text.Builder.fromText t
      mSet state { _lstate_plannedSpace   = PlannedNone
                 , _lstate_curY = i + Text.length t
                 }


-- adds a newline and adds spaces to reach the base column.
layoutWriteNewline
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => m ()
layoutWriteNewline = do
  traceLocal ("layoutWriteNewline")
  state <- mGet
  mSet $ state
    { _lstate_plannedSpace = PlannedNewline 1
    }

layoutWriteNewlines
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => Int
  -> m ()
layoutWriteNewlines n = do
  traceLocal ("layoutWriteNewlines")
  state <- mGet
  mSet $ state
    { _lstate_plannedSpace = PlannedNewline n
    }

-- layoutMoveToIndentCol :: ( MonadMultiState LayoutState m
--                     , MonadMultiWriter (Seq String) m) => Int -> m ()
-- layoutMoveToIndentCol i = do
-- #if INSERTTRACES
--   tellDebugMessShow ("layoutMoveToIndentCol", i)
-- #endif
--   state <- mGet
--   mSet $ state
--     { _lstate_addSepSpace = Just
--                           $ if isJust $ _lstate_addNewline state
--         then i
--         else _lstate_indLevelLinger state + i - _lstate_curY state
--     }

-- This is also used to move to non-comments in a couple of places. Seems
-- to be harmless so far..
layoutWriteComment
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => Bool
  -> Bool
  -> GHC.DeltaPos
  -> Int
  -> Text
  -> m ()
layoutWriteComment absolute isBlock dp commentLines s = do
  let (y, x) = case dp of
        GHC.SameLine c        -> (0, c)
        GHC.DifferentLine l c -> (l, c)
  state <- mGet
  mTell $ Text.Builder.fromString $ replicate y '\n' ++ replicate
    (if absolute && (y > 0) then x - 1 else x)
    ' '
  mTell $ Text.Builder.fromText s
  traceLocal
    ( "layoutMoveToCommentPos"
    , y
    , x
    , commentLines
    , _lstate_plannedSpace state
    , lstate_baseY state
    )
  mSet state
    { _lstate_plannedSpace    = if isBlock
      then case _lstate_plannedSpace state of
        p@PlannedNone       -> p
        p@PlannedSameline{} -> p
        PlannedNewline l ->
          -- trace ("setting to sameline " ++ show (l, y)) $ if l <= y then PlannedSameline 1 else PlannedNewline (l - y)
          PlannedNewline (l - y)
        PlannedDelta l i ->
          if l <= y && Data.Maybe.isNothing (_lstate_markerForDelta state)
            then PlannedSameline 1
            else PlannedDelta (l - y) i
      else case _lstate_plannedSpace state of
        PlannedNone        -> PlannedDelta 1 (_lstate_curY state)
        PlannedSameline i  -> PlannedDelta 1 (_lstate_curY state + i)
        p@PlannedNewline{} -> p
        p@PlannedDelta{}   -> p
    , _lstate_commentNewlines = _lstate_commentNewlines state
                                + y
                                + commentLines
                                - 1
    , _lstate_curY            = if y == 0
                                  then _lstate_curY state + x + Text.length s
                                  else x + Text.length s
    }


_layoutResetCommentNewlines :: MonadMultiState LayoutState m => m ()
_layoutResetCommentNewlines = do
  mModify $ \state -> state { _lstate_commentNewlines = 0 }

layoutWriteEnsureNewlineBlock
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => m ()
layoutWriteEnsureNewlineBlock = do
  state <- mGet
  traceLocal ("layoutWriteEnsureNewlineBlock", lstate_baseY state)
  mSet $ state
    { _lstate_plannedSpace = case _lstate_plannedSpace state of
                               PlannedNone       -> PlannedNewline 1
                               PlannedSameline _ -> PlannedNewline 1
                               PlannedNewline  i -> PlannedNewline i
                               PlannedDelta i _  -> PlannedNewline i
    }

layoutWriteEnsureAbsoluteN
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => Int
  -> m ()
layoutWriteEnsureAbsoluteN n = do
  state <- mGet
  traceLocal ("layoutWriteEnsureAbsoluteN", n)
  mSet $ state
    { _lstate_plannedSpace = case _lstate_plannedSpace state of
      PlannedNone       -> PlannedSameline (max 0 $ n - _lstate_curY state)
      PlannedSameline i -> PlannedSameline (max i $ n - _lstate_curY state)
      PlannedNewline  l -> PlannedDelta l n
      PlannedDelta l _  -> PlannedDelta l n
    }

layoutBaseYPushInternal :: (MonadMultiState LayoutState m) => Int -> m ()
layoutBaseYPushInternal i = do
  traceLocal ("layoutBaseYPushInternal", i)
  mModify $ \s -> s { _lstate_baseYs = i : _lstate_baseYs s }

layoutBaseYPopInternal :: (MonadMultiState LayoutState m) => m ()
layoutBaseYPopInternal = do
  traceLocal ("layoutBaseYPopInternal")
  mModify $ \s -> s { _lstate_baseYs = List.tail $ _lstate_baseYs s }

layoutIndentLevelPushInternal :: (MonadMultiState LayoutState m) => Int -> m ()
layoutIndentLevelPushInternal i = do
  traceLocal ("layoutIndentLevelPushInternal", i)
  mModify $ \s -> s
    { _lstate_indLevelLinger = lstate_indLevel s
    , _lstate_indLevels = i : _lstate_indLevels s
    }

layoutIndentLevelPopInternal :: (MonadMultiState LayoutState m) => m ()
layoutIndentLevelPopInternal = do
  traceLocal ("layoutIndentLevelPopInternal")
  mModify $ \s -> s
    { _lstate_indLevelLinger = lstate_indLevel s
    , _lstate_indLevels = List.tail $ _lstate_indLevels s
    }

layoutRemoveIndentLevelLinger :: (MonadMultiState LayoutState m) => m ()
layoutRemoveIndentLevelLinger = do
  mModify $ \s -> s { _lstate_indLevelLinger = lstate_indLevel s }

layoutWithAddBaseCol
  :: ( MonadMultiWriter Text.Builder.Builder m
     , MonadMultiState LayoutState m
     , MonadMultiReader Config m
     )
  => m ()
  -> m ()
layoutWithAddBaseCol m = do
  amount <- mAsk <&> _conf_layout .> _lconfig_indentAmount .> confUnpack
  state <- mGet
  layoutBaseYPushInternal $ lstate_baseY state + amount
  m
  layoutBaseYPopInternal

layoutWriteEnsureBlock
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => m ()
layoutWriteEnsureBlock = do
  traceLocal ("layoutWriteEnsureBlock")
  state <- mGet
  mSet $ state
    { _lstate_plannedSpace = case _lstate_plannedSpace state of
      PlannedNone ->
        PlannedSameline (max 0 $ lstate_baseY state - _lstate_curY state)
      PlannedSameline i ->
        PlannedSameline (max i $ lstate_baseY state - _lstate_curY state)
      PlannedNewline l -> PlannedDelta l (lstate_baseY state)
      PlannedDelta l i -> PlannedDelta l (max i $ lstate_baseY state)
    }

layoutWithAddBaseColN
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => Int
  -> m ()
  -> m ()
layoutWithAddBaseColN amount m = do
  state <- mGet
  layoutBaseYPushInternal $ lstate_baseY state + amount
  m
  layoutBaseYPopInternal

layoutBaseYPushCur :: (MonadMultiState LayoutState m) => m ()
layoutBaseYPushCur = do
  state <- mGet
  traceLocal
    ( "layoutBaseYPushCur"
    , _lstate_plannedSpace state
    )
  layoutBaseYPushInternal $ case _lstate_plannedSpace state of
    PlannedNone       -> _lstate_curY state
    PlannedSameline i -> _lstate_curY state + i
    PlannedNewline _l -> lstate_baseY state
    PlannedDelta _l i -> i


layoutBaseYPop :: (MonadMultiState LayoutState m) => m ()
layoutBaseYPop = do
  traceLocal ("layoutBaseYPop")
  layoutBaseYPopInternal

layoutIndentLevelPushCur :: (MonadMultiState LayoutState m) => m ()
layoutIndentLevelPushCur = do
  traceLocal ("layoutIndentLevelPushCur")
  state <- mGet
  layoutIndentLevelPushInternal $ case _lstate_plannedSpace state of
    PlannedNone -> _lstate_curY state
    PlannedSameline i -> _lstate_curY state + i
    PlannedNewline _l -> error "strange operation" -- TODO92
    PlannedDelta _l i -> i

layoutIndentLevelPop :: (MonadMultiState LayoutState m) => m ()
layoutIndentLevelPop = do
  traceLocal ("layoutIndentLevelPop")
  layoutIndentLevelPopInternal
  -- why are comment indentations relative to the previous indentation on
  -- the first node of an additional indentation, and relative to the outer
  -- indentation after the last node of some indented stuff? sure does not
  -- make sense.
  layoutRemoveIndentLevelLinger

layoutAddSepSpace :: (MonadMultiState LayoutState m) => m ()
layoutAddSepSpace = do
  state <- mGet
  mSet $ state
    { _lstate_plannedSpace = case _lstate_plannedSpace state of
                               PlannedNone        -> PlannedSameline 1
                               PlannedSameline i  -> PlannedSameline (max 1 i)
                               x@PlannedNewline{} -> x
                               PlannedDelta l i   -> PlannedDelta l (i + 1)
      -- the planneddelta case is questionable. The problem is that we don't
      -- know exactly how much is "separator" and how much is exact positioning
      -- (e.g. from an inserted comment restore-position task).
    }

layoutFlushLine
  :: (MonadMultiWriter Text.Builder.Builder m, MonadMultiState LayoutState m)
  => m ()
layoutFlushLine = do
  state <- mGet
  when (_lstate_curY state > 0) layoutWriteEnsureNewlineBlock

layoutSetMarker :: (MonadMultiState LayoutState m) => Maybe RealSrcLoc -> m ()
layoutSetMarker markerMay =
  mModify $ \s -> s { _lstate_markerForDelta = markerMay }

layoutUpdateMarker :: (MonadMultiState LayoutState m) => RealSrcLoc -> m ()
layoutUpdateMarker marker = mModify $ \s -> s
  { _lstate_markerForDelta = case _lstate_markerForDelta s of
                               Nothing -> Nothing
                               Just _  -> Just marker
  }

-- moveToY :: MonadMultiState LayoutState m => Int -> m ()
-- moveToY y = mModify $ \state ->
--   let
--     upd = case _lstate_curYOrAddNewline state of
--       Left i -> if y == 0 then Left i else Right y
--       Right i -> Right $ max y i
--   in
--     state
--       { _lstate_curYOrAddNewline = upd
--       , _lstate_addSepSpace = if Data.Either.isRight upd
--         then _lstate_commentCol state <|> _lstate_addSepSpace state <|> Just
--           (lstate_baseY state)
--         else Nothing
--       , _lstate_commentCol = Nothing
--       }
-- fixMoveToLineByIsNewline :: MonadMultiState
--                                                   LayoutState m => Int -> m Int
-- fixMoveToLineByIsNewline x = do
--   newLineState <- mGet <&> _lstate_isNewline
--   return $ if newLineState == NewLineStateYes
--     then x-1
--     else x

-- TODO: update and use, or clean up. Currently dead code.
-- layoutWritePriorComments
--   :: ( Data.Data.Data ast
--      , MonadMultiWriter Text.Builder.Builder m
--      , MonadMultiState LayoutState m
--      )
--   => Located ast
--   -> m ()
-- layoutWritePriorComments ast = do
--   mAnn <- do
--     state <- mGet
--     let key = ExactPrint.mkAnnKey ast
--     let anns = _lstate_comments state
--     let mAnn = ExactPrint.annPriorComments <$> Map.lookup key anns
--     mSet $ state
--       { _lstate_comments = Map.adjust
--         (\ann -> ann { ExactPrint.annPriorComments = [] })
--         key
--         anns
--       }
--     return mAnn
--   case mAnn of
--     Nothing -> return ()
--     Just priors -> do
--       unless (null priors) $ layoutSetCommentCol
--       priors `forM_` \(ExactPrint.Comment comment _ _, ExactPrint.DP (x, y)) ->
--         do
--           replicateM_ x layoutWriteNewline
--           layoutWriteAppendSpaces y
--           layoutWriteAppendMultiline $ Text.lines $ Text.pack comment

-- TODO: update and use, or clean up. Currently dead code.
-- this currently only extracs from the `annsDP` field of Annotations.
-- per documentation, this seems sufficient, as the
-- "..`annFollowingComments` are only added by AST transformations ..".
-- layoutWritePostComments
--   :: ( Data.Data.Data ast
--      , MonadMultiWriter Text.Builder.Builder m
--      , MonadMultiState LayoutState m
--      )
--   => Located ast
--   -> m ()
-- layoutWritePostComments ast = do
--   mAnn <- do
--     state <- mGet
--     let key = ExactPrint.mkAnnKey ast
--     let anns = _lstate_comments state
--     let mAnn = ExactPrint.annFollowingComments <$> Map.lookup key anns
--     mSet $ state
--       { _lstate_comments = Map.adjust
--         (\ann -> ann { ExactPrint.annFollowingComments = [] })
--         key
--         anns
--       }
--     return mAnn
--   case mAnn of
--     Nothing -> return ()
--     Just posts -> do
--       unless (null posts) $ layoutSetCommentCol
--       posts `forM_` \(ExactPrint.Comment comment _ _, ExactPrint.DP (x, y)) ->
--         do
--           replicateM_ x layoutWriteNewline
--           layoutWriteAppend $ Text.pack $ replicate y ' '
--           mModify $ \s -> s { _lstate_addSepSpace = Nothing }
--           layoutWriteAppendMultiline $ Text.lines $ Text.pack $ comment

-- layoutWritePriorCommentsRestore :: (Data.Data.Data ast,
--                                                MonadMultiWriter Text.Builder.Builder m,
--                                                MonadMultiState LayoutState m
--                                   , MonadMultiWriter (Seq String) m)
--                                 => Located ast -> m ()
-- layoutWritePriorCommentsRestore x = do
--   layoutWritePriorComments x
--   layoutIndentRestorePostComment
--
-- layoutWritePostCommentsRestore :: (Data.Data.Data ast,
--                                                MonadMultiWriter Text.Builder.Builder m,
--                                                MonadMultiState LayoutState m
--                                                , MonadMultiWriter (Seq String) m)
--                                 => Located ast -> m ()
-- layoutWritePostCommentsRestore x = do
--   layoutWritePostComments x
--   layoutIndentRestorePostComment
