{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE RecordWildCards #-}

-- |
-- Module      :  Distribution.Client.CmdPath
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- Implementation of the 'path' command. Query for project configuration
-- information.
module Distribution.Client.CmdPath
  ( pathCommand
  , pathAction
  ) where

import Distribution.Client.Compat.Prelude
import Prelude ()

import Distribution.Client.CmdInstall.ClientInstallFlags
  ( cinstInstalldir
  )
import Distribution.Client.Config
  ( defaultCacheHome
  , defaultInstallPath
  , defaultStoreDir
  , getConfigFilePath
  )
import Distribution.Client.DistDirLayout (CabalDirLayout (..), distProjectRootDirectory)
import Distribution.Client.Errors
import Distribution.Client.GlobalFlags
import Distribution.Client.NixStyleOptions
  ( NixStyleFlags (..)
  , defaultNixStyleFlags
  , nixStyleOptions
  )
import Distribution.Client.ProjectConfig.Types
  ( ProjectConfig (..)
  , ProjectConfigBuildOnly (..)
  , ProjectConfigShared (..)
  )
import Distribution.Client.ProjectOrchestration
import Distribution.Client.ProjectPlanning
import Distribution.Client.RebuildMonad (runRebuild)
import Distribution.Client.ScriptUtils
import Distribution.Client.Setup
  ( ConfigFlags (..)
  , yesNoOpt
  )
import Distribution.Client.Utils.Json
  ( (.=)
  )
import qualified Distribution.Client.Utils.Json as Json
import Distribution.Client.Version
  ( cabalInstallVersion
  )
import Distribution.ReadE
  ( ReadE (ReadE)
  )
import Distribution.Simple.Command
  ( CommandUI (..)
  , OptionField
  , ShowOrParseArgs
  , noArg
  , option
  , reqArg
  )
import Distribution.Simple.Compiler
import Distribution.Simple.Flag
  ( Flag (..)
  , flagToList
  , fromFlagOrDefault
  )
import Distribution.Simple.Program
import Distribution.Simple.Utils
  ( die'
  , dieWithException
  , withOutputMarker
  , wrapText
  )
import Distribution.Verbosity
  ( normal
  )

-------------------------------------------------------------------------------
-- Command
-------------------------------------------------------------------------------

pathCommand :: CommandUI (NixStyleFlags PathFlags)
pathCommand :: CommandUI (NixStyleFlags PathFlags)
pathCommand =
  CommandUI
    { commandName :: String
commandName = String
"path"
    , commandSynopsis :: String
commandSynopsis = String
"Query for simple project information"
    , commandDescription :: Maybe (String -> String)
commandDescription = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
_ ->
        String -> String
wrapText (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$
          String
"Query for configuration and project information such as project GHC.\n"
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"The output order of query keys is implementation defined and should not be relied on.\n"
    , commandNotes :: Maybe (String -> String)
commandNotes = (String -> String) -> Maybe (String -> String)
forall a. a -> Maybe a
Just ((String -> String) -> Maybe (String -> String))
-> (String -> String) -> Maybe (String -> String)
forall a b. (a -> b) -> a -> b
$ \String
pname ->
        String
"Examples:\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pname
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" path --store-dir\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"    Print the store-dir location of cabal.\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pname
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" path --output-format=json --compiler-info\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"    Print compiler information in json format.\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pname
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" path --output-format=json --installdir --compiler-info\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"    Print compiler information and installation directory in json format.\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pname
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" path --output-format=key-value --installdir\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"    Print the installation directory, taking project information into account.\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"  "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pname
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" path -z --output-format=key-value --installdir\n"
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"    Print the installation directory, without taking project information into account.\n"
    , commandUsage :: String -> String
commandUsage = \String
pname ->
        String
"Usage: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
pname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" path [FLAGS]\n"
    , commandDefaultFlags :: NixStyleFlags PathFlags
commandDefaultFlags = PathFlags -> NixStyleFlags PathFlags
forall a. a -> NixStyleFlags a
defaultNixStyleFlags PathFlags
defaultPathFlags
    , commandOptions :: ShowOrParseArgs -> [OptionField (NixStyleFlags PathFlags)]
commandOptions = (ShowOrParseArgs -> [OptionField PathFlags])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags PathFlags)]
forall a.
(ShowOrParseArgs -> [OptionField a])
-> ShowOrParseArgs -> [OptionField (NixStyleFlags a)]
nixStyleOptions ShowOrParseArgs -> [OptionField PathFlags]
pathOptions
    }

-------------------------------------------------------------------------------
-- Flags
-------------------------------------------------------------------------------

