packages feed

haskell-tools-debug 0.5.0.0 → 0.6.0.0

raw patch · 3 files changed

+38/−25 lines, 3 filesdep +filepathdep +template-haskelldep ~haskell-tools-astdep ~haskell-tools-backend-ghcdep ~haskell-tools-debugPVP ok

version bump matches the API change (PVP)

Dependencies added: filepath, template-haskell

Dependency ranges changed: haskell-tools-ast, haskell-tools-backend-ghc, haskell-tools-debug, haskell-tools-prettyprint, haskell-tools-refactor

API changes (from Hackage documentation)

Files

Language/Haskell/Tools/Debug.hs view
@@ -1,14 +1,19 @@  {-# LANGUAGE StandaloneDeriving
             , DeriveGeneric
+            , LambdaCase
             #-}
 module Language.Haskell.Tools.Debug where
 
 import Control.Monad.IO.Class (MonadIO(..))
 import Data.Maybe (Maybe(..), fromJust)
 import GHC.Generics (Generic(..))
+import System.FilePath (pathSeparator, (</>), (<.>))
 
+import DynFlags (xopt)
 import GHC hiding (loadModule)
 import GHC.Paths ( libdir )
+import Language.Haskell.TH.LanguageExtensions (Extension(..))
+import StringBuffer (hGetStringBuffer)
 
 import Language.Haskell.Tools.AST (NodeInfo(..))
 import Language.Haskell.Tools.AST.FromGHC
@@ -23,7 +28,7 @@ 
 -- | Should be only used for testing
 demoRefactor :: String -> String -> [String] -> String -> IO ()
-demoRefactor command workingDir args moduleName = 
+demoRefactor command workingDir args moduleName =
   runGhc (Just libdir) $ do
     initGhcFlags
     _ <- useFlags args
@@ -31,10 +36,12 @@     modSum <- loadModule workingDir moduleName
     p <- parseModule modSum
     t <- typecheckModule p
-        
+
     let annots = pm_annotations $ tm_parsed_module t
+        hasCPP = Cpp `xopt` ms_hspp_opts modSum
 
-    liftIO $ putStrLn $ show annots
+    liftIO $ putStrLn "=========== tokens:"
+    liftIO $ putStrLn $ show (fst annots)
     liftIO $ putStrLn "=========== parsed source:"
     liftIO $ putStrLn $ show (pm_parsed_source p)
     liftIO $ putStrLn "=========== renamed source:"
@@ -49,21 +56,24 @@     transformed <- addTypeInfos (typecheckedSource t) =<< (runTrf (fst annots) (getPragmaComments $ snd annots) $ trfModuleRename modSum parseTrf (fromJust $ tm_renamed_source t) (pm_parsed_source p))
     liftIO $ putStrLn $ srcInfoDebug transformed
     liftIO $ putStrLn "=========== ranges fixed:"
-    let commented = fixRanges $ placeComments (getNormalComments $ snd annots) transformed
+    sourceOrigin <- if hasCPP then liftIO $ hGetStringBuffer (workingDir </> map (\case '.' -> pathSeparator; c -> c) moduleName <.> "hs")
+                              else return (fromJust $ ms_hspp_buf $ pm_mod_summary p)
+    let commented = fixRanges $ placeComments (fst annots) (getNormalComments $ snd annots) $ fixMainRange sourceOrigin transformed
     liftIO $ putStrLn $ srcInfoDebug commented
     liftIO $ putStrLn "=========== cut up:"
     let cutUp = cutUpRanges commented
     liftIO $ putStrLn $ srcInfoDebug cutUp
     liftIO $ putStrLn $ show $ getLocIndices cutUp
-    liftIO $ putStrLn $ show $ mapLocIndices (fromJust $ ms_hspp_buf $ pm_mod_summary p) (getLocIndices cutUp)
+
+    liftIO $ putStrLn $ show $ mapLocIndices sourceOrigin (getLocIndices cutUp)
     liftIO $ putStrLn "=========== sourced:"
-    let sourced = rangeToSource (fromJust $ ms_hspp_buf $ pm_mod_summary p) cutUp
+    let sourced = (if hasCPP then fixCPPSpans else id) $ rangeToSource sourceOrigin cutUp
     liftIO $ putStrLn $ srcInfoDebug sourced
     liftIO $ putStrLn "=========== pretty printed:"
     let prettyPrinted = prettyPrint sourced
     liftIO $ putStrLn prettyPrinted
-    transformed <- performCommand (readCommand command) ((SourceFileKey NormalHs moduleName), sourced) []
-    case transformed of 
+    transformed <- performCommand (either error id $ readCommand command) ((SourceFileKey NormalHs moduleName), sourced) []
+    case transformed of
       Right [ContentChanged (_, correctlyTransformed)] -> do
         liftIO $ putStrLn "=========== transformed AST:"
         liftIO $ putStrLn $ srcInfoDebug correctlyTransformed
@@ -77,6 +87,6 @@         liftIO $ putStrLn "==========="
         liftIO $ putStrLn transformProblem
         liftIO $ putStrLn "==========="
-  
+
 deriving instance Generic SrcSpan
 deriving instance Generic (NodeInfo sema src)
Language/Haskell/Tools/RangeDebug/Instances.hs view
@@ -3,7 +3,7 @@            , MultiParamTypeClasses
            , StandaloneDeriving
            , DeriveGeneric
-           , UndecidableInstances 
+           , UndecidableInstances
            #-}
 module Language.Haskell.Tools.RangeDebug.Instances where
 
@@ -17,16 +17,16 @@ -- Annotations
 instance TreeDebug e dom st => TreeDebug (Ann e) dom st where
   treeDebug' i (Ann a e) = identLine i ++ show (a ^. sourceInfo) ++ " " ++ take 40 (show e) ++ "..." ++ treeDebug' (i+1) e
-  
+
 identLine :: Int -> String
 identLine i = "\n" ++ replicate (i*2) ' '
-  
+
 instance TreeDebug e dom st => TreeDebug (AnnListG e) dom st where
-  treeDebug' i (AnnListG a ls) = identLine i ++ show (a ^. sourceInfo) ++ " <*>" ++ concatMap (treeDebug' (i + 1)) ls 
-  
+  treeDebug' i (AnnListG a ls) = identLine i ++ show (a ^. sourceInfo) ++ " <*>" ++ concatMap (treeDebug' (i + 1)) ls
+
 instance TreeDebug e dom st => TreeDebug (AnnMaybeG e) dom st where
   treeDebug' i (AnnMaybeG a e) = identLine i ++ show (a ^. sourceInfo) ++ " <?>" ++ maybe "" (\e -> treeDebug' (i + 1) e) e
