-- 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.Platform where

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

import GHC.BaseDir
import GHC.Platform
import GHC.Settings.Utils

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

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

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

  Arch
targetArch <- String -> Either String Arch
forall a. (Show a, Read a) => String -> Either String a
readSetting String
"target arch"
  OS
targetOS <- String -> Either String OS
forall a. (Show a, Read a) => String -> Either String a
readSetting String
"target os"
  PlatformWordSize
targetWordSize <- String -> Either String PlatformWordSize
forall a. (Show a, Read a) => String -> Either String a
readSetting String
"target word size"
  Bool
targetWordBigEndian <- String -> Either String Bool
getBooleanSetting String
"target word big endian"
  Bool
targetLeadingUnderscore <- String -> Either String Bool
getBooleanSetting String
"Leading underscore"
  Bool
targetUnregisterised <- String -> Either String Bool
getBooleanSetting String
"Unregisterised"
  Bool
targetHasGnuNonexecStack <- String -> Either String Bool
getBooleanSetting String
"target has GNU nonexec stack"
  Bool
targetHasIdentDirective <- String -> Either String Bool
getBooleanSetting String
"target has .ident directive"
  Bool
targetHasSubsectionsViaSymbols <- String -> Either String Bool
getBooleanSetting String
"target has subsections via symbols"
  Bool
crossCompiling <- String -> Either String Bool
getBooleanSetting String
"cross compiling"
  Bool
tablesNextToCode <- String -> Either String Bool
getBooleanSetting String
"Tables next to code"

  Platform -> Either String Platform
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Platform -> Either String Platform)
-> Platform -> Either String Platform
forall a b. (a -> b) -> a -> b
$ Platform :: PlatformMini
-> PlatformWordSize
-> ByteOrder
-> Bool
-> Bool
-> 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
    , platformByteOrder :: ByteOrder
platformByteOrder = if Bool
targetWordBigEndian then ByteOrder
BigEndian else ByteOrder
LittleEndian
    , 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
    , platformLeadingUnderscore :: Bool
platformLeadingUnderscore = Bool
targetLeadingUnderscore
    , platformTablesNextToCode :: Bool
platformTablesNextToCode  = Bool
tablesNextToCode
    }

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

type RawSettings = Map String String

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

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

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

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