data PathOutputFormat
  = JSON
  | KeyValue
  deriving (PathOutputFormat -> PathOutputFormat -> Bool
(PathOutputFormat -> PathOutputFormat -> Bool)
-> (PathOutputFormat -> PathOutputFormat -> Bool)
-> Eq PathOutputFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathOutputFormat -> PathOutputFormat -> Bool
== :: PathOutputFormat -> PathOutputFormat -> Bool
$c/= :: PathOutputFormat -> PathOutputFormat -> Bool
/= :: PathOutputFormat -> PathOutputFormat -> Bool
Eq, Eq PathOutputFormat
Eq PathOutputFormat =>
(PathOutputFormat -> PathOutputFormat -> Ordering)
-> (PathOutputFormat -> PathOutputFormat -> Bool)
-> (PathOutputFormat -> PathOutputFormat -> Bool)
-> (PathOutputFormat -> PathOutputFormat -> Bool)
-> (PathOutputFormat -> PathOutputFormat -> Bool)
-> (PathOutputFormat -> PathOutputFormat -> PathOutputFormat)
-> (PathOutputFormat -> PathOutputFormat -> PathOutputFormat)
-> Ord PathOutputFormat
PathOutputFormat -> PathOutputFormat -> Bool
PathOutputFormat -> PathOutputFormat -> Ordering
PathOutputFormat -> PathOutputFormat -> PathOutputFormat
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathOutputFormat -> PathOutputFormat -> Ordering
compare :: PathOutputFormat -> PathOutputFormat -> Ordering
$c< :: PathOutputFormat -> PathOutputFormat -> Bool
< :: PathOutputFormat -> PathOutputFormat -> Bool
$c<= :: PathOutputFormat -> PathOutputFormat -> Bool
<= :: PathOutputFormat -> PathOutputFormat -> Bool
$c> :: PathOutputFormat -> PathOutputFormat -> Bool
> :: PathOutputFormat -> PathOutputFormat -> Bool
$c>= :: PathOutputFormat -> PathOutputFormat -> Bool
>= :: PathOutputFormat -> PathOutputFormat -> Bool
$cmax :: PathOutputFormat -> PathOutputFormat -> PathOutputFormat
max :: PathOutputFormat -> PathOutputFormat -> PathOutputFormat
$cmin :: PathOutputFormat -> PathOutputFormat -> PathOutputFormat
min :: PathOutputFormat -> PathOutputFormat -> PathOutputFormat
Ord, Int -> PathOutputFormat -> String -> String
[PathOutputFormat] -> String -> String
PathOutputFormat -> String
(Int -> PathOutputFormat -> String -> String)
-> (PathOutputFormat -> String)
-> ([PathOutputFormat] -> String -> String)
-> Show PathOutputFormat
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PathOutputFormat -> String -> String
showsPrec :: Int -> PathOutputFormat -> String -> String
$cshow :: PathOutputFormat -> String
show :: PathOutputFormat -> String
$cshowList :: [PathOutputFormat] -> String -> String
showList :: [PathOutputFormat] -> String -> String
Show, ReadPrec [PathOutputFormat]
ReadPrec PathOutputFormat
Int -> ReadS PathOutputFormat
ReadS [PathOutputFormat]
(Int -> ReadS PathOutputFormat)
-> ReadS [PathOutputFormat]
-> ReadPrec PathOutputFormat
-> ReadPrec [PathOutputFormat]
-> Read PathOutputFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PathOutputFormat
readsPrec :: Int -> ReadS PathOutputFormat
$creadList :: ReadS [PathOutputFormat]
readList :: ReadS [PathOutputFormat]
$creadPrec :: ReadPrec PathOutputFormat
readPrec :: ReadPrec PathOutputFormat
$creadListPrec :: ReadPrec [PathOutputFormat]
readListPrec :: ReadPrec [PathOutputFormat]
Read, Int -> PathOutputFormat
PathOutputFormat -> Int
PathOutputFormat -> [PathOutputFormat]
PathOutputFormat -> PathOutputFormat
PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
PathOutputFormat
-> PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
(PathOutputFormat -> PathOutputFormat)
-> (PathOutputFormat -> PathOutputFormat)
-> (Int -> PathOutputFormat)
-> (PathOutputFormat -> Int)
-> (PathOutputFormat -> [PathOutputFormat])
-> (PathOutputFormat -> PathOutputFormat -> [PathOutputFormat])
-> (PathOutputFormat -> PathOutputFormat -> [PathOutputFormat])
-> (PathOutputFormat
    -> PathOutputFormat -> PathOutputFormat -> [PathOutputFormat])
-> Enum PathOutputFormat
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: PathOutputFormat -> PathOutputFormat
succ :: PathOutputFormat -> PathOutputFormat
$cpred :: PathOutputFormat -> PathOutputFormat
pred :: PathOutputFormat -> PathOutputFormat
$ctoEnum :: Int -> PathOutputFormat
toEnum :: Int -> PathOutputFormat
$cfromEnum :: PathOutputFormat -> Int
fromEnum :: PathOutputFormat -> Int
$cenumFrom :: PathOutputFormat -> [PathOutputFormat]
enumFrom :: PathOutputFormat -> [PathOutputFormat]
$cenumFromThen :: PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
enumFromThen :: PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
$cenumFromTo :: PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
enumFromTo :: PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
$cenumFromThenTo :: PathOutputFormat
-> PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
enumFromThenTo :: PathOutputFormat
-> PathOutputFormat -> PathOutputFormat -> [PathOutputFormat]
Enum, PathOutputFormat
PathOutputFormat -> PathOutputFormat -> Bounded PathOutputFormat
forall a. a -> a -> Bounded a
$cminBound :: PathOutputFormat
minBound :: PathOutputFormat
$cmaxBound :: PathOutputFormat
maxBound :: PathOutputFormat
Bounded)

data PathFlags = PathFlags
  { PathFlags -> Flag Bool
pathCompiler :: Flag Bool
  , PathFlags -> Flag PathOutputFormat
pathOutputFormat :: Flag PathOutputFormat
  , PathFlags -> Flag [ConfigPath]
pathDirectories :: Flag [ConfigPath]
  }
  deriving (PathFlags -> PathFlags -> Bool
(PathFlags -> PathFlags -> Bool)
-> (PathFlags -> PathFlags -> Bool) -> Eq PathFlags
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathFlags -> PathFlags -> Bool
== :: PathFlags -> PathFlags -> Bool
$c/= :: PathFlags -> PathFlags -> Bool
/= :: PathFlags -> PathFlags -> Bool
Eq, Int -> PathFlags -> String -> String
[PathFlags] -> String -> String
PathFlags -> String
(Int -> PathFlags -> String -> String)
-> (PathFlags -> String)
-> ([PathFlags] -> String -> String)
-> Show PathFlags
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PathFlags -> String -> String
showsPrec :: Int -> PathFlags -> String -> String
$cshow :: PathFlags -> String
show :: PathFlags -> String
$cshowList :: [PathFlags] -> String -> String
showList :: [PathFlags] -> String -> String
Show)

defaultPathFlags :: PathFlags
defaultPathFlags :: PathFlags
defaultPathFlags =
  PathFlags
    { pathCompiler :: Flag Bool
pathCompiler = Flag Bool
forall a. Monoid a => a
mempty
    , pathOutputFormat :: Flag PathOutputFormat
pathOutputFormat = Flag PathOutputFormat
forall a. Monoid a => a
mempty
    , pathDirectories :: Flag [ConfigPath]
pathDirectories = Flag [ConfigPath]
forall a. Monoid a => a
mempty
    }

pathOutputFormatParser :: ReadE (Flag PathOutputFormat)
pathOutputFormatParser :: ReadE (Flag PathOutputFormat)
pathOutputFormatParser = (String -> Either String (Flag PathOutputFormat))
-> ReadE (Flag PathOutputFormat)
forall a. (String -> Either String a) -> ReadE a
ReadE ((String -> Either String (Flag PathOutputFormat))
 -> ReadE (Flag PathOutputFormat))
