{-# LANGUAGE LambdaCase #-}
{-# OPTIONS_GHC -Wno-missing-fields #-}
module Language.Haskell.Stylish.GHC
( dropAfterLocated
, dropBeforeLocated
, dropBeforeAndAfter
, unsafeGetRealSrcSpan
, getEndLineUnsafe
, getStartLineUnsafe
, baseDynFlags
, unLocated
, 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