-- Note [Settings file]
-- ~~~~~~~~~~~~~~~~~~~~
--
-- GHC has a file, `${top_dir}/settings`, which is the main source of run-time
-- configuration. ghc-pkg needs just a little bit of it: the target platform CPU
-- arch and OS. It uses that to figure out what subdirectory of `~/.ghc` is
-- associated with the current version/target.
--
-- This module has just enough code to read key value pairs from the settings
-- file, and read the target platform from those pairs.
--
-- The  "0" suffix is because the caller will partially apply it, and that will
-- in turn be used a few more times.
module GHC.Settings where

import Prelude -- See Note [Why do we import Prelude here?]

import GHC.BaseDir
import GHC.Platform

import Data.Char (isSpace)
import Data.Map (Map)
import qualified Data.Map as Map

-----------------------------------------------------------------------------
-- parts of settings file

getTargetPlatform
  :: FilePath -> RawSettings -> Either String Platform
getTargetPlatform :: FilePath -> RawSettings -> Either FilePath Platform
getTargetPlatform FilePath
settingsFile RawSettings
mySettings = do
  let
    getBooleanSetting :: FilePath -> Either FilePath Bool
getBooleanSetting = FilePath -> RawSettings -> FilePath -> Either FilePath Bool
getBooleanSetting0 FilePath
settingsFile RawSettings
mySettings
    readSetting :: (Show a, Read a) => String -> Either String a
    readSetting :: FilePath -> Either FilePath a
readSetting = FilePath -> RawSettings -> FilePath -> Either FilePath a
forall a.
(Show a, Read a) =>
FilePath -> RawSettings -> FilePath -> Either FilePath a
readSetting0 FilePath
settingsFile RawSettings
mySettings

  Arch
targetArch <- FilePath -> Either FilePath Arch
forall a. (Show a, Read a) => FilePath -> Either FilePath a
readSetting FilePath
"target arch"
  OS
targetOS <- FilePath -> Either FilePath OS
forall a. (Show a, Read a) => FilePath -> Either FilePath a
readSetting FilePath
"target os"
  PlatformWordSize
targetWordSize <- FilePath -> Either FilePath PlatformWordSize
forall a. (Show a, Read a) => FilePath -> Either FilePath a
readSetting FilePath
"target word size"
  Bool
targetUnregisterised <- FilePath -> Either FilePath Bool
getBooleanSetting FilePath
"Unregisterised"
  Bool
targetHasGnuNonexecStack <- FilePath -> Either FilePath Bool
getBooleanSetting FilePath
"target has GNU nonexec stack"
  Bool
targetHasIdentDirective <- FilePath -> Either FilePath Bool
getBooleanSetting FilePath
"target has .ident directive"
  Bool
targetHasSubsectionsViaSymbols <- FilePath -> Either FilePath Bool
getBooleanSetting FilePath
"target has subsections via symbols"
  Bool
crossCompiling <- FilePath -> Either FilePath Bool
getBooleanSetting FilePath
"cross compiling"

  Platform -> Either FilePath Platform
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Either FilePath Platform)
-> Platform -> Either FilePath Platform
forall a b. (a -> b) -> a -> b
$ Platform :: PlatformMini
-> PlatformWordSize
-> Bool
-> Bool
-> Bool
-> Bool
-> Bool
-> Platform
Platform
    { platformMini :: PlatformMini
platformMini = PlatformMini :: Arch -> OS -> PlatformMini
PlatformMini
      { platformMini_arch :: Arch
platformMini_arch = Arch
targetArch
      , platformMini_os :: OS
platformMini_os = OS
targetOS
      }
    , platformWordSize :: PlatformWordSize
platformWordSize = PlatformWordSize
targetWordSize
    , platformUnregisterised :: Bool
platformUnregisterised = Bool
targetUnregisterised
    , platformHasGnuNonexecStack :: Bool
platformHasGnuNonexecStack = Bool
targetHasGnuNonexecStack
    , platformHasIdentDirective :: Bool
platformHasIdentDirective = Bool
targetHasIdentDirective
    , platformHasSubsectionsViaSymbols :: Bool
platformHasSubsectionsViaSymbols = Bool
targetHasSubsectionsViaSymbols
    , platformIsCrossCompiling :: Bool
platformIsCrossCompiling = Bool
crossCompiling
    }

-----------------------------------------------------------------------------
-- settings file helpers

type RawSettings = Map String String

-- | See Note [Settings file] for "0" suffix
getSetting0
  :: FilePath -> RawSettings -> String -> Either String String
