<commit_before>{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.GHC.ExactPrint
-- Based on
-- --------------------------------------------------------------------------
-- Module      :  Language.Haskell.Exts.Annotated.ExactPrint
-- Copyright   :  (c) <NAME> 2009
-- License     :  BSD-style (see the file LICENSE.txt)
--
-- Maintainer  :  <NAME>, <EMAIL>
-- Stability   :  stable
-- Portability :  portable
--
-- Exact-printer for Haskell abstract syntax. The input is a (semi-concrete)
-- abstract syntax tree, annotated with exact source information to enable
-- printing the tree exactly as it was parsed.
--
-----------------------------------------------------------------------------
module Language.Haskell.GHC.ExactPrint
        ( annotateAST
        , Anns
        , exactPrintAnnotated
        , exactPrintAnnotation

        , exactPrint
        , ExactP

        ) where

import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils

import Control.Applicative
import Control.Monad.State
import Control.Exception
import Data.Data
import Data.List
import Data.Maybe
import Data.Monoid
import Control.Monad.RWS

import qualified Bag           as GHC
import qualified BasicTypes    as GHC
import qualified Class         as GHC
import qualified CoAxiom       as GHC
import qualified FastString    as GHC
import qualified ForeignCall   as GHC
import qualified GHC           as GHC
import qualified SrcLoc        as GHC

import qualified Data.Map as Map

-- ---------------------------------------------------------------------

-- Compatibiity types, from HSE

-- | A portion of the source, extended with information on the position of entities within the span.
data SrcSpanInfo = SrcSpanInfo
    { srcInfoSpan    :: GHC.SrcSpan
    , srcInfoPoints  :: [GHC.SrcSpan]    -- Marks the location of specific entities inside the span
    }
  deriving (Eq,Ord,Show,Typeable,Data)


-- | A class to work over all kinds of source location information.
class SrcInfo si where
  toSrcInfo   :: GHC.SrcLoc -> [GHC.SrcSpan] -> GHC.SrcLoc -> si
  fromSrcInfo :: SrcSpanInfo -> si
  getPointLoc :: si -> GHC.SrcLoc
  fileName    :: si -> String
  startLine   :: si -> Int
  startColumn :: si -> Int

  getPointLoc si = GHC.mkSrcLoc (GHC.mkFastString $ fileName si) (startLine si) (startColumn si)


instance SrcInfo GHC.SrcSpan where
  toSrcInfo   = error "toSrcInfo GHC.SrcSpan undefined"
  fromSrcInfo = error "toSrcInfo GHC.SrcSpan undefined"

  getPointLoc = GHC.srcSpanStart

  fileName (GHC.RealSrcSpan s) = GHC.unpackFS $ GHC.srcSpanFile s
  fileName _                   = "bad file name for SrcSpan"

  startLine   = srcSpanStartLine
  startColumn = srcSpanStartColumn

class Annotated a where
  ann :: a -> GHC.SrcSpan

instance Annotated (GHC.Located a) where
  ann (GHC.L l _) = l

------------------------------------------------------
-- The EP monad and basic combinators

-- The (ColOffset,ColOffset) value carries the normal and current
-- column offset. The second one captures the difference between the
-- original col when the DP was captured and the current one.

data EPState = EPState
             { epPos       :: Pos -- ^ Current output position
             , epAnns      :: Anns
             , epAnnKds    :: [[(KeywordId, DeltaPos)]] -- MP: Could this be moved to the local state with suitable refactoring?
             }

data EPLocal = EPLocal
             { eFunId      :: (Bool, String)
             , eFunIsInfix :: Bool -- AZ:Needed? is in first field of eFunId
             , epStack     :: (ColOffset,ColDelta) -- ^ stack of offsets that currently apply
             , epSrcSpan  :: GHC.SrcSpan
             }

type EP a = RWS EPLocal (Endo String) EPState a

runEP :: EP () -> GHC.SrcSpan -> Anns -> String
runEP f ss ans =
  flip appEndo "" . snd . execRWS f (defaultLocal ss) $ (defaultState ans)

defaultState :: Anns -> EPState
defaultState as = EPState
             { epPos = (1,1)
             , epAnns = as
             , epAnnKds      = []
             }

defaultLocal :: GHC.SrcSpan -> EPLocal
defaultLocal ss = EPLocal
             { eFunId   = (False, "")
             , eFunIsInfix = False
             , epStack = (0,0)
             , epSrcSpan = ss
             }

getPos :: EP Pos
getPos = gets epPos

setPos :: Pos -> EP ()
setPos l = modify (\s -> s {epPos = l})

-- ---------------------------------------------------------------------

-- Given an annotation, determines a new offset relative to the previous
-- offset
--
withOffset :: Annotation -> (EP () -> EP ())
withOffset a@(Ann (DP (edLine, edColumn)) newline originalStartCol annDelta _) k = do
  (colOffset, colDelta) <- asks epStack
  (_l, currentColumn) <- getPos
  let
      newOffset =
        case newline of
          LineChanged -> (annDelta + colDelta , colDelta)
          KeepOffset -> (annDelta + colDelta , colDelta)
          LineSame ->
            let
              -- Add extra indentation
              colOffset' = annDelta + colOffset
              -- Work out where new column starts
              -- If the annLineDelta == 0 ie, we stay on the same
              -- line so the new column is the current position
              --
              --
              -- If not then we move to the next line so the
              -- start column is whatever the indentation context
              -- is `colOffset`
              newStartColumn = edColumn +
                                 if edLine == 0
                                   then currentColumn -- same line
                                   else colOffset -- different line
              newColDelta = newStartColumn - originalStartCol
              in ((colOffset' + newColDelta) - colDelta, newColDelta)
  local (\s -> s {epStack = newOffset }) k
    `debug` ("pushOffset:(ann, colOffset, colDelta, currentColumn, newOffset)=" ++ show (a, colOffset, colDelta, currentColumn, newOffset))

-- |Get the current column offset
getOffset :: EP ColOffset
getOffset = asks (fst . epStack)

-- ---------------------------------------------------------------------

withSrcSpan :: GHC.SrcSpan -> (EP () -> EP ())
withSrcSpan ss = local (\s -> s {epSrcSpan = ss})<commit_msg>Change bracketing to make the new offset calculation clearer<commit_after>{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeSynonymInstances #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Language.Haskell.GHC.ExactPrint
-- Based on
-- --------------------------------------------------------------------------
-- Module      :  Language.Haskell.Exts.Annotated.ExactPrint
-- Copyright   :  (c) <NAME> 2009
-- License     :  BSD-style (see the file LICENSE.txt)
--
-- Maintainer  :  <NAME>, <EMAIL>
-- Stability   :  stable
-- Portability :  portable
--
-- Exact-printer for Haskell abstract syntax. The input is a (semi-concrete)
-- abstract syntax tree, annotated with exact source information to enable
-- printing the tree exactly as it was parsed.
--
-----------------------------------------------------------------------------
module Language.Haskell.GHC.ExactPrint
        ( annotateAST
        , Anns
        , exactPrintAnnotated
        , exactPrintAnnotation

        , exactPrint
        , ExactP

        ) where

import Language.Haskell.GHC.ExactPrint.Types
import Language.Haskell.GHC.ExactPrint.Utils

import Control.Applicative
import Control.Monad.State
import Control.Exception
import Data.Data
import Data.List
import Data.Maybe
import Data.Monoid
import Control.Monad.RWS

import qualified Bag           as GHC
import qualified BasicTypes    as GHC
import qualified Class         as GHC
import qualified CoAxiom       as GHC
import qualified FastString    as GHC
import qualified ForeignCall   as GHC
import qualified GHC           as GHC
import qualified SrcLoc        as GHC

import qualified Data.Map as Map

-- ---------------------------------------------------------------------

-- Compatibiity types, from HSE

-- | A portion of the source, extended with information on the position of entities within the span.
data SrcSpanInfo = SrcSpanInfo
    { srcInfoSpan    :: GHC.SrcSpan
    , srcInfoPoints  :: [GHC.SrcSpan]    -- Marks the location of specific entities inside the span
    }
  deriving (Eq,Ord,Show,Typeable,Data)


-- | A class to work over all kinds of source location information.
class SrcInfo si where
  toSrcInfo   :: GHC.SrcLoc -> [GHC.SrcSpan] -> GHC.SrcLoc -> si
  fromSrcInfo :: SrcSpanInfo -> si
  getPointLoc :: si -> GHC.SrcLoc
  fileName    :: si -> String
  startLine   :: si -> Int
  startColumn :: si -> Int

  getPointLoc si = GHC.mkSrcLoc (GHC.mkFastString $ fileName si) (startLine si) (startColumn si)


instance SrcInfo GHC.SrcSpan where
  toSrcInfo   = error "toSrcInfo GHC.SrcSpan undefined"
  fromSrcInfo = error "toSrcInfo GHC.SrcSpan undefined"

  getPointLoc = GHC.srcSpanStart

  fileName (GHC.RealSrcSpan s) = GHC.unpackFS $ GHC.srcSpanFile s
  fileName _                   = "bad file name for SrcSpan"

  startLine   = srcSpanStartLine
  startColumn = srcSpanStartColumn

class Annotated a where
  ann :: a -> GHC.SrcSpan

instance Annotated (GHC.Located a) where
  ann (GHC.L l _) = l

------------------------------------------------------
-- The EP monad and basic combinators

-- The (ColOffset,ColOffset) value carries the normal and current
-- column offset. The second one captures the difference between the
-- original col when the DP was captured and the current one.

data EPState = EPState
             { epPos       :: Pos -- ^ Current output position
             , epAnns      :: Anns
             , epAnnKds    :: [[(KeywordId, DeltaPos)]] -- MP: Could this be moved to the local state with suitable refactoring?
             }

data EPLocal = EPLocal
             { eFunId      :: (Bool, String)
             , eFunIsInfix :: Bool -- AZ:Needed? is in first field of eFunId
             , epStack     :: (ColOffset,ColDelta) -- ^ stack of offsets that currently apply
             , epSrcSpan  :: GHC.SrcSpan
             }

type EP a = RWS EPLocal (Endo String) EPState a

runEP :: EP () -> GHC.SrcSpan -> Anns -> String
runEP f ss ans =
  flip appEndo "" . snd . execRWS f (defaultLocal ss) $ (defaultState ans)

defaultState :: Anns -> EPState
defaultState as = EPState
             { epPos = (1,1)
             , epAnns = as
             , epAnnKds      = []
             }

defaultLocal :: GHC.SrcSpan -> EPLocal
defaultLocal ss = EPLocal
             { eFunId   = (False, "")
             , eFunIsInfix = False
             , epStack = (0,0)
             , epSrcSpan = ss
             }

getPos :: EP Pos
getPos = gets epPos

setPos :: Pos -> EP ()
setPos l = modify (\s -> s {epPos = l})

-- ---------------------------------------------------------------------

-- Given an annotation, determines a new offset relative to the previous
-- offset
--
withOffset :: Annotation -> (EP () -> EP ())
withOffset a@(Ann (DP (edLine, edColumn)) newline originalStartCol annDelta _) k = do
  (colOffset, colDelta) <- asks epStack
  (_l, currentColumn) <- getPos
  let
      newOffset =
        case newline of
          LineChanged -> (annDelta + colDelta , colDelta)
          KeepOffset -> (annDelta + colDelta , colDelta)
          LineSame ->
            let
              -- Add extra indentation
              colOffset' = annDelta + colOffset
              -- Work out where new column starts
              -- If the annLineDelta == 0 ie, we stay on the same
              -- line so the new column is the current position
              --
              --
              -- If not then we move to the next line so the
              -- start column is whatever the indentation context
              -- is `colOffset`
              newStartColumn = edColumn +
                                 if edLine == 0
                                   then currentColumn -- same line
                                   else colOffset -- different line
              newColDelta = newStartColumn - originalStartCol
              in (colOffset' + (newColDelta - colDelta), newColDelta)
  local (\s -> s {epStack = newOffset }) k
    `debug` ("pushOffset:(ann, colOffset, colDelta, currentColumn, newOffset)=" ++ show (a, colOffset, colDelta, currentColumn, newOffset))

-- |Get the current column offset
getOffset :: EP ColOffset
getOffset = asks (fst . epStack)

-- ---------------------------------------------------------------------

withSrcSpan :: GHC.SrcSpan -> (EP () -> EP ())
withSrcSpan ss = local (\s -> s {epSrcSpan = ss})
{'fraction_non_alphanumeric': 0.16125262911895302, 'fraction_numerical': 0.001557996416608242, 'mean_word_length': 1.728586609989373, 'pattern_counts': {'":': 0, '<': 13, '<?xml version=': 0, '>': 59, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '1067820', 'n_tokens_mistral': 3532, 'n_tokens_neox': 3472, 'n_words': 1165}