-> (String -> Either String (Flag PathOutputFormat))
-> ReadE (Flag PathOutputFormat)
forall a b. (a -> b) -> a -> b
$ \case
  String
"json" -> Flag PathOutputFormat -> Either String (Flag PathOutputFormat)
forall a b. b -> Either a b
Right (Flag PathOutputFormat -> Either String (Flag PathOutputFormat))
-> Flag PathOutputFormat -> Either String (Flag PathOutputFormat)
forall a b. (a -> b) -> a -> b
$ PathOutputFormat -> Flag PathOutputFormat
forall a. a -> Flag a
Flag PathOutputFormat
JSON
  String
"key-value" -> Flag PathOutputFormat -> Either String (Flag PathOutputFormat)
forall a b. b -> Either a b
Right (Flag PathOutputFormat -> Either String (Flag PathOutputFormat))
-> Flag PathOutputFormat -> Either String (Flag PathOutputFormat)
forall a b. (a -> b) -> a -> b
$ PathOutputFormat -> Flag PathOutputFormat
forall a. a -> Flag a
Flag PathOutputFormat
KeyValue
  String
policy ->
    String -> Either String (Flag PathOutputFormat)
forall a b. a -> Either a b
Left (String -> Either String (Flag PathOutputFormat))
-> String -> Either String (Flag PathOutputFormat)
forall a b. (a -> b) -> a -> b
$
      String
"Cannot parse the status output format '"
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
policy
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"'"

pathOutputFormatString :: PathOutputFormat -> String
pathOutputFormatString :: PathOutputFormat -> String
pathOutputFormatString PathOutputFormat
JSON = String
"json"
pathOutputFormatString PathOutputFormat
KeyValue = String
"key-value"

pathOutputFormatPrinter
  :: Flag PathOutputFormat -> [String]
pathOutputFormatPrinter :: Flag PathOutputFormat -> [String]
pathOutputFormatPrinter = \case
  (Flag PathOutputFormat
format) -> [PathOutputFormat -> String
pathOutputFormatString PathOutputFormat
format]
  Flag PathOutputFormat
NoFlag -> []

pathOptions :: ShowOrParseArgs -> [OptionField PathFlags]
pathOptions :: ShowOrParseArgs -> [OptionField PathFlags]
pathOptions ShowOrParseArgs
showOrParseArgs =
  [ String
-> [String]
-> String
-> (PathFlags -> Flag PathOutputFormat)
-> (Flag PathOutputFormat -> PathFlags -> PathFlags)
-> MkOptDescr
     (PathFlags -> Flag PathOutputFormat)
     (Flag PathOutputFormat -> PathFlags -> PathFlags)
     PathFlags
-> OptionField PathFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [String
"output-format"]
      String
"Output format of the requested path locations"
      PathFlags -> Flag PathOutputFormat
pathOutputFormat
      (\Flag PathOutputFormat
v PathFlags
flags -> PathFlags
flags{pathOutputFormat = v})
      ( String
-> ReadE (Flag PathOutputFormat)
-> (Flag PathOutputFormat -> [String])
-> MkOptDescr
     (PathFlags -> Flag PathOutputFormat)
     (Flag PathOutputFormat -> PathFlags -> PathFlags)
     PathFlags
forall b a.
Monoid b =>
String
-> ReadE b
-> (b -> [String])
-> MkOptDescr (a -> b) (b -> a -> a) a
reqArg
          (String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"|" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (PathOutputFormat -> String) -> [PathOutputFormat] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map PathOutputFormat -> String
pathOutputFormatString [PathOutputFormat
forall a. Bounded a => a
minBound .. PathOutputFormat
forall a. Bounded a => a
maxBound])
          ReadE (Flag PathOutputFormat)
pathOutputFormatParser
          Flag PathOutputFormat -> [String]
pathOutputFormatPrinter
      )
  , String
-> [String]
-> String
-> (PathFlags -> Flag Bool)
-> (Flag Bool -> PathFlags -> PathFlags)
-> MkOptDescr
     (PathFlags -> Flag Bool)
     (Flag Bool -> PathFlags -> PathFlags)
     PathFlags
-> OptionField PathFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
      []
      [String
"compiler-info"]
      String
"Print information of the project compiler"
      PathFlags -> Flag Bool
pathCompiler
      (\Flag Bool
v PathFlags
flags -> PathFlags
flags{pathCompiler = v})
      (ShowOrParseArgs
-> MkOptDescr
     (PathFlags -> Flag Bool)
     (Flag Bool -> PathFlags -> PathFlags)
     PathFlags
forall b.
ShowOrParseArgs
-> MkOptDescr (b -> Flag Bool) (Flag Bool -> b -> b) b
yesNoOpt ShowOrParseArgs
showOrParseArgs)
  ]
    [OptionField PathFlags]
-> [OptionField PathFlags] -> [OptionField PathFlags]
forall a. Semigroup a => a -> a -> a
<> (ConfigPath -> OptionField PathFlags)
-> [ConfigPath] -> [OptionField PathFlags]
forall a b. (a -> b) -> [a] -> [b]
map ConfigPath -> OptionField PathFlags
pathOption [ConfigPath
forall a. Bounded a => a
minBound .. ConfigPath
forall a. Bounded a => a
maxBound]
  where
    pathOption :: ConfigPath -> OptionField PathFlags
pathOption ConfigPath
s =
      String
-> [String]
-> String
-> (PathFlags -> Flag [ConfigPath])
-> (Flag [ConfigPath] -> PathFlags -> PathFlags)
-> MkOptDescr
     (PathFlags -> Flag [ConfigPath])
     (Flag [ConfigPath] -> PathFlags -> PathFlags)
     PathFlags
-> OptionField PathFlags
forall get set a.
String
-> [String]
-> String
-> get
-> set
-> MkOptDescr get set a
-> OptionField a
option
        []
        [ConfigPath -> String
pathName ConfigPath
s]
        (String
"Print cabal's " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> ConfigPath -> String
pathName ConfigPath
s)
        PathFlags -> Flag [ConfigPath]
