| ... |
... |
@@ -5,6 +5,7 @@ |
|
5
|
5
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
6
|
6
|
{-# LANGUAGE GADTs #-}
|
|
7
|
7
|
{-# LANGUAGE KindSignatures #-}
|
|
|
8
|
+{-# LANGUAGE MultiWayIf #-}
|
|
8
|
9
|
{-# LANGUAGE DataKinds #-}
|
|
9
|
10
|
{-# LANGUAGE TupleSections #-}
|
|
10
|
11
|
{-# LANGUAGE ScopedTypeVariables #-}
|
| ... |
... |
@@ -151,6 +152,7 @@ data Flag |
|
151
|
152
|
| FlagVerbosity (Maybe String)
|
|
152
|
153
|
| FlagUnitId
|
|
153
|
154
|
| FlagShowUnitIds
|
|
|
155
|
+ | FlagTarget String
|
|
154
|
156
|
deriving Eq
|
|
155
|
157
|
|
|
156
|
158
|
flags :: [OptDescr Flag]
|
| ... |
... |
@@ -198,7 +200,9 @@ flags = [ |
|
198
|
200
|
Option [] ["ipid", "unit-id"] (NoArg FlagUnitId)
|
|
199
|
201
|
"interpret package arguments as unit IDs (e.g. installed package IDs)",
|
|
200
|
202
|
Option ['v'] ["verbose"] (OptArg FlagVerbosity "Verbosity")
|
|
201
|
|
- "verbosity level (0-2, default 1)"
|
|
|
203
|
+ "verbosity level (0-2, default 1)",
|
|
|
204
|
+ Option [] ["target"] (ReqArg FlagTarget "TARGET")
|
|
|
205
|
+ "run against the specified target (this has no effect if --global-package-db is specified)"
|
|
202
|
206
|
]
|
|
203
|
207
|
|
|
204
|
208
|
data Verbosity = Silent | Normal | Verbose
|
| ... |
... |
@@ -587,6 +591,29 @@ readFromSettingsFile settingsFile f = do |
|
587
|
591
|
Right archOS -> Right archOS
|
|
588
|
592
|
Left e -> Left e
|
|
589
|
593
|
|
|
|
594
|
+-- | Get the cross target.
|
|
|
595
|
+--
|
|
|
596
|
+-- This is either extracted from the '--target' flag or inferred
|
|
|
597
|
+-- from the current program name.
|
|
|
598
|
+getTarget :: [Flag] -> IO (Maybe String)
|
|
|
599
|
+getTarget my_flags = do
|
|
|
600
|
+ case [ t | FlagTarget t <- my_flags ] of
|
|
|
601
|
+ [] -> do
|
|
|
602
|
+ -- when no target is specified on the command line, infer it from the program name.
|
|
|
603
|
+ -- e.g. x86_64-unknown-linux-ghc-pkg
|
|
|
604
|
+ progN <- getProgName
|
|
|
605
|
+ if | "-ghc-pkg" `isSuffixOf` progN
|
|
|
606
|
+ , parts <- split '-' progN
|
|
|
607
|
+ , length parts > 3 -> pure (Just (take (length progN - 8) progN))
|
|
|
608
|
+ | otherwise -> pure Nothing
|
|
|
609
|
+ ts -> pure (Just (last ts))
|
|
|
610
|
+ where
|
|
|
611
|
+ split :: Char -> String -> [String]
|
|
|
612
|
+ split c s = case rest of
|
|
|
613
|
+ [] -> [chunk]
|
|
|
614
|
+ _:rest' -> chunk : split c rest'
|
|
|
615
|
+ where (chunk, rest) = break (==c) s
|
|
|
616
|
+
|
|
590
|
617
|
getPkgDatabases :: Verbosity
|
|
591
|
618
|
-> GhcPkg.DbOpenMode mode DbModifySelector
|
|
592
|
619
|
-> Bool -- use the user db
|
| ... |
... |
@@ -616,7 +643,12 @@ getPkgDatabases verbosity mode use_user use_cache expand_vars my_flags = do |
|
616
|
643
|
[] -> do mb_dir <- getBaseDir
|
|
617
|
644
|
case mb_dir of
|
|
618
|
645
|
Nothing -> die err_msg
|
|
619
|
|
- Just dir -> do
|
|
|
646
|
+ Just dir' -> do
|
|
|
647
|
+ mt <- getTarget my_flags
|
|
|
648
|
+ dir <- case mt of
|
|
|
649
|
+ Nothing -> pure dir'
|
|
|
650
|
+ Just target -> pure (dir' </> "targets" </> target </> "lib")
|
|
|
651
|
+
|
|
620
|
652
|
-- Look for where it is given in the settings file, if marked there.
|
|
621
|
653
|
let settingsFile = dir </> "settings"
|
|
622
|
654
|
exists_settings_file <- doesFileExist settingsFile
|