{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}

-- | Copyright: (c) 2020-2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- Stability: experimental
-- Portability: portable
-- This module contains CLI parsers used in executables.
-- "Options.Applicative.Simple" is re-exported.
module Distribution.ArchHs.Options
  ( -- * Load Community DB
    CommunityDBOptions (..),
    communityDBOptionsParser,

    -- * Load files DB
    FilesDBOptions (..),
    filesDBOptionsParser,

    -- * Load Hackage DB
    HackageDBOptions (..),
    hackageDBOptionsParser,

    -- * Parse flags
    optFlagAssignmentParser,
    optFlagReader,

    -- * Readers
    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

-----------------------------------------------------------------------------

-- | Parsed options for loading [community]
newtype CommunityDBOptions = CommunityDBOptions
  { CommunityDBOptions -> IO CommunityDB
loadCommunityDBFromOptions :: IO CommunityDB
  }

-- | CLI options parser of 'CommunityDBOptions'
--
-- When alpm is enabled, it reads a flag @no-alpm-community@;
-- otherwise it reads a string option @community@.
communityDBOptionsParser :: Parser CommunityDBOptions

#ifndef ALPM
communityDBOptionsParser :: Parser CommunityDBOptions
communityDBOptionsParser =
  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
-----------------------------------------------------------------------------

-- | Parsed options for loading 'FilesDB'
newtype FilesDBOptions = FilesDBOptions
  { FilesDBOptions -> DBKind -> IO FilesDB
loadFilesDBFromOptions :: DBKind -> IO FilesDB
  }

-- | CLI options parser of 'CommunityDBOptions'
--
-- When alpm is enabled, it reads a flag @no-alpm-files@;
-- otherwise it reads a string option @files@.
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
-----------------------------------------------------------------------------

-- | Parsed options for loading 'HackageDB'
newtype HackageDBOptions = HackageDBOptions
  { HackageDBOptions -> IO HackageDB
loadHackageDBFromOptions :: IO HackageDB
  }

-- | CLI options parser that reads a string option @hackage@.
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]
""
      )

-----------------------------------------------------------------------------

-- | Read a flag assignment like @package_name:flag_name:true|false@
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"

-- | CLI options parser of flag assignments
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 [])

-----------------------------------------------------------------------------

-- | Read a 'Version'
-- This function calls 'simpleParsec'.
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
    )

-- | Read a 'PackageName'
-- This function never fails, because it just wraps the input string with 'mkPackageName'.
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