Operations.hs

{-# LANGUAGE ConstraintKinds      #-}
{-# LANGUAGE InstanceSigs         #-}
{-# LANGUAGE PolyKinds            #-}
{-# LANGUAGE RankNTypes           #-}
{-# LANGUAGE TypeFamilies         #-}
{-# LANGUAGE UndecidableInstances #-}
module Options.Harg.Operations where

import           Data.Functor.Identity      (Identity(..))

import qualified Data.Barbie                as B
import qualified Options.Applicative        as Optparse

import           Options.Harg.Cmdline       (mkOptparseParser)
import           Options.Harg.Config        (mkConfigParser, getConfig)
import           Options.Harg.Het.All       (All)
import           Options.Harg.Het.HList     (AssocListF, MapAssocList(..))
import           Options.Harg.Het.Variant   (VariantF)
import           Options.Harg.Pretty        (ppWarning, ppError)
import           Options.Harg.Sources       (accumSourceResults, defaultSources)
import           Options.Harg.Sources.Env   (EnvSourceVal)
import           Options.Harg.Sources.Types (GetSource(..), RunSource(..))
import           Options.Harg.Subcommands   (Subcommands(..))
import           Options.Harg.Types         (HargCtx(..), getCtx, Opt, OptError)
import           Options.Harg.Util          (toDummyOpts, allToDummyOpts, compose)


-- | Run the option parser and combine with values from the specified sources,
-- passing the context explicitly.
execOptWithCtx
  :: forall c a.
     ( B.TraversableB a
     , B.ProductB a
     , B.TraversableB c
     , B.ProductB c
     , GetSource c Identity
     , RunSource (SourceVal c) a
     )
  => HargCtx  -- ^ Context containing the environment and the cmdline args
  -> c Opt    -- ^ Source options
  -> a Opt    -- ^ Target configuration options
  -> IO (a Identity)
execOptWithCtx ctx conf opts
  = do
      let
        configParser = mkConfigParser ctx (compose Identity conf)
        dummyParser = mkOptparseParser [] (toDummyOpts @String opts)
      config <- getConfig ctx configParser dummyParser
      sourceVals <- getSource ctx config
      let
        (errs, sources)
          = accumSourceResults
          $ runSource sourceVals (compose Identity opts)
        parser
          = mkOptparseParser sources (compose Identity opts)
      (res, _) <- execParser ctx ((,) <$> parser <*> configParser) errs
      pure res

-- | Run the option parser and combine with values from the specified sources
execOpt
  :: forall c a.
     ( B.TraversableB a
     , B.ProductB a
     , B.TraversableB c
     , B.ProductB c
     , GetSource c Identity
     , RunSource (SourceVal c) a
     )
  => c Opt  -- ^ Source options
  -> a Opt  -- ^ Target configuration options
  -> IO (a Identity)
execOpt conf opts
  = do
      ctx <- getCtx
      execOptWithCtx ctx conf opts

-- | Run the option parser only with default sources (environment variables),
-- passing the context explicitly.
execOptWithCtxDef
  :: forall a.
     ( B.TraversableB a
     , B.ProductB a
     )
  => HargCtx  -- ^ Context containing the environment and the cmdline args
  -> a Opt    -- ^ Target configuration options
  -> IO (a Identity)
execOptWithCtxDef ctx
  = execOptWithCtx ctx defaultSources

-- | Run the option parser only with default sources (environment variables)
execOptDef
  :: forall a.
     ( B.TraversableB a
     , B.ProductB a
     )
  => a Opt -- ^ Target configuration options
  -> IO (a Identity)
execOptDef
  = execOpt defaultSources

-- | Run the subcommand parser and combine with values from the specified
-- sources, passing the context explicitly.
execCommandsWithCtx
  :: forall c ts xs.
     ( B.TraversableB (VariantF xs)
     , B.TraversableB c
     , B.ProductB c
     , Subcommands ts xs
     , GetSource c Identity
     , All (RunSource (SourceVal c)) xs
     , All (RunSource ()) xs
     , MapAssocList xs
     )
  => HargCtx  -- ^ Context containing the environment and the cmdline args
  -> c Opt    -- ^ Source options
  -> AssocListF ts xs Opt  -- ^ Target options associated with subcommands
  -> IO (VariantF xs Identity)
execCommandsWithCtx ctx conf opts
  = do
      let
        configParser = mkConfigParser ctx (compose Identity conf)
        (_, dummyCommands)
          = mapSubcommand () (allToDummyOpts @String opts)
        dummyParser
          = Optparse.subparser (mconcat dummyCommands)

      config <- getConfig ctx configParser dummyParser
      sourceVals <- getSource ctx config

      let
        (errs, commands)
          = mapSubcommand sourceVals (mapAssocList (compose Identity) opts)
        parser
          = Optparse.subparser (mconcat commands)
      (res, _) <- execParser ctx ((,) <$> parser <*> configParser) errs
      pure res

-- | Run the subcommand parser and combine with values from the specified
-- sources
execCommands
  :: forall c ts xs.
     ( B.TraversableB (VariantF xs)
     , B.TraversableB c
     , B.ProductB c
     , Subcommands ts xs
     , GetSource c Identity
     , All (RunSource (SourceVal c)) xs
     , All (RunSource ()) xs
     , MapAssocList xs
     )
  => c Opt  -- ^ Source options
  -> AssocListF ts xs Opt  -- ^ Target options associated with subcommands
  -> IO (VariantF xs Identity)
execCommands conf opts
  = do
      ctx <- getCtx
      execCommandsWithCtx ctx conf opts

-- | Run the subcommand parser only with default sources (environment
-- variables), passing the context explicitly.
execCommandsWithCtxDef
  :: forall ts xs.
     ( B.TraversableB (VariantF xs)
     , Subcommands ts xs
     , All (RunSource EnvSourceVal) xs
     , All (RunSource ()) xs
     , MapAssocList xs
     )
  => HargCtx  -- ^ Context containing the environment and the cmdline args
  -> AssocListF ts xs Opt  -- ^ Target options associated with subcommands
  -> IO (VariantF xs Identity)
execCommandsWithCtxDef ctx
  = execCommandsWithCtx ctx defaultSources

-- | Run the subcommand parser only with default sources (environment
-- variables)
execCommandsDef
  :: forall ts xs.
     ( B.TraversableB (VariantF xs)
     , Subcommands ts xs
     , All (RunSource EnvSourceVal) xs
     , All (RunSource ()) xs
     , MapAssocList xs
     )
  => AssocListF ts xs Opt  -- ^ Target options associated with subcommands
  -> IO (VariantF xs Identity)
execCommandsDef
  = execCommands defaultSources

-- | Run the optparse-applicative parser, printing accumulated errors. Errors
-- are printed as warnings if the parser succeeds.
execParser
  :: HargCtx
  -> Optparse.Parser a
  -> [OptError]
  -> IO a
execParser HargCtx{..} parser errs
  = do
      let
        res = execParserPure _hcArgs parser
      case res of
        Optparse.Success a
          -> ppWarning errs >> pure a
        _
          -> ppError errs >> Optparse.handleParseResult res

-- | Run the optparse-applicative parser and return the
-- 'Optparse.ParserResult'
execParserPure
  :: [String]
  -> Optparse.Parser a
  -> Optparse.ParserResult a
execParserPure args parser
  = let
      parserInfo
        = Optparse.info (Optparse.helper <*> parser) Optparse.forwardOptions
    in Optparse.execParserPure Optparse.defaultPrefs parserInfo args