{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-missing-fields #-}
-- | Utility functions for working with the GHC AST
module Language.Haskell.Stylish.GHC
  ( dropAfterLocated
  , dropBeforeLocated
  , dropBeforeAndAfter
    -- * Unsafe getters
  , unsafeGetRealSrcSpan
  , getEndLineUnsafe
  , getStartLineUnsafe
    -- * Standard settings
  , baseDynFlags
    -- * Positions
  , unLocated
    -- * Outputable operators
  , showOutputable
  , compareOutputable
  ) where

--------------------------------------------------------------------------------
import           Data.Function     (on)

--------------------------------------------------------------------------------
import           DynFlags          (Settings (..), defaultDynFlags)
import qualified DynFlags          as GHC
import           FileSettings      (FileSettings (..))
import           GHC.Fingerprint   (fingerprint0)
import           GHC.Platform
import           GHC.Version       (cProjectVersion)
import           GhcNameVersion    (GhcNameVersion (..))
import qualified Outputable        as GHC
import           PlatformConstants (PlatformConstants (..))
import           SrcLoc            (GenLocated (..), Located, RealLocated,
                                    RealSrcSpan, SrcSpan (..), srcSpanEndLine,
                                    srcSpanStartLine)
import           ToolSettings      (ToolSettings (..))

unsafeGetRealSrcSpan :: Located a -> RealSrcSpan
unsafeGetRealSrcSpan :: Located a -> RealSrcSpan
unsafeGetRealSrcSpan = \case
  (L (RealSrcSpan RealSrcSpan
s) a
_) -> RealSrcSpan
s
  Located a
_                     -> [Char] -> RealSrcSpan
forall a. HasCallStack => [Char] -> a
error [Char]
"could not get source code location"

getStartLineUnsafe :: Located a -> Int
getStartLineUnsafe :: Located a -> Int
getStartLineUnsafe = RealSrcSpan -> Int
srcSpanStartLine (RealSrcSpan -> Int)
-> (Located a -> RealSrcSpan) -> Located a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> RealSrcSpan
forall a. Located a -> RealSrcSpan
unsafeGetRealSrcSpan

getEndLineUnsafe :: Located a -> Int
getEndLineUnsafe :: Located a -> Int
getEndLineUnsafe = RealSrcSpan -> Int
srcSpanEndLine (RealSrcSpan -> Int)
-> (Located a -> RealSrcSpan) -> Located a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located a -> RealSrcSpan
forall a. Located a -> RealSrcSpan
unsafeGetRealSrcSpan

dropAfterLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropAfterLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropAfterLocated Maybe (Located a)
loc [RealLocated b]
xs = case Maybe (Located a)
loc of
  Just (L (RealSrcSpan RealSrcSpan
rloc) a
_) ->
    (RealLocated b -> Bool) -> [RealLocated b] -> [RealLocated b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(L RealSrcSpan
x b
_) -> RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
rloc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
x) [RealLocated b]
xs
  Maybe (Located a)
_ -> [RealLocated b]
xs

dropBeforeLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropBeforeLocated :: Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropBeforeLocated Maybe (Located a)
loc [RealLocated b]
xs = case Maybe (Located a)
loc of
  Just (L (RealSrcSpan RealSrcSpan
rloc) a
_) ->
    (RealLocated b -> Bool) -> [RealLocated b] -> [RealLocated b]
forall a. (a -> Bool) -> [a] -> [a]
filter (\(L RealSrcSpan
x b
_) -> RealSrcSpan -> Int
srcSpanStartLine RealSrcSpan
rloc Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= RealSrcSpan -> Int
srcSpanEndLine RealSrcSpan
x) [RealLocated b]
xs
  Maybe (Located a)
_ -> [RealLocated b]
xs

dropBeforeAndAfter :: Located a -> [RealLocated b] -> [RealLocated b]
dropBeforeAndAfter :: Located a -> [RealLocated b] -> [RealLocated b]
dropBeforeAndAfter Located a
loc = Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
forall a b. Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropBeforeLocated (Located a -> Maybe (Located a)
forall a. a -> Maybe a
Just Located a
loc) ([RealLocated b] -> [RealLocated b])
-> ([RealLocated b] -> [RealLocated b])
-> [RealLocated b]
-> [RealLocated b]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
forall a b. Maybe (Located a) -> [RealLocated b] -> [RealLocated b]
dropAfterLocated (Located a -> Maybe (Located a)
forall a. a -> Maybe a
Just Located a
loc)

baseDynFlags :: GHC.DynFlags
baseDynFlags :: DynFlags
baseDynFlags = Settings -> LlvmConfig -> DynFlags
defaultDynFlags Settings
fakeSettings LlvmConfig
llvmConfig
  where
    fakeSettings :: Settings
fakeSettings = Settings :: GhcNameVersion
-> FileSettings
-> Platform
-> ToolSettings
-> PlatformMisc
-> PlatformConstants
-> [([Char], [Char])]
-> Settings
GHC.Settings
      { sGhcNameVersion :: GhcNameVersion
sGhcNameVersion = [Char] -> [Char] -> GhcNameVersion
GhcNameVersion [Char]
"stylish-haskell" [Char]
cProjectVersion
      , sFileSettings :: FileSettings
sFileSettings = FileSettings :: [Char]
-> [Char]
-> Maybe [Char]
-> [Char]
-> [Char]
-> [Char]
-> FileSettings
FileSettings {}
      , sToolSettings :: ToolSettings
sToolSettings = ToolSettings :: Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [Char]
-> ([Char], [Option])
-> [Char]
-> [Char]
-> ([Char], [Option])
-> ([Char], [Option])
-> ([Char], [Option])
-> ([Char], [Option])
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> [Char]
-> ([Char], [Option])
-> ([Char], [Option])
-> ([Char], [Option])
-> [Char]
-> [[Char]]
-> [[Char]]
-> Fingerprint
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> [[Char]]
-> ToolSettings
ToolSettings
        { toolSettings_opt_P_fingerprint :: Fingerprint
toolSettings_opt_P_fingerprint = Fingerprint
fingerprint0,
          toolSettings_pgm_F :: [Char]
toolSettings_pgm_F = [Char]
""
        }
      , sPlatformConstants :: PlatformConstants
sPlatformConstants = PlatformConstants :: Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Bool
-> Bool
-> Int
-> Integer
-> Integer
-> Integer
-> PlatformConstants
PlatformConstants
        { pc_DYNAMIC_BY_DEFAULT :: Bool
pc_DYNAMIC_BY_DEFAULT = Bool
False
        , pc_WORD_SIZE :: Int
pc_WORD_SIZE = Int
8
        }
      , sTargetPlatform :: Platform
sTargetPlatform = Platform :: PlatformMini
-> PlatformWordSize
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Platform
Platform
        { platformMini :: PlatformMini
platformMini = PlatformMini :: Arch -> OS -> PlatformMini
PlatformMini
          { platformMini_arch :: Arch
platformMini_arch = Arch
ArchUnknown
          , platformMini_os :: OS
platformMini_os = OS
OSUnknown
          }
        , platformWordSize :: PlatformWordSize
platformWordSize = PlatformWordSize
PW8
        , platformUnregisterised :: Bool
platformUnregisterised = Bool
True
        , platformHasIdentDirective :: Bool
platformHasIdentDirective = Bool
False
        , platformHasSubsectionsViaSymbols :: Bool
platformHasSubsectionsViaSymbols = Bool
False
        , platformIsCrossCompiling :: Bool
platformIsCrossCompiling = Bool
False
        }
      , sPlatformMisc :: PlatformMisc
sPlatformMisc = PlatformMisc :: [Char]
-> [Char]
-> IntegerLibrary
-> Bool
-> Bool
-> Bool
-> [Char]
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> [Char]
-> PlatformMisc
PlatformMisc {}
      , sRawSettings :: [([Char], [Char])]
sRawSettings = []
      }

    llvmConfig :: LlvmConfig
llvmConfig = [([Char], LlvmTarget)] -> [(Int, [Char])] -> LlvmConfig
GHC.LlvmConfig [] []

unLocated :: Located a -> a
unLocated :: Located a -> a
unLocated (L SrcSpan
_ a
a) = a
a

showOutputable :: GHC.Outputable a => a -> String
showOutputable :: a -> [Char]
showOutputable = DynFlags -> a -> [Char]
forall a. Outputable a => DynFlags -> a -> [Char]
GHC.showPpr DynFlags
baseDynFlags

compareOutputable :: GHC.Outputable a => a -> a -> Ordering
compareOutputable :: a -> a -> Ordering
compareOutputable = [Char] -> [Char] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ([Char] -> [Char] -> Ordering)
-> (a -> [Char]) -> a -> a -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` a -> [Char]
forall a. Outputable a => a -> [Char]
showOutputable