{-# LANGUAGE OverloadedStrings #-}

-- | Copyright: (c) 2020 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <1793913507@qq.com>
-- Stability: experimental
-- Portability: portable
-- This module defines input patterns used in executables' cli.
-- "Options.Applicative" is re-exported.
module Distribution.ArchHs.OptionReader
  ( optFlagReader,
    optSkippedReader,
    optExtraCabalReader,
    optVersionReader,
    optPackageNameReader,
    module Options.Applicative,
  )
where

import qualified Data.Map.Strict as Map
import Data.Void (Void)
import Distribution.ArchHs.Internal.Prelude
import Distribution.ArchHs.Utils
import Options.Applicative
import System.FilePath (takeExtension)
import qualified Text.Megaparsec as M
import qualified Text.Megaparsec.Char as M

readFlag :: [(String, String, Bool)] -> Map.Map PackageName FlagAssignment
readFlag :: [(String, String, Bool)] -> Map PackageName FlagAssignment
readFlag [] = Map PackageName FlagAssignment
forall k a. Map k a
Map.empty
readFlag [(String, String, Bool)]
list =
  [(PackageName, FlagAssignment)] -> Map PackageName FlagAssignment
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(PackageName, FlagAssignment)] -> Map PackageName FlagAssignment)
-> ([(String, String, Bool)] -> [(PackageName, FlagAssignment)])
-> [(String, String, Bool)]
-> Map PackageName FlagAssignment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(String, String, Bool)] -> (PackageName, FlagAssignment))
-> [[(String, String, Bool)]] -> [(PackageName, FlagAssignment)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[(String, String, Bool)]
l -> (String -> PackageName
mkPackageName (String -> PackageName)
-> ([(String, String, Bool)] -> String)
-> [(String, String, Bool)]
-> PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String, Bool)
-> Getting String (String, String, Bool) String -> String
forall s a. s -> Getting a s a -> a
^. Getting String (String, String, Bool) String
forall s t a b. Field1 s t a b => Lens s t a b
_1) ((String, String, Bool) -> String)
-> ([(String, String, Bool)] -> (String, String, Bool))
-> [(String, String, Bool)]
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(String, String, Bool)] -> (String, String, Bool)
forall a. [a] -> a
head ([(String, String, Bool)] -> PackageName)
-> [(String, String, Bool)] -> PackageName
forall a b. (a -> b) -> a -> b
$ [(String, String, Bool)]
l, ((String, String, Bool) -> FlagAssignment -> FlagAssignment)
-> FlagAssignment -> [(String, String, Bool)] -> FlagAssignment
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(String
_, String
f, Bool
v) FlagAssignment
acc -> FlagName -> Bool -> FlagAssignment -> FlagAssignment
insertFlagAssignment (String -> FlagName
mkFlagName String
f) Bool
v FlagAssignment
acc) ([(FlagName, Bool)] -> FlagAssignment
mkFlagAssignment []) [(String, String, Bool)]
l))
    ([[(String, String, Bool)]] -> [(PackageName, FlagAssignment)])
-> ([(String, String, Bool)] -> [[(String, String, Bool)]])
-> [(String, String, Bool)]
-> [(PackageName, FlagAssignment)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, String, Bool) -> (String, String, Bool) -> Bool)
-> [(String, String, Bool)] -> [[(String, String, Bool)]]
forall a. (a -> a -> Bool) -> [a] -> [[a]]
groupBy (\(String, String, Bool)
a (String, String, Bool)
b -> (String -> String -> Bool) -> (String, String) -> Bool
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry String -> String -> Bool
forall a. Eq a => a -> a -> Bool
(==) (Getting String (String, String, Bool) String
-> (String, String, Bool)
-> (String, String, Bool)
-> (String, String)
forall b s. Getting b s b -> s -> s -> (b, b)
getTwo Getting String (String, String, Bool) String
forall s t a b. Field1 s t a b => Lens s t a b
_1 (String, String, Bool)
a (String, String, Bool)
b))
    ([(String, String, Bool)] -> Map PackageName FlagAssignment)
-> [(String, String, Bool)] -> Map PackageName FlagAssignment
forall a b. (a -> b) -> a -> b
$ [(String, String, Bool)]
list

