{-# 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
    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 community.db from" forall ann. Doc ann -> Doc ann -> Doc ann
<+> forall a ann. Pretty a => a -> Doc ann
pretty String
s
            String -> IO CommunityDB
loadCommunityDB 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
"community"
            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 community.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
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
    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 community.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
-----------------------------------------------------------------------------

-- | 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
    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
""
      )

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

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

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

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

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

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