-  
+
 -- Modules
 instance (SourceInfo st, Domain dom) => TreeDebug UModule dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UModuleHead dom st
@@ -85,6 +85,7 @@ instance (SourceInfo st, Domain dom) => TreeDebug UBracket dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UTopLevelPragma dom st
 instance (SourceInfo st, Domain dom) => TreeDebug URule dom st
+instance (SourceInfo st, Domain dom) => TreeDebug URuleVar dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UAnnotationSubject dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UMinimalFormula dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UExprPragma dom st
@@ -113,6 +114,7 @@ instance (SourceInfo st, Domain dom) => TreeDebug ULanguageExtension dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UMatchLhs dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UInlinePragma dom st
+instance (SourceInfo st, Domain dom) => TreeDebug USpecializePragma dom st
 
 -- ULiteral
 instance (SourceInfo st, Domain dom) => TreeDebug ULiteral dom st
@@ -138,4 +140,4 @@ instance (SourceInfo st, Domain dom) => TreeDebug LineNumber dom st
 instance (SourceInfo st, Domain dom) => TreeDebug UPhaseControl dom st
 instance (SourceInfo st, Domain dom) => TreeDebug PhaseNumber dom st
-instance (SourceInfo st, Domain dom) => TreeDebug PhaseInvert dom st+instance (SourceInfo st, Domain dom) => TreeDebug PhaseInvert dom st
haskell-tools-debug.cabal view
@@ -1,5 +1,5 @@ name:                haskell-tools-debug
-version:             0.5.0.0
+version:             0.6.0.0
 synopsis:            Debugging Tools for Haskell-tools
 description:         Debugging Tools for Haskell-tools
 homepage:            https://github.com/haskell-tools/haskell-tools
@@ -12,24 +12,25 @@ cabal-version:       >=1.10
 
 library
-  ghc-options:         -O2
   exposed-modules:     Language.Haskell.Tools.Debug
   other-modules:       Language.Haskell.Tools.DebugGhcAST
                      , Language.Haskell.Tools.RangeDebug
                      , Language.Haskell.Tools.RangeDebug.Instances
   build-depends:       base                      >= 4.9 && < 4.10
+                     , filepath                  >= 1.4 && < 1.5
+                     , template-haskell          >= 2.11 && < 2.12
                      , references                >= 0.3 && < 0.4
                      , ghc                       >= 8.0 && < 8.1
                      , ghc-paths                 >= 0.1 && < 0.2
-                     , haskell-tools-ast         >= 0.5 && < 0.6
-                     , haskell-tools-backend-ghc >= 0.5 && < 0.6
-                     , haskell-tools-refactor    >= 0.5 && < 0.6
-                     , haskell-tools-prettyprint >= 0.5 && < 0.6
+                     , haskell-tools-ast         >= 0.6 && < 0.7
+                     , haskell-tools-backend-ghc >= 0.6 && < 0.7
+                     , haskell-tools-refactor    >= 0.6 && < 0.7
+                     , haskell-tools-prettyprint >= 0.6 && < 0.7
   default-language:    Haskell2010
-  
+
 executable ht-debug
   build-depends:       base                      >= 4.9 && < 5.0
-                     , haskell-tools-debug       >= 0.5 && < 0.6
+                     , haskell-tools-debug       >= 0.6 && < 0.7
   hs-source-dirs:      exe
   main-is:             Main.hs
-  default-language:    Haskell2010+  default-language:    Haskell2010