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