pathDirectories
        (\Flag [ConfigPath]
v PathFlags
flags -> PathFlags
flags{pathDirectories = Flag $ concat (flagToList (pathDirectories flags) <> flagToList v)})
        (Flag [ConfigPath]
-> MkOptDescr
     (PathFlags -> Flag [ConfigPath])
     (Flag [ConfigPath] -> PathFlags -> PathFlags)
     PathFlags
forall b a. Eq b => b -> MkOptDescr (a -> b) (b -> a -> a) a
noArg ([ConfigPath] -> Flag [ConfigPath]
forall a. a -> Flag a
Flag [ConfigPath
s]))

-- | A path that can be retrieved by the @cabal path@ command.
data ConfigPath
  = ConfigPathCacheHome
  | ConfigPathRemoteRepoCache
  | ConfigPathLogsDir
  | ConfigPathStoreDir
  | ConfigPathConfigFile
  | ConfigPathInstallDir
  deriving (ConfigPath -> ConfigPath -> Bool
(ConfigPath -> ConfigPath -> Bool)
-> (ConfigPath -> ConfigPath -> Bool) -> Eq ConfigPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ConfigPath -> ConfigPath -> Bool
== :: ConfigPath -> ConfigPath -> Bool
$c/= :: ConfigPath -> ConfigPath -> Bool
/= :: ConfigPath -> ConfigPath -> Bool
Eq, Eq ConfigPath
Eq ConfigPath =>
(ConfigPath -> ConfigPath -> Ordering)
-> (ConfigPath -> ConfigPath -> Bool)
-> (ConfigPath -> ConfigPath -> Bool)
-> (ConfigPath -> ConfigPath -> Bool)
-> (ConfigPath -> ConfigPath -> Bool)
-> (ConfigPath -> ConfigPath -> ConfigPath)
-> (ConfigPath -> ConfigPath -> ConfigPath)
-> Ord ConfigPath
ConfigPath -> ConfigPath -> Bool
ConfigPath -> ConfigPath -> Ordering
ConfigPath -> ConfigPath -> ConfigPath
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ConfigPath -> ConfigPath -> Ordering
compare :: ConfigPath -> ConfigPath -> Ordering
$c< :: ConfigPath -> ConfigPath -> Bool
< :: ConfigPath -> ConfigPath -> Bool
$c<= :: ConfigPath -> ConfigPath -> Bool
<= :: ConfigPath -> ConfigPath -> Bool
$c> :: ConfigPath -> ConfigPath -> Bool
> :: ConfigPath -> ConfigPath -> Bool
$c>= :: ConfigPath -> ConfigPath -> Bool
>= :: ConfigPath -> ConfigPath -> Bool
$cmax :: ConfigPath -> ConfigPath -> ConfigPath
max :: ConfigPath -> ConfigPath -> ConfigPath
$cmin :: ConfigPath -> ConfigPath -> ConfigPath
min :: ConfigPath -> ConfigPath -> ConfigPath
Ord, Int -> ConfigPath -> String -> String
[ConfigPath] -> String -> String
ConfigPath -> String
(Int -> ConfigPath -> String -> String)
-> (ConfigPath -> String)
-> ([ConfigPath] -> String -> String)
-> Show ConfigPath
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ConfigPath -> String -> String
showsPrec :: Int -> ConfigPath -> String -> String
$cshow :: ConfigPath -> String
show :: ConfigPath -> String
$cshowList :: [ConfigPath] -> String -> String
showList :: [ConfigPath] -> String -> String
Show, Int -> ConfigPath
ConfigPath -> Int
ConfigPath -> [ConfigPath]
ConfigPath -> ConfigPath
ConfigPath -> ConfigPath -> [ConfigPath]
ConfigPath -> ConfigPath -> ConfigPath -> [ConfigPath]
(ConfigPath -> ConfigPath)
-> (ConfigPath -> ConfigPath)
-> (Int -> ConfigPath)
-> (ConfigPath -> Int)
-> (ConfigPath -> [ConfigPath])
-> (ConfigPath -> ConfigPath -> [ConfigPath])
-> (ConfigPath -> ConfigPath -> [ConfigPath])
-> (ConfigPath -> ConfigPath -> ConfigPath -> [ConfigPath])
-> Enum ConfigPath
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: ConfigPath -> ConfigPath
succ :: ConfigPath -> ConfigPath
$cpred :: ConfigPath -> ConfigPath
pred :: ConfigPath -> ConfigPath
$ctoEnum :: Int -> ConfigPath
toEnum :: Int -> ConfigPath
$cfromEnum :: ConfigPath -> Int
fromEnum :: ConfigPath -> Int
$cenumFrom :: ConfigPath -> [ConfigPath]
enumFrom :: ConfigPath -> [ConfigPath]
$cenumFromThen :: ConfigPath -> ConfigPath -> [ConfigPath]
enumFromThen :: ConfigPath -> ConfigPath -> [ConfigPath]
$cenumFromTo :: ConfigPath -> ConfigPath -> [ConfigPath]
enumFromTo :: ConfigPath -> ConfigPath -> [ConfigPath]
$cenumFromThenTo :: ConfigPath -> ConfigPath -> ConfigPath -> [ConfigPath]
enumFromThenTo :: ConfigPath -> ConfigPath -> ConfigPath -> [ConfigPath]
Enum, ConfigPath
ConfigPath -> ConfigPath -> Bounded ConfigPath
forall a. a -> a -> Bounded a
$cminBound :: ConfigPath
minBound :: ConfigPath
$cmaxBound :: ConfigPath
maxBound :: ConfigPath
Bounded)

-- | The configuration name for this path.
pathName :: ConfigPath -> String
pathName :: ConfigPath -> String
pathName ConfigPath
ConfigPathCacheHome = String
"cache-home"
pathName ConfigPath
ConfigPathRemoteRepoCache = String
"remote-repo-cache"
pathName ConfigPath
ConfigPathLogsDir = String
"logs-dir"
pathName ConfigPath
ConfigPathStoreDir = String
"store-dir"
pathName ConfigPath
ConfigPathConfigFile = String
"config-file"
pathName ConfigPath
ConfigPathInstallDir = String
"installdir"

-------------------------------------------------------------------------------
-- Action
-------------------------------------------------------------------------------

