arch-hs-0.0.0.0: src/OptionParse.hs

{-# 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 [] = Map.empty
readFlag list =
  Map.fromList
    . fmap (\l -> (mkPackageName . (^. _1) . head $ l, foldr (\(_, f, v) acc -> insertFlagAssignment (mkFlagName f) v acc) (mkFlagAssignment []) l))
    . groupBy (\a b -> uncurry (==) (getTwo _1 a b))
    $ list

optFlagReader :: ReadM (Map.Map PackageName FlagAssignment)
optFlagReader =
  eitherReader
    ( \s -> case M.parse optFlagParser "" s of
        Right x -> Right x
        Left err -> Left $ M.errorBundlePretty err
    )

optFlagParser :: M.Parsec Void String (Map.Map PackageName FlagAssignment)
optFlagParser =
  readFlag
    <$> ( do
            pkg <- M.manyTill M.anySingle $ M.single ':'
            flg <- M.manyTill M.anySingle $ M.single ':'
            b <- bool
            return (pkg, flg, b)
        )
    `M.sepBy` ","
  where
    bool = do
      s <- M.string "true" <|> M.string "false"
      case s of
        "true" -> return True
        "false" -> return False
        _ -> fail $ "unknown bool: " <> s

optSkippedReader :: ReadM [String]
optSkippedReader = eitherReader $ Right . splitOn ","

optExtraCabalReader :: ReadM [FilePath]
optExtraCabalReader = eitherReader $ \x ->
  let splitted = splitOn "," x
      check = map (\e -> if takeExtension x == ".cabal" then (e, True) else (e, False)) splitted
      failed = map fst . filter (not . snd) $ check
      successful = map fst . filter snd $ check
   in if failed /= [] then Left ("Unexpected file name: " <> intercalate ", " failed) else Right successful

optVersionReader :: ReadM Version
optVersionReader =
  eitherReader
    ( \s -> case simpleParsec s of
        Just v -> Right v
        _ -> Left $ "Failed to parse version: " <> s
    )

optPackageNameReader :: ReadM PackageName
optPackageNameReader = eitherReader $ Right . mkPackageName