getSetting0 :: FilePath -> RawSettings -> FilePath -> Either FilePath FilePath
getSetting0 FilePath
settingsFile RawSettings
mySettings FilePath
key = case FilePath -> RawSettings -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
key RawSettings
mySettings of
  Just FilePath
xs -> FilePath -> Either FilePath FilePath
forall a b. b -> Either a b
Right FilePath
xs
  Maybe FilePath
Nothing -> FilePath -> Either FilePath FilePath
forall a b. a -> Either a b
Left (FilePath -> Either FilePath FilePath)
-> FilePath -> Either FilePath FilePath
forall a b. (a -> b) -> a -> b
$ FilePath
"No entry for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
settingsFile

-- | See Note [Settings file] for "0" suffix
getFilePathSetting0
  :: FilePath -> FilePath -> RawSettings -> String -> Either String String
getFilePathSetting0 :: FilePath
-> FilePath -> RawSettings -> FilePath -> Either FilePath FilePath
getFilePathSetting0 FilePath
top_dir FilePath
settingsFile RawSettings
mySettings FilePath
key =
  FilePath -> FilePath -> FilePath
expandTopDir FilePath
top_dir (FilePath -> FilePath)
-> Either FilePath FilePath -> Either FilePath FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> RawSettings -> FilePath -> Either FilePath FilePath
getSetting0 FilePath
settingsFile RawSettings
mySettings FilePath
key

-- | See Note [Settings file] for "0" suffix
getBooleanSetting0
  :: FilePath -> RawSettings -> String -> Either String Bool
getBooleanSetting0 :: FilePath -> RawSettings -> FilePath -> Either FilePath Bool
getBooleanSetting0 FilePath
settingsFile RawSettings
mySettings FilePath
key = do
  FilePath
rawValue <- FilePath -> RawSettings -> FilePath -> Either FilePath FilePath
getSetting0 FilePath
settingsFile RawSettings
mySettings FilePath
key
  case FilePath
rawValue of
    FilePath
"YES" -> Bool -> Either FilePath Bool
forall a b. b -> Either a b
Right Bool
True
    FilePath
"NO" -> Bool -> Either FilePath Bool
forall a b. b -> Either a b
Right Bool
False
    FilePath
xs -> FilePath -> Either FilePath Bool
forall a b. a -> Either a b
Left (FilePath -> Either FilePath Bool)
-> FilePath -> Either FilePath Bool
forall a b. (a -> b) -> a -> b
$ FilePath
"Bad value for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
xs

-- | See Note [Settings file] for "0" suffix
readSetting0
  :: (Show a, Read a) => FilePath -> RawSettings -> String -> Either String a
readSetting0 :: FilePath -> RawSettings -> FilePath -> Either FilePath a
readSetting0 FilePath
settingsFile RawSettings
mySettings FilePath
key = case FilePath -> RawSettings -> Maybe FilePath
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup FilePath
key RawSettings
mySettings of
  Just FilePath
xs -> case FilePath -> Maybe a
forall a. Read a => FilePath -> Maybe a
maybeRead FilePath
xs of
    Just a
v -> a -> Either FilePath a
forall a b. b -> Either a b
Right a
v
    Maybe a
Nothing -> FilePath -> Either FilePath a
forall a b. a -> Either a b
Left (FilePath -> Either FilePath a) -> FilePath -> Either FilePath a
forall a b. (a -> b) -> a -> b
$ FilePath
"Failed to read " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" value " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
xs
  Maybe FilePath
Nothing -> FilePath -> Either FilePath a
forall a b. a -> Either a b
Left (FilePath -> Either FilePath a) -> FilePath -> Either FilePath a
forall a b. (a -> b) -> a -> b
$ FilePath
"No entry for " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
key FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" in " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
settingsFile

-----------------------------------------------------------------------------
-- read helpers

maybeRead :: Read a => String -> Maybe a
maybeRead :: FilePath -> Maybe a
maybeRead FilePath
str = case ReadS a
forall a. Read a => ReadS a
reads FilePath
str of
  [(a
x, FilePath
"")] -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  [(a, FilePath)]
_ -> Maybe a
forall a. Maybe a
Nothing

maybeReadFuzzy :: Read a => String -> Maybe a
maybeReadFuzzy :: FilePath -> Maybe a
maybeReadFuzzy FilePath
str = case ReadS a
forall a. Read a => ReadS a
reads FilePath
str of
  [(a
x, FilePath
s)] | (Char -> Bool) -> FilePath -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace FilePath
s -> a -> Maybe a
forall a. a -> Maybe a
Just a
x
  [(a, FilePath)]
_ -> Maybe a
forall a. Maybe a
Nothing