-- |Combinators for @optparse-applicative@.
module Hix.Optparse where

import Data.Aeson (Value, eitherDecodeFileStrict', eitherDecodeStrict')
import Distribution.Parsec (eitherParsec)
import Exon (exon)
import Options.Applicative (ReadM, eitherReader)
import Path (Abs, Dir, File, Path, Rel, parseAbsDir, parseAbsFile, parseRelDir, parseRelFile, toFilePath)
import qualified Text.Show as Show

import Hix.Data.OutputFormat (OutputFormat (..))
import Hix.Data.OutputTarget (OutputTarget (..))
import Hix.Managed.Cabal.Data.Config (HackageIndexState (HackageIndexState))
import Hix.Managed.Handlers.Build (SpecialBuildHandlers (TestBumpHandlers))

pathOption ::
  String ->
  (String -> Either e a) ->
  ReadM a
pathOption :: forall e a. String -> (String -> Either e a) -> ReadM a
pathOption String
desc String -> Either e a
parse =
  (String -> Either String a) -> ReadM a
forall a. (String -> Either String a) -> ReadM a
eitherReader \ String
raw ->
    (e -> String) -> Either e a -> Either String a
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> e -> String
forall a b. a -> b -> a
const [exon|not a valid #{desc} path: #{raw}|]) (String -> Either e a
parse String
raw)

-- | An absolute file path option for @optparse-applicative@.
absFileOption :: ReadM (Path Abs File)
absFileOption :: ReadM (Path Abs File)
absFileOption = String
-> (String -> Either SomeException (Path Abs File))
-> ReadM (Path Abs File)
forall e a. String -> (String -> Either e a) -> ReadM a
pathOption String
"absolute file" String -> Either SomeException (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile

-- | A relative file path option for @optparse-applicative@.
relFileOption :: ReadM (Path Rel File)
relFileOption :: ReadM (Path Rel File)
relFileOption = String
-> (String -> Either SomeException (Path Rel File))
-> ReadM (Path Rel File)
forall e a. String -> (String -> Either e a) -> ReadM a
pathOption String
"relative file" String -> Either SomeException (Path Rel File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel File)
parseRelFile

-- | A relative dir path option for @optparse-applicative@.
absDirOption :: ReadM (Path Abs Dir)
absDirOption :: ReadM (Path Abs Dir)
absDirOption = String
-> (String -> Either SomeException (Path Abs Dir))
-> ReadM (Path Abs Dir)
forall e a. String -> (String -> Either e a) -> ReadM a
pathOption String
"absolute dir" String -> Either SomeException (Path Abs Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs Dir)
parseAbsDir

-- | A relative dir path option for @optparse-applicative@.
relDirOption :: ReadM (Path Rel Dir)
relDirOption :: ReadM (Path Rel Dir)
relDirOption = String
-> (String -> Either SomeException (Path Rel Dir))
-> ReadM (Path Rel Dir)
forall e a. String -> (String -> Either e a) -> ReadM a
pathOption String
"relative dir" String -> Either SomeException (Path Rel Dir)
forall (m :: * -> *). MonadThrow m => String -> m (Path Rel Dir)
parseRelDir

newtype JsonConfig =
  JsonConfig { JsonConfig -> IO (Either String Value)
unJsonConfig :: IO (Either String Value) }
  deriving stock ((forall x. JsonConfig -> Rep JsonConfig x)
-> (forall x. Rep JsonConfig x -> JsonConfig) -> Generic JsonConfig
forall x. Rep JsonConfig x -> JsonConfig
forall x. JsonConfig -> Rep JsonConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. JsonConfig -> Rep JsonConfig x
from :: forall x. JsonConfig -> Rep JsonConfig x
$cto :: forall x. Rep JsonConfig x -> JsonConfig
to :: forall x. Rep JsonConfig x -> JsonConfig
Generic)

instance Show JsonConfig where
  show :: JsonConfig -> String
show (JsonConfig IO (Either String Value)
_) = String
"JsonConfig"

jsonOption :: ReadM JsonConfig
jsonOption :: ReadM JsonConfig
jsonOption =
  (String -> Either String JsonConfig) -> ReadM JsonConfig
forall a. (String -> Either String a) -> ReadM a
eitherReader \ String
raw -> do
    JsonConfig -> Either String JsonConfig
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (JsonConfig -> Either String JsonConfig)
-> JsonConfig -> Either String JsonConfig
forall a b. (a -> b) -> a -> b
$ IO (Either String Value) -> JsonConfig
JsonConfig (IO (Either String Value) -> JsonConfig)
-> IO (Either String Value) -> JsonConfig
forall a b. (a -> b) -> a -> b
$ case String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
raw of
      Just Path Abs File
f -> String -> IO (Either String Value)
forall a. FromJSON a => String -> IO (Either String a)
eitherDecodeFileStrict' (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
f)
      Maybe (Path Abs File)
