{-# LANGUAGE OverloadedStrings #-}
{-# OPTIONS_HADDOCK hide #-}

module OptionParse
  ( readFlag,
    optFlagReader,
    optFlagParser,
    optSkippedReader,
    optExtraCabalReader,
    optVersionReader,
    optPackageNameReader,
    module Options.Applicative,
  )
where

import Data.List (groupBy, intercalate)
import Data.List.Split (splitOn)
import qualified Data.Map.Strict as Map
import Data.Void (Void)
import Distribution.ArchHs.Types
import Distribution.ArchHs.Utils
import Distribution.Parsec (simpleParsec)
import Distribution.Types.Flag (FlagAssignment, insertFlagAssignment, mkFlagAssignment, mkFlagName)
import Distribution.Types.PackageName (PackageName, mkPackageName)
import Distribution.Version (Version)
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

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

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

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 splitted :: [String]
splitted = 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
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".cabal" then (String
e, Bool
True) else (String
e, Bool
False)) [String]
splitted
      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]
successful

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
    )

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