{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
module Distribution.ArchHs.Options
(
ExtraDBOptions (..),
extraDBOptionsParser,
FilesDBOptions (..),
filesDBOptionsParser,
HackageDBOptions (..),
hackageDBOptionsParser,
optFlagAssignmentParser,
optFlagReader,
optPackageNameReader,
optVersionReader,
module Options.Applicative.Simple,
)
where
import qualified Data.Map.Strict as Map
import Distribution.ArchHs.ExtraDB
import Distribution.ArchHs.FilesDB
import Distribution.ArchHs.Hackage
import Distribution.ArchHs.Internal.Prelude
import Distribution.ArchHs.PP
import Distribution.ArchHs.Types
import Options.Applicative.Simple
newtype =
{ :: IO ExtraDB
}
extraDBOptionsParser :: Parser ExtraDBOptions
#ifndef ALPM
=
IO ExtraDB -> ExtraDBOptions
ExtraDBOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( \String
s ->
do
forall (m :: * -> *). MonadIO m => Doc AnsiStyle -> m ()
printInfo forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Loading extra.db from" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
s
String -> IO ExtraDB
loadExtraDB String
s
)
( forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"extra"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'c'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Path to extra.db"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
defaultExtraDBPath
)
#else
extraDBOptionsParser =
ExtraDBOptions
<$> fmap
( \b ->
do
let src = if b then "libalpm" else defaultExtraDBPath
printInfo $ "Loading extra.db from" <+> pretty src
if b
then loadExtraDBFFI
else loadExtraDB defaultExtraDBPath
)
( flag
True
False
( long "no-alpm-extra"
<> help "Do not use libalpm to parse extra db"
)
)
#endif
newtype FilesDBOptions = FilesDBOptions
{ FilesDBOptions -> DBKind -> IO FilesDB
loadFilesDBFromOptions :: DBKind -> IO FilesDB
}
filesDBOptionsParser :: Parser FilesDBOptions
#ifndef ALPM
filesDBOptionsParser :: Parser FilesDBOptions
filesDBOptionsParser =
(DBKind -> IO FilesDB) -> FilesDBOptions
FilesDBOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( \String
s DBKind
db ->
do
forall (m :: * -> *). MonadIO m => Doc AnsiStyle -> m ()
printInfo forall a b. (a -> b) -> a -> b
$
Doc AnsiStyle
"Loading" forall ann. Doc ann -> Doc ann -> Doc ann
<+> DBKind -> Doc AnsiStyle
ppDBKind DBKind
db forall ann. Doc ann -> Doc ann -> Doc ann
<+> Doc AnsiStyle
"files from" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
s
DBKind -> String -> IO FilesDB
loadFilesDB DBKind
db String
s
)
( forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"files"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help
String
"Path of dir that includes core.files, extra.files and extra.files"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
defaultFilesDBDir
)
#else
filesDBOptionsParser =
FilesDBOptions
<$> fmap
( \b db ->
do
let src = if b then "libalpm" else defaultFilesDBDir
printInfo $
"Loading" <+> ppDBKind db <+> "files from" <+> pretty src
if b then loadFilesDBFFI db else loadFilesDB db defaultFilesDBDir
)
( flag
True
False
( long "no-alpm-files"
<> help "Do not use libalpm to parse files db"
)
)
#endif
newtype HackageDBOptions = HackageDBOptions
{ HackageDBOptions -> IO HackageDB
loadHackageDBFromOptions :: IO HackageDB
}
hackageDBOptionsParser :: Parser HackageDBOptions
hackageDBOptionsParser :: Parser HackageDBOptions
hackageDBOptionsParser =
IO HackageDB -> HackageDBOptions
HackageDBOptions
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
( \String
s ->
do
String
hackagePath <- if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s then IO String
lookupHackagePath else forall (f :: * -> *) a. Applicative f => a -> f a
pure String
s
forall (m :: * -> *). MonadIO m => Doc AnsiStyle -> m ()
printInfo forall a b. (a -> b) -> a -> b
$ Doc AnsiStyle
"Loading hackage from" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
hackagePath
String -> IO HackageDB
loadHackageDB String
hackagePath
)
( forall s. IsString s => Mod OptionFields s -> Parser s
strOption forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"hackage"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"PATH"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'h'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"Path to hackage index tarball"
forall a. Semigroup a => a -> a -> a
<> forall a (f :: * -> *). Show a => Mod f a
showDefault
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasValue f => a -> Mod f a
value String
""
)
optFlagReader :: ReadM (String, String, Bool)
optFlagReader :: ReadM (String, String, Bool)
optFlagReader = forall a. (String -> Either String a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ \String
s -> case forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
":" String
s of
[String
name, String
fname, String
fvalue] -> case String
fvalue of
String
"true" -> forall a b. b -> Either a b
Right (String
name, String
fname, Bool
True)
String
"false" -> forall a b. b -> Either a b
Right (String
name, String
fname, Bool
False)
String
_ -> forall a b. a -> Either a b
Left String
"Unknown boolean value, it should be 'true' or 'false'"
[String]
_ -> forall a b. a -> Either a b
Left String
"Failed to parse flag assignment"
optFlagAssignmentParser :: Parser (Map.Map PackageName FlagAssignment)
optFlagAssignmentParser :: Parser (Map PackageName FlagAssignment)
optFlagAssignmentParser =
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(String, String, Bool)] -> Map PackageName FlagAssignment
toFlagAssignment forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many forall a b. (a -> b) -> a -> b
$
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM (String, String, Bool)
optFlagReader forall a b. (a -> b) -> a -> b
$
forall (f :: * -> *) a. HasName f => String -> Mod f a
long String
"flag"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
metavar String
"package_name:flag_name:true|false"
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. HasName f => Char -> Mod f a
short Char
'f'
forall a. Semigroup a => a -> a -> a
<> forall (f :: * -> *) a. String -> Mod f a
help String
"A sinlge flag assignment for a package - e.g. inline-c:gsl-example:true"
toFlagAssignment :: [(String, String, Bool)] -> Map.Map PackageName FlagAssignment
toFlagAssignment :: [(String, String, Bool)] -> Map PackageName FlagAssignment
toFlagAssignment [(String, String, Bool)]
xs =
forall a b k. (a -> b) -> Map k a -> Map k b
Map.map [(FlagName, Bool)] -> FlagAssignment
toAssignment forall a b. (a -> b) -> a -> b
$
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
name, String
fname, Bool
fvalue) Map PackageName [(FlagName, Bool)]
acc -> forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith forall a. Semigroup a => a -> a -> a
(<>) (String -> PackageName
mkPackageName String
name) [(String -> FlagName
mkFlagName String
fname, Bool
fvalue)] Map PackageName [(FlagName, Bool)]
acc) forall k a. Map k a
Map.empty [(String, String, Bool)]
xs
where
toAssignment :: [(FlagName, Bool)] -> FlagAssignment
toAssignment = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(FlagName
fname, Bool
fvalue) FlagAssignment
acc -> FlagName -> Bool -> FlagAssignment -> FlagAssignment
insertFlagAssignment FlagName
fname Bool
fvalue FlagAssignment
acc) ([(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment [])
optVersionReader :: ReadM Version
optVersionReader :: ReadM Version
optVersionReader =
forall a. (String -> Either String a) -> ReadM a
eitherReader
( \String
s -> case forall a. Parsec a => String -> Maybe a
simpleParsec String
s of
Just Version
v -> forall a b. b -> Either a b
Right Version
v
Maybe Version
_ -> forall a b. a -> Either a b
Left forall a b. (a -> b) -> a -> b
$ String
"Failed to parse version: " forall a. Semigroup a => a -> a -> a
<> String
s
)
optPackageNameReader :: ReadM PackageName
optPackageNameReader :: ReadM PackageName
optPackageNameReader = forall a. (String -> Either String a) -> ReadM a
eitherReader forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName