summaryrefslogtreecommitdiff
path: root/src/Language/Haskell/GHC/ExactPrint/Utils.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Language/Haskell/GHC/ExactPrint/Utils.hs')
-rw-r--r--src/Language/Haskell/GHC/ExactPrint/Utils.hs70
1 files changed, 64 insertions, 6 deletions
diff --git a/src/Language/Haskell/GHC/ExactPrint/Utils.hs b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
index b02193d..5cca4e3 100644
--- a/src/Language/Haskell/GHC/ExactPrint/Utils.hs
+++ b/src/Language/Haskell/GHC/ExactPrint/Utils.hs
@@ -1,5 +1,7 @@
-{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
{-# LANGUAGE NamedFieldPuns #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
module Language.Haskell.GHC.ExactPrint.Utils
(
-- * Manipulating Positons
@@ -20,7 +22,7 @@ module Language.Haskell.GHC.ExactPrint.Utils
, comment2dp
-- * GHC Functions
- , srcSpanStartLine
+ , srcSpanStartLine
, srcSpanEndLine
, srcSpanStartColumn
, srcSpanEndColumn
@@ -33,12 +35,13 @@ module Language.Haskell.GHC.ExactPrint.Utils
-- * Manipulating Annotations
, getAnnotationEP
, annTrueEntryDelta
+ , annCommentEntryDelta
+ , annLeadingCommentEntryDelta
-- * General Utility
, orderByKey
-
-- * For tests
, debug
, debugM
@@ -135,9 +138,10 @@ undelta (l,c) (DP (dl,dc)) (LayoutStartCol co) = (fl,fc)
fl = l + dl
fc = if dl == 0 then c + dc
else co + dc
+
-- | Add together two @DeltaPos@ taking into account newlines
--
--- > DP (0, 1) `addDP` DP (0, 2) == DP (0,3)
+-- > DP (0, 1) `addDP` DP (0, 2) == DP (0, 3)
-- > DP (0, 9) `addDP` DP (1, 5) == DP (1, 5)
-- > DP (1, 4) `addDP` DP (1, 3) == DP (2, 3)
addDP :: DeltaPos -> DeltaPos -> DeltaPos
@@ -145,6 +149,33 @@ addDP (DP (a, b)) (DP (c, d)) =
if c >= 1 then DP (a+c, d)
else DP (a, b + d)
+-- | "Subtract" two @DeltaPos@ from each other, in the sense of calculating the
+-- remaining delta for the second after the first has been applied.
+-- invariant : if c = a `addDP` b
+-- then a `stepDP` c == b
+--
+-- Cases where first DP is <= than second
+-- > DP (0, 1) `addDP` DP (0, 2) == DP (0, 1)
+-- > DP (1, 1) `addDP` DP (2, 0) == DP (1, 0)
+-- > DP (1, 3) `addDP` DP (1, 4) == DP (0, 1)
+-- > DP (1, 4) `addDP` DP (1, 4) == DP (1, 4)
+--
+-- Cases where first DP is > than second
+-- > DP (0, 3) `addDP` DP (0, 2) == DP (0,1) -- advance one at least
+-- > DP (3, 3) `addDP` DP (2, 4) == DP (1, 4) -- go one line forward and to expected col
+-- > DP (3, 3) `addDP` DP (0, 4) == DP (0, 1) -- maintain col delta at least
+-- > DP (1, 21) `addDP` DP (1, 4) == DP (1, 4) -- go one line forward and to expected col
+stepDP :: DeltaPos -> DeltaPos -> DeltaPos
+stepDP (DP (a,b)) (DP (c,d))
+ | (a,b) == (c,d) = DP (a,b)
+ | a == c = if b < d then DP (0,d - b)
+ else if d == 0
+ then DP (1,0)
+ -- else DP (0,1)
+ else DP (c,d)
+ | a < c = DP (c - a,d)
+ | otherwise = DP (1,d)
+
-- ---------------------------------------------------------------------
ss2pos :: GHC.SrcSpan -> Pos
@@ -242,6 +273,23 @@ annTrueEntryDelta Ann{annEntryDelta, annPriorComments} =
foldr addDP (DP (0,0)) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments )
`addDP` annEntryDelta
+-- | Take an annotation and a required "true entry" and calculate an equivalent
+-- one relative to the last comment in the annPriorComments.
+annCommentEntryDelta :: Annotation -> DeltaPos -> DeltaPos
+annCommentEntryDelta Ann{annPriorComments} trueDP = dp
+ where
+ commentDP =
+ foldr addDP (DP (0,0)) (map (\(a, b) -> addDP b (dpFromString $ commentContents a)) annPriorComments )
+ dp = stepDP commentDP trueDP
+
+-- | Return the DP of the first item that generates output, either a comment or the entry DP
+annLeadingCommentEntryDelta :: Annotation -> DeltaPos
+annLeadingCommentEntryDelta Ann{annPriorComments,annEntryDelta} = dp
+ where
+ dp = case annPriorComments of
+ [] -> annEntryDelta
+ ((_,ed):_) -> ed
+
-- | Calculates the distance from the start of a string to the end of
-- a string.
dpFromString :: String -> DeltaPos
@@ -333,13 +381,23 @@ showAnnData anns n =
srcSpan s
++ indent (n + 1) ++
show (getAnnotationEP (GHC.L s a) anns)
+ -- ++ case showWrappedDeclAnns (GHC.L s a) of
+ -- Nothing -> ""
+ -- Just annStr -> indent (n + 1) ++ annStr
Nothing -> "nnnnnnnn"
++ showAnnData anns (n+1) a
++ ")"
--- ---------------------------------------------------------------------
-
+{-
+ showWrappedDeclAnns :: (Data a) => GHC.Located a -> Maybe String
+ showWrappedDeclAnns t = everything mappend (Nothing `mkQ` showDecl) t
+ where
+ showDecl :: GHC.LHsDecl GHC.RdrName -> Maybe String
+ showDecl d = Just $ declFun doShowAnn d
+ doShowAnn :: (Data a) => GHC.Located a -> String
+ doShowAnn a = show (getAnnotationEP a anns)
+-}
-- ---------------------------------------------------------------------
showSDoc_ :: GHC.SDoc -> String