base: Move prettyCallStack to GHC.Internal.Stack

libraries/ghc-internal/src/GHC/Internal/Exception.hs

@@ -2,7 +2,6 @@
 {-# LANGUAGE NoImplicitPrelude
            , ExistentialQuantification
            , MagicHash
-           , RecordWildCards
            , PatternSynonyms
   #-}
 {-# LANGUAGE DataKinds, PolyKinds #-}
@@ -62,6 +61,7 @@ import GHC.Internal.Stack.Types
 import GHC.Internal.Data.OldList
 import GHC.Internal.IO.Unsafe
 import {-# SOURCE #-} GHC.Internal.Stack.CCS
+import {-# SOURCE #-} GHC.Internal.Stack (prettyCallStackLines, prettyCallStack, prettySrcLoc)
 import GHC.Internal.Exception.Type
 
 -- | Throw an exception.  Exceptions may be thrown from purely
@@ -111,31 +111,3 @@ showCCSStack :: [String] -> [String]
 showCCSStack [] = []
 showCCSStack stk = "CallStack (from -prof):" : map ("  " ++) (reverse stk)
 
--- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
--- files. See Note [Definition of CallStack]
-
--- | Pretty print a 'SrcLoc'.
---
--- @since base-4.9.0.0
-prettySrcLoc :: SrcLoc -> String
-prettySrcLoc SrcLoc {..}
-  = foldr (++) ""
-      [ srcLocFile, ":"
-      , show srcLocStartLine, ":"
-      , show srcLocStartCol, " in "
-      , srcLocPackage, ":", srcLocModule
-      ]
-
--- | Pretty print a 'CallStack'.
---
--- @since base-4.9.0.0
-prettyCallStack :: CallStack -> String
-prettyCallStack = intercalate "\n" . prettyCallStackLines
-
-prettyCallStackLines :: CallStack -> [String]
-prettyCallStackLines cs = case getCallStack cs of
-  []  -> []
-  stk -> "CallStack (from HasCallStack):"
-       : map (("  " ++) . prettyCallSite) stk
-  where
-    prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc

libraries/ghc-internal/src/GHC/Internal/Stack.hs

 {-# LANGUAGE ImplicitParams #-}
 {-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE RankNTypes #-}
 {-# LANGUAGE Trustworthy #-}
 
@@ -27,8 +28,9 @@ module GHC.Internal.Stack (
 
     -- * HasCallStack call stacks
     CallStack, HasCallStack, callStack, emptyCallStack, freezeCallStack,
-    fromCallSiteList, getCallStack, popCallStack, prettyCallStack,
+    fromCallSiteList, getCallStack, popCallStack,
     pushCallStack, withFrozenCallStack,
+    prettyCallStackLines, prettyCallStack,
 
     -- * Source locations
     SrcLoc(..), prettySrcLoc,
@@ -48,11 +50,13 @@ module GHC.Internal.Stack (
     renderStack
   ) where
 
+import GHC.Internal.Show
 import GHC.Internal.Stack.CCS
 import GHC.Internal.Stack.Types
 import GHC.Internal.IO
 import GHC.Internal.Base
 import GHC.Internal.List
+import GHC.Internal.Data.OldList (intercalate)
 import GHC.Internal.Exception
 
 -- | Like the function 'error', but appends a stack trace to the error
@@ -104,3 +108,32 @@ withFrozenCallStack do_this =
   -- withFrozenCallStack's call-site
   let ?callStack = freezeCallStack (popCallStack callStack)
   in do_this
+
+-- prettySrcLoc and prettyCallStack are defined here to avoid hs-boot
+-- files. See Note [Definition of CallStack]
+
+-- | Pretty print a 'SrcLoc'.
+--
+-- @since 4.9.0.0
+prettySrcLoc :: SrcLoc -> String
+prettySrcLoc SrcLoc {..}
+  = foldr (++) ""
+      [ srcLocFile, ":"
+      , show srcLocStartLine, ":"
+      , show srcLocStartCol, " in "
+      , srcLocPackage, ":", srcLocModule
+      ]
+
+-- | Pretty print a 'CallStack'.
+--
+-- @since 4.9.0.0
+prettyCallStack :: CallStack -> String
+prettyCallStack = intercalate "\n" . prettyCallStackLines
+
+prettyCallStackLines :: CallStack -> [String]
+prettyCallStackLines cs = case getCallStack cs of
+  []  -> []
+  stk -> "CallStack (from HasCallStack):"
+       : map (("  " ++) . prettyCallSite) stk
+  where
+    prettyCallSite (f, loc) = f ++ ", called at " ++ prettySrcLoc loc

libraries/ghc-internal/src/GHC/Internal/Stack.hs-boot

+{-# LANGUAGE NoImplicitPrelude #-}
+
+module GHC.Internal.Stack where
+
+import GHC.Internal.Base
+import GHC.Internal.Stack.Types (CallStack, SrcLoc)
+
+prettyCallStackLines :: CallStack -> [String]
+prettyCallStack :: CallStack -> String
+prettySrcLoc :: SrcLoc -> String