-- | Read a set of package name with flag assignments.
--
-- >>> f ""
-- Right (fromList [])
-- >>> f "package_name:flag_name:true"
-- Right (fromList [(PackageName "package_name",fromList [(FlagName "flag_name",(1,True))])])
-- >>> f "package_name:flag_name_1:true,package_name:flag_name_2:false"
-- Right (fromList [(PackageName "package_name",fromList [(FlagName "flag_name_1",(1,True)),(FlagName "flag_name_2",(1,False))])])
-- >>> f "package_name_1:flag_name_1:false,package_name_2:flag_name_2:true"
-- Right (fromList [(PackageName "package_name_1",fromList [(FlagName "flag_name_1",(1,False))]),(PackageName "package_name_2",fromList [(FlagName "flag_name_2",(1,True))])])
-- >>> f "zzz"
-- Left "1:4:\n  |\n1 | zzz\n  |    ^\nunexpected end of input\nexpecting ':'\n"
optFlagReader :: ReadM (Map.Map PackageName FlagAssignment)
optFlagReader :: ReadM (Map PackageName FlagAssignment)
optFlagReader =
  (String -> Either String (Map PackageName FlagAssignment))
-> ReadM (Map PackageName FlagAssignment)
forall a. (String -> Either String a) -> ReadM a
eitherReader
    ( \String
s -> case Parsec Void String (Map PackageName FlagAssignment)
-> String
-> String
-> Either
     (ParseErrorBundle String Void) (Map PackageName FlagAssignment)
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
M.parse Parsec Void String (Map PackageName FlagAssignment)
optFlagParser String
"" String
s of
        Right Map PackageName FlagAssignment
x -> Map PackageName FlagAssignment
-> Either String (Map PackageName FlagAssignment)
forall a b. b -> Either a b
Right Map PackageName FlagAssignment
x
        Left ParseErrorBundle String Void
err -> String -> Either String (Map PackageName FlagAssignment)
forall a b. a -> Either a b
Left (String -> Either String (Map PackageName FlagAssignment))
-> String -> Either String (Map PackageName FlagAssignment)
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle String Void -> String
forall s e.
(Stream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
M.errorBundlePretty ParseErrorBundle String Void
err
    )

optFlagParser :: M.Parsec Void String (Map.Map PackageName FlagAssignment)
optFlagParser :: Parsec Void String (Map PackageName FlagAssignment)
optFlagParser =
  [(String, String, Bool)] -> Map PackageName FlagAssignment
readFlag
    ([(String, String, Bool)] -> Map PackageName FlagAssignment)
-> ParsecT Void String Identity [(String, String, Bool)]
-> Parsec Void String (Map PackageName FlagAssignment)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( do
            String
pkg <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle (ParsecT Void String Identity Char
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.single Char
Token String
':'
            String
flg <- ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
M.manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
M.anySingle (ParsecT Void String Identity Char
 -> ParsecT Void String Identity String)
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall a b. (a -> b) -> a -> b
$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Token s -> m (Token s)
M.single Char
Token String
':'
            Bool
b <- ParsecT Void String Identity Bool
bool
            (String, String, Bool)
-> ParsecT Void String Identity (String, String, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
pkg, String
flg, Bool
b)
        )
    ParsecT Void String Identity (String, String, Bool)
-> ParsecT Void String Identity String
-> ParsecT Void String Identity [(String, String, Bool)]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`M.sepBy` ParsecT Void String Identity String
","
  where
    bool :: ParsecT Void String Identity Bool
bool = do
      String
s <- Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string Tokens String
"true" ParsecT Void String Identity String
-> ParsecT Void String Identity String
-> ParsecT Void String Identity String
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Tokens String -> ParsecT Void String Identity (Tokens String)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
M.string Tokens String
"false"
      case String
s of
        String
"true" -> Bool -> ParsecT Void String Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        String
"false" -> Bool -> ParsecT Void String Identity Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        String
_ -> String -> ParsecT Void String Identity Bool
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT Void String Identity Bool)
-> String -> ParsecT Void String Identity Bool
forall a b. (a -> b) -> a -> b
$ String
"unknown bool: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s

-- | Read skipped components.
-- This never fails, i.e. the return value will be 'Right'.
-- >>> f ""
-- Right [""]
-- >>> f "component_1,component_2"
-- Right ["component_1","component_2"]
optSkippedReader :: ReadM [String]
optSkippedReader :: ReadM [String]
optSkippedReader = (String -> Either String [String]) -> ReadM [String]
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String [String]) -> ReadM [String])
-> (String -> Either String [String]) -> ReadM [String]
forall a b. (a -> b) -> a -> b
$ [String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> (String -> [String]) -> String -> Either String [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
","

-- | Read extra cabal files.
--
-- >>> f ""
-- Left "Unexpected file name: "
-- >>> f "a.cabal"
-- Right ["a.cabal"]
-- >>> f "a.cabal,b.cabal"
-- Right ["a.cabal","b.cabal"]
-- >>> f "a.what,b.cabal"
-- Left "Unexpected file name: a.what"
optExtraCabalReader :: ReadM [FilePath]
optExtraCabalReader :: ReadM [String]
optExtraCabalReader = (String -> Either String [String]) -> ReadM [String]
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String [String]) -> ReadM [String])
-> (String -> Either String [String]) -> ReadM [String]
forall a b. (a -> b) -> a -> b
$ \String
x ->
  let split :: [String]