-- | Entry point for the 'path' command.
pathAction :: NixStyleFlags PathFlags -> [String] -> GlobalFlags -> IO ()
pathAction :: NixStyleFlags PathFlags -> [String] -> GlobalFlags -> IO ()
pathAction flags :: NixStyleFlags PathFlags
flags@NixStyleFlags{extraFlags :: forall a. NixStyleFlags a -> a
extraFlags = PathFlags
pathFlags', TestFlags
HaddockFlags
ConfigFlags
BenchmarkFlags
ProjectFlags
InstallFlags
ConfigExFlags
configFlags :: ConfigFlags
configExFlags :: ConfigExFlags
installFlags :: InstallFlags
haddockFlags :: HaddockFlags
testFlags :: TestFlags
benchmarkFlags :: BenchmarkFlags
projectFlags :: ProjectFlags
configFlags :: forall a. NixStyleFlags a -> ConfigFlags
configExFlags :: forall a. NixStyleFlags a -> ConfigExFlags
installFlags :: forall a. NixStyleFlags a -> InstallFlags
haddockFlags :: forall a. NixStyleFlags a -> HaddockFlags
testFlags :: forall a. NixStyleFlags a -> TestFlags
benchmarkFlags :: forall a. NixStyleFlags a -> BenchmarkFlags
projectFlags :: forall a. NixStyleFlags a -> ProjectFlags
..} [String]
cliTargetStrings GlobalFlags
globalFlags = AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags PathFlags
-> [String]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b.
AcceptNoTargets
-> Maybe ComponentKind
-> NixStyleFlags a
-> [String]
-> GlobalFlags
-> CurrentCommand
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO b)
-> IO b
withContextAndSelectors AcceptNoTargets
AcceptNoTargets Maybe ComponentKind
forall a. Maybe a
Nothing NixStyleFlags PathFlags
flags [] GlobalFlags
globalFlags CurrentCommand
OtherCommand ((TargetContext -> ProjectBaseContext -> [TargetSelector] -> IO ())
 -> IO ())