Nothing -> Either String Value -> IO (Either String Value)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Either String Value
forall a. FromJSON a => ByteString -> Either String a
eitherDecodeStrict' (String -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 String
raw))

buildHandlersOption :: ReadM SpecialBuildHandlers
buildHandlersOption :: ReadM SpecialBuildHandlers
buildHandlersOption =
  (String -> Either String SpecialBuildHandlers)
-> ReadM SpecialBuildHandlers
forall a. (String -> Either String a) -> ReadM a
eitherReader \case
    String
"test" -> SpecialBuildHandlers -> Either String SpecialBuildHandlers
forall a b. b -> Either a b
Right SpecialBuildHandlers
TestBumpHandlers
    String
h -> String -> Either String SpecialBuildHandlers
forall a b. a -> Either a b
Left [exon|Invalid value for build handlers: #{h}|]

outputFormatOption :: ReadM OutputFormat
outputFormatOption :: ReadM OutputFormat
outputFormatOption =
  (String -> Either String OutputFormat) -> ReadM OutputFormat
forall a. (String -> Either String a) -> ReadM a
eitherReader \case
    String
"none" -> OutputFormat -> Either String OutputFormat
forall a b. b -> Either a b
Right OutputFormat
OutputNone
    String
"json" -> OutputFormat -> Either String OutputFormat
forall a b. b -> Either a b
Right OutputFormat
OutputJson
    String
"commit-msg" -> OutputFormat -> Either String OutputFormat
forall a b. b -> Either a b
Right OutputFormat
OutputCommitMsg
    String
"ga-pr" -> OutputFormat -> Either String OutputFormat
forall a b. b -> Either a b
Right OutputFormat
OutputGaPr
    String
fmt -> String -> Either String OutputFormat
forall a b. a -> Either a b
Left [exon|Invalid output format: #{fmt}|]

outputTargetOption :: ReadM OutputTarget
outputTargetOption :: ReadM OutputTarget
outputTargetOption =
  (String -> Either String OutputTarget) -> ReadM OutputTarget
forall a. (String -> Either String a) -> ReadM a
eitherReader \case
    String
"default" -> OutputTarget -> Either String OutputTarget
forall a b. b -> Either a b
Right OutputTarget
OutputDefault
    String
"stdout" -> OutputTarget -> Either String OutputTarget
forall a b. b -> Either a b
Right OutputTarget
OutputStdout
    String
other -> Either String OutputTarget
-> (Path Abs File -> Either String OutputTarget)
-> Maybe (Path Abs File)
-> Either String OutputTarget
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Either String OutputTarget
forall {inner} {builder} {b}.
(ExonAppend inner builder, ExonString inner builder,
 ExonBuilder inner builder) =>
inner -> Either inner b
badFile String
other) (OutputTarget -> Either String OutputTarget
forall a b. b -> Either a b
Right (OutputTarget -> Either String OutputTarget)
-> (Path Abs File -> OutputTarget)
-> Path Abs File
-> Either String OutputTarget
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> OutputTarget
OutputFile) (String -> Maybe (Path Abs File)
forall (m :: * -> *). MonadThrow m => String -> m (Path Abs File)
parseAbsFile String
other)
  where
    badFile :: inner -> Either inner b
badFile inner
f = inner -> Either inner b
forall a b. a -> Either a b
Left [exon|Argument for --output is neither an absolute filepath nor 'default' or 'stdout': #{f}|]

indexStateOption :: ReadM HackageIndexState
indexStateOption :: ReadM HackageIndexState
indexStateOption =
  (String -> Either String HackageIndexState)
-> ReadM HackageIndexState
forall a. (String -> Either String a) -> ReadM a
eitherReader \ String
raw -> ShowS
-> (Timestamp -> HackageIndexState)
-> Either String Timestamp
-> Either String HackageIndexState
forall a b c d. (a -> b) -> (c -> d) -> Either a c -> Either b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap (String -> ShowS
forall {inner} {builder}.
(ExonAppend inner builder, ExonString inner builder,
 ExonBuilder inner builder) =>
inner -> inner -> inner
err String
raw) Timestamp -> HackageIndexState
HackageIndexState (String -> Either String Timestamp
forall a. Parsec a => String -> Either String a
eitherParsec String
raw)
  where
    err :: inner -> inner -> inner
err inner
raw inner
msg = [exon|Invalid index state string '#{raw}': #{msg}|]