split = String -> String -> [String]
forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"," String
x
      check :: [(String, Bool)]
check = (String -> (String, Bool)) -> [String] -> [(String, Bool)]
forall a b. (a -> b) -> [a] -> [b]
map (\String
e -> if String -> String
takeExtension String
e String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal" then (String
e, Bool
True) else (String
e, Bool
False)) [String]
split
      failed :: [String]
failed = ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst ([(String, Bool)] -> [String])
-> ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ((String, Bool) -> Bool) -> (String, Bool) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, Bool) -> Bool
forall a b. (a, b) -> b
snd) ([(String, Bool)] -> [String]) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, Bool)]
check
      successful :: [String]
successful = ((String, Bool) -> String) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String, Bool) -> String
forall a b. (a, b) -> a
fst ([(String, Bool)] -> [String])
-> ([(String, Bool)] -> [(String, Bool)])
-> [(String, Bool)]
-> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, Bool) -> Bool) -> [(String, Bool)] -> [(String, Bool)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, Bool) -> Bool
forall a b. (a, b) -> b
snd ([(String, Bool)] -> [String]) -> [(String, Bool)] -> [String]
forall a b. (a -> b) -> a -> b
$ [(String, Bool)]
check
   in if [String]
failed [String] -> [String] -> Bool
forall a. Eq a => a -> a -> Bool
/= [] then String -> Either String [String]
forall a b. a -> Either a b
Left (String
"Unexpected file name: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " [String]
failed) else [String] -> Either String [String]
forall a b. b -> Either a b
Right ([String] -> Either String [String])
-> [String] -> Either String [String]
forall a b. (a -> b) -> a -> b
$ [String]
successful

-- | Read a 'Version'
-- This function calls 'simpleParsec'.
optVersionReader :: ReadM Version
optVersionReader :: ReadM Version
optVersionReader =
  (String -> Either String Version) -> ReadM Version
forall a. (String -> Either String a) -> ReadM a
eitherReader
    ( \String
s -> case String -> Maybe Version
forall a. Parsec a => String -> Maybe a
simpleParsec String
s of
        Just Version
v -> Version -> Either String Version
forall a b. b -> Either a b
Right Version
v
        Maybe Version
_ -> String -> Either String Version
forall a b. a -> Either a b
Left (String -> Either String Version)
-> String -> Either String Version
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse version: " String -> String -> String
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 = (String -> Either String PackageName) -> ReadM PackageName
forall a. (String -> Either String a) -> ReadM a
eitherReader ((String -> Either String PackageName) -> ReadM PackageName)
-> (String -> Either String PackageName) -> ReadM PackageName
forall a b. (a -> b) -> a -> b
$ PackageName -> Either String PackageName
forall a b. b -> Either a b
Right (PackageName -> Either String PackageName)
-> (String -> PackageName) -> String -> Either String PackageName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> PackageName
mkPackageName