-> (TargetContext
    -> ProjectBaseContext -> [TargetSelector] -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \TargetContext
_ ProjectBaseContext
baseCtx [TargetSelector]
_ -> do
  let pathFlags :: PathFlags
pathFlags =
        if PathFlags -> Flag Bool
pathCompiler PathFlags
pathFlags' Flag Bool -> Flag Bool -> Bool
forall a. Eq a => a -> a -> Bool
== Flag Bool
forall a. Flag a
NoFlag Bool -> Bool -> Bool
&& PathFlags -> Flag [ConfigPath]
pathDirectories PathFlags
pathFlags' Flag [ConfigPath] -> Flag [ConfigPath] -> Bool
forall a. Eq a => a -> a -> Bool
== Flag [ConfigPath]
forall a. Flag a
NoFlag
          then -- if not a single key to query is given, query everything!

            PathFlags
pathFlags'
              { pathCompiler = Flag True
              , pathDirectories = Flag [minBound .. maxBound]
              }
          else PathFlags
pathFlags'
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cliTargetStrings) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
CmdPathAcceptsNoTargets
  Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (BuildTimeSettings -> Bool
buildSettingDryRun (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    Verbosity -> CabalInstallException -> IO ()
forall a1 a.
(HasCallStack, Show a1, Typeable a1,
 Exception (VerboseException a1)) =>
Verbosity -> a1 -> IO a
dieWithException Verbosity
verbosity CabalInstallException
CmdPathCommandDoesn'tSupportDryRun

  Maybe PathCompilerInfo
compilerPathOutputs <-
    if Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Flag Bool -> Bool
forall a. a -> Flag a -> a
fromFlagOrDefault Bool
False (PathFlags -> Flag Bool
pathCompiler PathFlags
pathFlags)
      then Maybe PathCompilerInfo -> IO (Maybe PathCompilerInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe PathCompilerInfo
forall a. Maybe a
Nothing
      else do
        (Compiler
compiler, Platform
_, ProgramDb
progDb) <- String
-> Rebuild (Compiler, Platform, ProgramDb)
-> IO (Compiler, Platform, ProgramDb)
forall a. String -> Rebuild a -> IO a
runRebuild (DistDirLayout -> String
distProjectRootDirectory (DistDirLayout -> String)
-> (ProjectBaseContext -> DistDirLayout)
-> ProjectBaseContext
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ProjectBaseContext -> DistDirLayout
distDirLayout (ProjectBaseContext -> String) -> ProjectBaseContext -> String
forall a b. (a -> b) -> a -> b
$ ProjectBaseContext
baseCtx) (Rebuild (Compiler, Platform, ProgramDb)
 -> IO (Compiler, Platform, ProgramDb))
-> Rebuild (Compiler, Platform, ProgramDb)
-> IO (Compiler, Platform, ProgramDb)
forall a b. (a -> b) -> a -> b
$ Verbosity
-> DistDirLayout
-> ProjectConfig
-> Rebuild (Compiler, Platform, ProgramDb)
configureCompiler Verbosity
verbosity (ProjectBaseContext -> DistDirLayout
distDirLayout ProjectBaseContext
baseCtx) (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
baseCtx)
        Program
compilerProg <- Verbosity -> Compiler -> IO Program
requireCompilerProg Verbosity
verbosity Compiler
compiler
        (ConfiguredProgram
configuredCompilerProg, ProgramDb
_) <- Verbosity
-> Program -> ProgramDb -> IO (ConfiguredProgram, ProgramDb)
requireProgram Verbosity
verbosity Program
compilerProg ProgramDb
progDb
        Maybe PathCompilerInfo -> IO (Maybe PathCompilerInfo)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe PathCompilerInfo -> IO (Maybe PathCompilerInfo))
-> Maybe PathCompilerInfo -> IO (Maybe PathCompilerInfo)
forall a b. (a -> b) -> a -> b
$ PathCompilerInfo -> Maybe PathCompilerInfo
forall a. a -> Maybe a
Just (PathCompilerInfo -> Maybe PathCompilerInfo)
-> PathCompilerInfo -> Maybe PathCompilerInfo
forall a b. (a -> b) -> a -> b
$ ConfiguredProgram -> Compiler -> PathCompilerInfo
mkCompilerInfo ConfiguredProgram
configuredCompilerProg Compiler
compiler

  [(String, String)]
paths <- [ConfigPath]
-> (ConfigPath -> IO (String, String)) -> IO [(String, String)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for ([ConfigPath] -> Flag [ConfigPath] -> [ConfigPath]
forall a. a -> Flag a -> a
fromFlagOrDefault [] (Flag [ConfigPath] -> [ConfigPath])
-> Flag [ConfigPath] -> [ConfigPath]
forall a b. (a -> b) -> a -> b
$ PathFlags -> Flag [ConfigPath]
pathDirectories PathFlags
pathFlags) ((ConfigPath -> IO (String, String)) -> IO [(String, String)])
-> (ConfigPath -> IO (String, String)) -> IO [(String, String)]
forall a b. (a -> b) -> a -> b
$ \ConfigPath
p -> do
    String
t <- ProjectBaseContext -> ConfigPath -> IO String
getPathLocation ProjectBaseContext
baseCtx ConfigPath
p
    (String, String) -> IO (String, String)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ConfigPath -> String
pathName ConfigPath
p, String
t)

  let pathOutputs :: PathOutputs
pathOutputs =
        PathOutputs
          { pathOutputsCompilerInfo :: Maybe PathCompilerInfo
pathOutputsCompilerInfo = Maybe PathCompilerInfo
compilerPathOutputs
          , pathOutputsConfigPaths :: [(String, String)]
pathOutputsConfigPaths = [(String, String)]
paths
          }

  let output :: String
output = case PathOutputFormat -> Flag PathOutputFormat -> PathOutputFormat
forall a. a -> Flag a -> a
fromFlagOrDefault PathOutputFormat
KeyValue (PathFlags -> Flag PathOutputFormat
pathOutputFormat PathFlags
pathFlags) of
        PathOutputFormat
JSON ->
          Value -> String
forall a. ToJSON a => a -> String
Json.encodeToString (PathOutputs -> Value
showAsJson PathOutputs
pathOutputs) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\n"
        PathOutputFormat
KeyValue -> do
          PathOutputs -> String
showAsKeyValuePair PathOutputs
pathOutputs

  String -> IO ()
putStr (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Verbosity -> String -> String
withOutputMarker Verbosity
verbosity String
output
  where
    verbosity :: Verbosity
verbosity = Verbosity -> Flag Verbosity -> Verbosity
forall a. a -> Flag a -> a
fromFlagOrDefault Verbosity
normal (ConfigFlags -> Flag Verbosity
configVerbosity ConfigFlags
configFlags)

-- | Find the FilePath location for common configuration paths.
--
-- TODO: this should come from a common source of truth to avoid code path divergence
getPathLocation :: ProjectBaseContext -> ConfigPath -> IO FilePath
getPathLocation :: ProjectBaseContext -> ConfigPath -> IO String
getPathLocation ProjectBaseContext
_ ConfigPath
ConfigPathCacheHome =
  IO String
defaultCacheHome
getPathLocation ProjectBaseContext
baseCtx ConfigPath
ConfigPathRemoteRepoCache =
  String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ BuildTimeSettings -> String
buildSettingCacheDir (ProjectBaseContext -> BuildTimeSettings
buildSettings ProjectBaseContext
baseCtx)
getPathLocation ProjectBaseContext
baseCtx ConfigPath
ConfigPathLogsDir =
  String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ CabalDirLayout -> String
cabalLogsDirectory (ProjectBaseContext -> CabalDirLayout
cabalDirLayout ProjectBaseContext
baseCtx)
getPathLocation ProjectBaseContext
baseCtx ConfigPath
ConfigPathStoreDir =
  IO String -> Flag (IO String) -> IO String
forall a. a -> Flag a -> a
fromFlagOrDefault
    IO String
defaultStoreDir
    (String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> Flag String -> Flag (IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ProjectConfigShared -> Flag String
projectConfigStoreDir (ProjectConfig -> ProjectConfigShared
projectConfigShared (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
baseCtx)))
getPathLocation ProjectBaseContext
baseCtx ConfigPath
ConfigPathConfigFile =
  Flag String -> IO String
getConfigFilePath (ProjectConfigShared -> Flag String
projectConfigConfigFile (ProjectConfig -> ProjectConfigShared
projectConfigShared (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
baseCtx)))
getPathLocation ProjectBaseContext
baseCtx ConfigPath
ConfigPathInstallDir =
  IO String -> Flag (IO String) -> IO String
forall a. a -> Flag a -> a
fromFlagOrDefault
    IO String
defaultInstallPath
    (String -> IO String
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> IO String) -> Flag String -> Flag (IO String)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ClientInstallFlags -> Flag String
cinstInstalldir (ProjectConfigBuildOnly -> ClientInstallFlags
projectConfigClientInstallFlags (ProjectConfigBuildOnly -> ClientInstallFlags)
-> ProjectConfigBuildOnly -> ClientInstallFlags
forall a b. (a -> b) -> a -> b
$ ProjectConfig -> ProjectConfigBuildOnly
projectConfigBuildOnly (ProjectBaseContext -> ProjectConfig
projectConfig ProjectBaseContext
baseCtx)))

-- ----------------------------------------------------------------------------
-- Helpers for determining compiler information
-- ----------------------------------------------------------------------------

requireCompilerProg :: Verbosity -> Compiler -> IO Program
requireCompilerProg :: Verbosity -> Compiler -> IO Program
requireCompilerProg Verbosity
verbosity Compiler
compiler =
  case Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler of
    CompilerFlavor
GHC -> Program -> IO Program
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
ghcProgram
    CompilerFlavor
GHCJS -> Program -> IO Program
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Program
ghcjsProgram
    CompilerFlavor
flavour ->
      Verbosity -> String -> IO Program
forall a. Verbosity -> String -> IO a
die' Verbosity
verbosity (String -> IO Program) -> String -> IO Program
forall a b. (a -> b) -> a -> b
$
        String
"path: Unsupported compiler flavour: "
          String -> String -> String
forall a. Semigroup a => a -> a -> a
<> CompilerFlavor -> String
forall a. Pretty a => a -> String
prettyShow CompilerFlavor
flavour

-- ----------------------------------------------------------------------------
-- Output
-- ----------------------------------------------------------------------------

data PathOutputs = PathOutputs
  { PathOutputs -> Maybe PathCompilerInfo
pathOutputsCompilerInfo :: Maybe PathCompilerInfo
  , PathOutputs -> [(String, String)]
pathOutputsConfigPaths :: [(String, FilePath)]
  }
  deriving (Int -> PathOutputs -> String -> String
[PathOutputs] -> String -> String
PathOutputs -> String
(Int -> PathOutputs -> String -> String)
-> (PathOutputs -> String)
-> ([PathOutputs] -> String -> String)
-> Show PathOutputs
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PathOutputs -> String -> String
showsPrec :: Int -> PathOutputs -> String -> String
$cshow :: PathOutputs -> String
show :: PathOutputs -> String
$cshowList :: [PathOutputs] -> String -> String
showList :: [PathOutputs] -> String -> String
Show, PathOutputs -> PathOutputs -> Bool
(PathOutputs -> PathOutputs -> Bool)
-> (PathOutputs -> PathOutputs -> Bool) -> Eq PathOutputs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathOutputs -> PathOutputs -> Bool
== :: PathOutputs -> PathOutputs -> Bool
$c/= :: PathOutputs -> PathOutputs -> Bool
/= :: PathOutputs -> PathOutputs -> Bool
Eq, Eq PathOutputs
Eq PathOutputs =>
(PathOutputs -> PathOutputs -> Ordering)
-> (PathOutputs -> PathOutputs -> Bool)
-> (PathOutputs -> PathOutputs -> Bool)
-> (PathOutputs -> PathOutputs -> Bool)
-> (PathOutputs -> PathOutputs -> Bool)
-> (PathOutputs -> PathOutputs -> PathOutputs)
-> (PathOutputs -> PathOutputs -> PathOutputs)
-> Ord PathOutputs
PathOutputs -> PathOutputs -> Bool
PathOutputs -> PathOutputs -> Ordering
PathOutputs -> PathOutputs -> PathOutputs
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathOutputs -> PathOutputs -> Ordering
compare :: PathOutputs -> PathOutputs -> Ordering
$c< :: PathOutputs -> PathOutputs -> Bool
< :: PathOutputs -> PathOutputs -> Bool
$c<= :: PathOutputs -> PathOutputs -> Bool
<= :: PathOutputs -> PathOutputs -> Bool
$c> :: PathOutputs -> PathOutputs -> Bool
> :: PathOutputs -> PathOutputs -> Bool
$c>= :: PathOutputs -> PathOutputs -> Bool
>= :: PathOutputs -> PathOutputs -> Bool
$cmax :: PathOutputs -> PathOutputs -> PathOutputs
max :: PathOutputs -> PathOutputs -> PathOutputs
$cmin :: PathOutputs -> PathOutputs -> PathOutputs
min :: PathOutputs -> PathOutputs -> PathOutputs
Ord)

data PathCompilerInfo = PathCompilerInfo
  { PathCompilerInfo -> CompilerFlavor
pathCompilerInfoFlavour :: CompilerFlavor
  , PathCompilerInfo -> CompilerId
pathCompilerInfoId :: CompilerId
  , PathCompilerInfo -> String
pathCompilerInfoPath :: FilePath
  }
  deriving (Int -> PathCompilerInfo -> String -> String
[PathCompilerInfo] -> String -> String
PathCompilerInfo -> String
(Int -> PathCompilerInfo -> String -> String)
-> (PathCompilerInfo -> String)
-> ([PathCompilerInfo] -> String -> String)
-> Show PathCompilerInfo
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> PathCompilerInfo -> String -> String
showsPrec :: Int -> PathCompilerInfo -> String -> String
$cshow :: PathCompilerInfo -> String
show :: PathCompilerInfo -> String
$cshowList :: [PathCompilerInfo] -> String -> String
showList :: [PathCompilerInfo] -> String -> String
Show, PathCompilerInfo -> PathCompilerInfo -> Bool
(PathCompilerInfo -> PathCompilerInfo -> Bool)
-> (PathCompilerInfo -> PathCompilerInfo -> Bool)
-> Eq PathCompilerInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PathCompilerInfo -> PathCompilerInfo -> Bool
== :: PathCompilerInfo -> PathCompilerInfo -> Bool
$c/= :: PathCompilerInfo -> PathCompilerInfo -> Bool
/= :: PathCompilerInfo -> PathCompilerInfo -> Bool
Eq, Eq PathCompilerInfo
Eq PathCompilerInfo =>
(PathCompilerInfo -> PathCompilerInfo -> Ordering)
-> (PathCompilerInfo -> PathCompilerInfo -> Bool)
-> (PathCompilerInfo -> PathCompilerInfo -> Bool)
-> (PathCompilerInfo -> PathCompilerInfo -> Bool)
-> (PathCompilerInfo -> PathCompilerInfo -> Bool)
-> (PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo)
-> (PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo)
-> Ord PathCompilerInfo
PathCompilerInfo -> PathCompilerInfo -> Bool
PathCompilerInfo -> PathCompilerInfo -> Ordering
PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: PathCompilerInfo -> PathCompilerInfo -> Ordering
compare :: PathCompilerInfo -> PathCompilerInfo -> Ordering
$c< :: PathCompilerInfo -> PathCompilerInfo -> Bool
< :: PathCompilerInfo -> PathCompilerInfo -> Bool
$c<= :: PathCompilerInfo -> PathCompilerInfo -> Bool
<= :: PathCompilerInfo -> PathCompilerInfo -> Bool
$c> :: PathCompilerInfo -> PathCompilerInfo -> Bool
> :: PathCompilerInfo -> PathCompilerInfo -> Bool
$c>= :: PathCompilerInfo -> PathCompilerInfo -> Bool
>= :: PathCompilerInfo -> PathCompilerInfo -> Bool
$cmax :: PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo
max :: PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo
$cmin :: PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo
min :: PathCompilerInfo -> PathCompilerInfo -> PathCompilerInfo
Ord)

mkCompilerInfo :: ConfiguredProgram -> Compiler -> PathCompilerInfo
mkCompilerInfo :: ConfiguredProgram -> Compiler -> PathCompilerInfo
mkCompilerInfo ConfiguredProgram
compilerProgram Compiler
compiler =
  PathCompilerInfo
    { pathCompilerInfoFlavour :: CompilerFlavor
pathCompilerInfoFlavour = Compiler -> CompilerFlavor
compilerFlavor Compiler
compiler
    , pathCompilerInfoId :: CompilerId
pathCompilerInfoId = Compiler -> CompilerId
compilerId Compiler
compiler
    , pathCompilerInfoPath :: String
pathCompilerInfoPath = ConfiguredProgram -> String
programPath ConfiguredProgram
compilerProgram
    }

-- ----------------------------------------------------------------------------
-- JSON
-- ----------------------------------------------------------------------------

showAsJson :: PathOutputs -> Json.Value
showAsJson :: PathOutputs -> Value
showAsJson PathOutputs
pathOutputs =
  let
    cabalInstallJson :: Value
cabalInstallJson =
      [Pair] -> Value
Json.object
        [ String
"cabal-version" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= Version -> Value
forall a. Pretty a => a -> Value
jdisplay Version
cabalInstallVersion
        ]

    compilerInfoJson :: Value
compilerInfoJson = case PathOutputs -> Maybe PathCompilerInfo
pathOutputsCompilerInfo PathOutputs
pathOutputs of
      Maybe PathCompilerInfo
Nothing -> [Pair] -> Value
Json.object []
      Just PathCompilerInfo
pci -> PathCompilerInfo -> Value
compilerInfoToJson PathCompilerInfo
pci

    pathsJson :: Value
pathsJson = [Pair] -> Value
Json.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$ ((String, String) -> Pair) -> [(String, String)] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (\(String
k, String
v) -> String
k String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
Json.String String
v) (PathOutputs -> [(String, String)]
pathOutputsConfigPaths PathOutputs
pathOutputs)
   in
    [Value] -> Value
mergeJsonObjects ([Value] -> Value) -> [Value] -> Value
forall a b. (a -> b) -> a -> b
$
      [ Value
cabalInstallJson
      , Value
compilerInfoJson
      , Value
pathsJson
      ]

jdisplay :: Pretty a => a -> Json.Value
jdisplay :: forall a. Pretty a => a -> Value
jdisplay = String -> Value
Json.String (String -> Value) -> (a -> String) -> a -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Pretty a => a -> String
prettyShow

mergeJsonObjects :: [Json.Value] -> Json.Value
mergeJsonObjects :: [Value] -> Value
mergeJsonObjects = [Pair] -> Value
Json.object ([Pair] -> Value) -> ([Value] -> [Pair]) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([Pair] -> Value -> [Pair]) -> [Pair] -> [Value] -> [Pair]
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [Pair] -> Value -> [Pair]
go []
  where
    go :: [Pair] -> Value -> [Pair]
go [Pair]
acc (Json.Object [Pair]
objs) =
      [Pair]
acc [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Pair]
objs
    go [Pair]
_ Value
_ =
      String -> [Pair]
forall a. HasCallStack => String -> a
error String
"mergeJsonObjects: Only objects can be merged"

compilerInfoToJson :: PathCompilerInfo -> Json.Value
compilerInfoToJson :: PathCompilerInfo -> Value
compilerInfoToJson PathCompilerInfo
pci =
  [Pair] -> Value
Json.object
    [ String
"compiler"
        String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= [Pair] -> Value
Json.object
          [ String
"flavour" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= CompilerFlavor -> Value
forall a. Pretty a => a -> Value
jdisplay (PathCompilerInfo -> CompilerFlavor
pathCompilerInfoFlavour PathCompilerInfo
pci)
          , String
"id" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= CompilerId -> Value
forall a. Pretty a => a -> Value
jdisplay (PathCompilerInfo -> CompilerId
pathCompilerInfoId PathCompilerInfo
pci)
          , String
"path" String -> Value -> Pair
forall v. ToJSON v => String -> v -> Pair
.= String -> Value
Json.String (PathCompilerInfo -> String
pathCompilerInfoPath PathCompilerInfo
pci)
          ]
    ]

-- ----------------------------------------------------------------------------
-- Key Value Pair outputs
-- ----------------------------------------------------------------------------

showAsKeyValuePair :: PathOutputs -> String
showAsKeyValuePair :: PathOutputs -> String
showAsKeyValuePair PathOutputs
pathOutputs =
  let
    cInfo :: [(String, String)]
cInfo = case PathOutputs -> Maybe PathCompilerInfo
pathOutputsCompilerInfo PathOutputs
pathOutputs of
      Maybe PathCompilerInfo
Nothing -> []
      Just PathCompilerInfo
pci -> PathCompilerInfo -> [(String, String)]
compilerInfoToKeyValue PathCompilerInfo
pci

    paths :: [(String, String)]
paths = PathOutputs -> [(String, String)]
pathOutputsConfigPaths PathOutputs
pathOutputs

    pairs :: [(String, String)]
pairs = [(String, String)]
cInfo [(String, String)] -> [(String, String)] -> [(String, String)]
forall a. Semigroup a => a -> a -> a
<> [(String, String)]
paths

    showPair :: (String, String) -> String
showPair (String
k, String
v) = String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v
   in
    case [(String, String)]
pairs of
      [(String
_, String
v)] -> String
v
      [(String, String)]
xs -> [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ ((String, String) -> String) -> [(String, String)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, String) -> String
showPair [(String, String)]
xs

compilerInfoToKeyValue :: PathCompilerInfo -> [(String, String)]
compilerInfoToKeyValue :: PathCompilerInfo -> [(String, String)]
compilerInfoToKeyValue PathCompilerInfo
pci =
  [ (String
"compiler-flavour", CompilerFlavor -> String
forall a. Pretty a => a -> String
prettyShow (CompilerFlavor -> String) -> CompilerFlavor -> String
forall a b. (a -> b) -> a -> b
$ PathCompilerInfo -> CompilerFlavor
pathCompilerInfoFlavour PathCompilerInfo
pci)
  , (String
"compiler-id", CompilerId -> String
forall a. Pretty a => a -> String
prettyShow (CompilerId -> String) -> CompilerId -> String
forall a b. (a -> b) -> a -> b
$ PathCompilerInfo -> CompilerId
pathCompilerInfoId PathCompilerInfo
pci)
  , (String
"compiler-path", PathCompilerInfo -> String
pathCompilerInfoPath PathCompilerInfo
pci)
  ]