{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}

module OptEnvConf.Parser
  ( -- * Parser API
    setting,
    filePathSetting,
    directoryPathSetting,
    strOption,
    strArgument,
    choice,
    mapIO,
    runIO,
    checkEither,
    checkMaybe,
    checkMapEither,
    checkMapIO,
    checkMapMaybe,
    checkMapEitherForgivable,
    checkMapIOForgivable,
    checkMapMaybeForgivable,
    allOrNothing,
    commands,
    command,
    subArgs,
    subArgs_,
    subEnv,
    subEnv_,
    subConfig,
    subConfig_,
    subAll,
    subSettings,
    someNonEmpty,
    withConfig,
    withYamlConfig,
    withFirstYamlConfig,
    withCombinedYamlConfigs,
    withCombinedYamlConfigs',
    combineConfigObjects,
    xdgYamlConfigFile,
    withLocalYamlConfig,
    withConfigurableYamlConfig,
    withoutConfig,
    configuredConfigFile,
    enableDisableSwitch,
    yesNoSwitch,
    makeDoubleSwitch,
    readSecretTextFile,

    -- * Parser implementation
    Parser (..),
    HasParser (..),
    Command (..),
    Metavar,
    Help,
    showParserABit,
    parserEraseSrcLocs,
    parserMapSetting,
    parserTraverseSetting,
    commandTraverseSetting,

    -- ** All or nothing implementation
    parserSettingsSet,
    SrcLocHash (..),
    hashSrcLoc,

    -- ** Re-exports
    Functor (..),
    Applicative (..),
    Alternative (..),
    Selective (..),
  )
where

import Autodocodec.Yaml
import Control.Applicative
import Control.Arrow (first)
import Control.Monad
import Control.Selective
import Data.Aeson as JSON
import qualified Data.Aeson.KeyMap as KM
import Data.Functor.Identity
import Data.Hashable
import Data.List.NonEmpty (NonEmpty (..), (<|))
import qualified Data.List.NonEmpty as NE
import Data.Maybe
import Data.Set (Set)
import qualified Data.Set as S
import Data.String
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.IO as T
import GHC.Stack (HasCallStack, SrcLoc, callStack, getCallStack, prettySrcLoc, withFrozenCallStack)
import OptEnvConf.Args (Dashed (..), prefixDashed)
import OptEnvConf.Casing
import OptEnvConf.Reader
import OptEnvConf.Setting
import Path
import Path.IO
import Text.Show

data Command a = Command
  { forall a. Command a -> Maybe SrcLoc
commandSrcLoc :: !(Maybe SrcLoc),
    forall a. Command a -> String
commandArg :: !String,
    forall a. Command a -> String
commandHelp :: !Help,
    forall a. Command a -> Parser a
commandParser :: !(Parser a)
  }

instance Functor Command where
  fmap :: forall a b. (a -> b) -> Command a -> Command b
fmap a -> b
f Command a
c = Command a
c {commandParser = fmap f (commandParser c)}

showCommandABit :: Command a -> ShowS
showCommandABit :: forall a. Command a -> ShowS
showCommandABit Command {String
Maybe SrcLoc
Parser a
commandSrcLoc :: forall a. Command a -> Maybe SrcLoc
commandArg :: forall a. Command a -> String
commandHelp :: forall a. Command a -> String
commandParser :: forall a. Command a -> Parser a
commandSrcLoc :: Maybe SrcLoc
commandArg :: String
commandHelp :: String
commandParser :: Parser a
..} =
  String -> ShowS
showString String
"Command "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
commandArg
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> String -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 String
commandHelp
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
showParserPrec Int
11 Parser a
commandParser

-- | A 'Parser' structure
--
-- A @Parser a@ value represents each of these all at once:
--
--     * A way to run it to parse an @a@
--     * A way to document it in various ways
--     * A way to run it to perform shell completion
--
-- The basic building block of a 'Parser' is a 'setting'.
-- 'setting's represent individual settings that you can then compose into larger parsers.
--
-- Much of the way you compose parsers happens via its type
-- class instances.
-- In particular:
--
--     * '<$>' from 'Functor' to map over 'Parser's
--     * '<*>' from 'Applicative' to "and" 'Parser's
--     * '<|>' from 'Alternative' to "or" 'Parser's
--     * 'optional' from 'Alternative' to optionally run a parser
--     * 'many' and 'some' from 'Alternative' to run the same parser multiple times.
--
-- You can run a parser with 'runParser', or give your type an instance of
-- 'HasParser' and run the parser with 'runSettingsParser'.
data Parser a where
  -- Functor
  ParserPure :: !a -> Parser a
  -- Applicative
  ParserAp ::
    !(Parser (a -> b)) ->
    !(Parser a) ->
    Parser b
  -- Selective
  ParserSelect ::
    !(Parser (Either a b)) ->
    !(Parser (a -> b)) ->
    Parser b
  -- Alternative
  ParserEmpty ::
    !(Maybe SrcLoc) ->
    Parser a
  ParserAlt ::
    !(Parser a) ->
    !(Parser a) ->
    Parser a
  ParserMany ::
    !(Parser a) ->
    Parser [a]
  ParserAllOrNothing ::
    !(Maybe SrcLoc) ->
    !(Parser a) ->
    Parser a
  -- Map, Check, and IO
  ParserCheck ::
    !(Maybe SrcLoc) ->
    -- | Forgivable
    !Bool ->
    !(a -> IO (Either String b)) ->
    !(Parser a) ->
    Parser b
  -- Commands
  ParserCommands ::
    !(Maybe SrcLoc) ->
    ![Command a] ->
    Parser a
  -- | Load a configuration value and use it for the continuing parser
  ParserWithConfig ::
    !(Maybe SrcLoc) ->
    !(Parser (Maybe JSON.Object)) ->
    !(Parser a) ->
    Parser a
  -- | General settings
  ParserSetting ::
    !(Maybe SrcLoc) ->
    !(Setting a) ->
    Parser a

instance Functor Parser where
  -- We case-match to produce shallower parser structures.
  fmap :: forall a b. (a -> b) -> Parser a -> Parser b
fmap a -> b
f = \case
    ParserPure a
a -> b -> Parser b
forall a. a -> Parser a
ParserPure (a -> b
f a
a)
    ParserAp Parser (a -> a)
pf Parser a
pa -> Parser (a -> b) -> Parser a -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
ParserAp (((a -> a) -> a -> b) -> Parser (a -> a) -> Parser (a -> b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Parser (a -> a)
pf) Parser a
pa
    ParserSelect Parser (Either a a)
pe Parser (a -> a)
pf -> Parser (Either a b) -> Parser (a -> b) -> Parser b
forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
ParserSelect ((Either a a -> Either a b)
-> Parser (Either a a) -> Parser (Either a b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either a a -> Either a b
forall a b. (a -> b) -> Either a a -> Either a b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Parser (Either a a)
pe) (((a -> a) -> a -> b) -> Parser (a -> a) -> Parser (a -> b)
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (a -> a) -> a -> b
forall a b. (a -> b) -> (a -> a) -> a -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) Parser (a -> a)
pf)
    ParserEmpty Maybe SrcLoc
mLoc -> Maybe SrcLoc -> Parser b
forall a. Maybe SrcLoc -> Parser a
ParserEmpty Maybe SrcLoc
mLoc
    ParserAlt Parser a
p1 Parser a
p2 -> Parser b -> Parser b -> Parser b
forall a. Parser a -> Parser a -> Parser a
ParserAlt ((a -> b) -> Parser a -> Parser b
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
p1) ((a -> b) -> Parser a -> Parser b
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
p2)
    ParserCheck Maybe SrcLoc
mLoc Bool
forgivable a -> IO (Either String a)
g Parser a
p -> Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
ParserCheck Maybe SrcLoc
mLoc Bool
forgivable ((Either String a -> Either String b)
-> IO (Either String a) -> IO (Either String b)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> Either String a -> Either String b
forall a b. (a -> b) -> Either String a -> Either String b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) (IO (Either String a) -> IO (Either String b))
-> (a -> IO (Either String a)) -> a -> IO (Either String b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO (Either String a)
g) Parser a
p
    ParserCommands Maybe SrcLoc
mLoc [Command a]
cs -> Maybe SrcLoc -> [Command b] -> Parser b
forall a. Maybe SrcLoc -> [Command a] -> Parser a
ParserCommands Maybe SrcLoc
mLoc ([Command b] -> Parser b) -> [Command b] -> Parser b
forall a b. (a -> b) -> a -> b
$ (Command a -> Command b) -> [Command a] -> [Command b]
forall a b. (a -> b) -> [a] -> [b]
map ((a -> b) -> Command a -> Command b
forall a b. (a -> b) -> Command a -> Command b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f) [Command a]
cs
    ParserWithConfig Maybe SrcLoc
mLoc Parser (Maybe Object)
pc Parser a
pa -> Maybe SrcLoc -> Parser (Maybe Object) -> Parser b -> Parser b
forall a.
Maybe SrcLoc -> Parser (Maybe Object) -> Parser a -> Parser a
ParserWithConfig Maybe SrcLoc
mLoc Parser (Maybe Object)
pc ((a -> b) -> Parser a -> Parser b
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f Parser a
pa)
    -- TODO: make setting a functor and fmap here
    Parser a
p -> Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
ParserCheck Maybe SrcLoc
forall a. Maybe a
Nothing Bool
True (Either String b -> IO (Either String b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> IO (Either String b))
-> (a -> Either String b) -> a -> IO (Either String b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either String b
forall a b. b -> Either a b
Right (b -> Either String b) -> (a -> b) -> a -> Either String b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
f) Parser a
p

instance Applicative Parser where
  pure :: forall a. a -> Parser a
pure = a -> Parser a
forall a. a -> Parser a
ParserPure
  <*> :: forall a b. Parser (a -> b) -> Parser a -> Parser b
(<*>) Parser (a -> b)
p1 Parser a
p2 = case (Parser (a -> b)
p1, Parser a
p2) of
    -- Homomorphism law for applicative
    (ParserPure a -> b
f, ParserPure a
a) -> b -> Parser b
forall a. a -> Parser a
ParserPure (a -> b
f a
a)
    (Parser (a -> b), Parser a)
_ -> Parser (a -> b) -> Parser a -> Parser b
forall a b. Parser (a -> b) -> Parser a -> Parser b
ParserAp Parser (a -> b)
p1 Parser a
p2

instance Selective Parser where
  select :: forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
select = Parser (Either a b) -> Parser (a -> b) -> Parser b
forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
ParserSelect

instance Alternative Parser where
  empty :: forall a. Parser a
empty = Maybe SrcLoc -> Parser a
forall a. Maybe SrcLoc -> Parser a
ParserEmpty Maybe SrcLoc
forall a. Maybe a
Nothing
  <|> :: forall a. Parser a -> Parser a -> Parser a
(<|>) Parser a
p1 Parser a
p2 =
    let isEmpty :: Parser a -> Bool
        isEmpty :: forall a. Parser a -> Bool
isEmpty = \case
          ParserPure a
_ -> Bool
False
          ParserAp Parser (a -> a)
pf Parser a
pa -> Parser (a -> a) -> Bool
forall a. Parser a -> Bool
isEmpty Parser (a -> a)
pf Bool -> Bool -> Bool
&& Parser a -> Bool
forall a. Parser a -> Bool
isEmpty Parser a
pa
          ParserSelect Parser (Either a a)
pe Parser (a -> a)
pf -> Parser (Either a a) -> Bool
forall a. Parser a -> Bool
isEmpty Parser (Either a a)
pe Bool -> Bool -> Bool
&& Parser (a -> a) -> Bool
forall a. Parser a -> Bool
isEmpty Parser (a -> a)
pf
          ParserEmpty Maybe SrcLoc
_ -> Bool
True
          ParserAlt Parser a
_ Parser a
_ -> Bool
False
          ParserMany Parser a
_ -> Bool
False
          ParserAllOrNothing Maybe SrcLoc
_ Parser a
p -> Parser a -> Bool
forall a. Parser a -> Bool
isEmpty Parser a
p
          ParserCheck Maybe SrcLoc
_ Bool
_ a -> IO (Either String a)
_ Parser a
p -> Parser a -> Bool
forall a. Parser a -> Bool
isEmpty Parser a
p
          ParserCommands Maybe SrcLoc
_ [Command a]
cs -> [Command a] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Command a]
cs
          ParserWithConfig Maybe SrcLoc
_ Parser (Maybe Object)
pc Parser a
ps -> Parser (Maybe Object) -> Bool
forall a. Parser a -> Bool
isEmpty Parser (Maybe Object)
pc Bool -> Bool -> Bool
&& Parser a -> Bool
forall a. Parser a -> Bool
isEmpty Parser a
ps
          ParserSetting Maybe SrcLoc
_ Setting a
_ -> Bool
False
     in case (Parser a -> Bool
forall a. Parser a -> Bool
isEmpty Parser a
p1, Parser a -> Bool
forall a. Parser a -> Bool
isEmpty Parser a
p2) of
          (Bool
True, Bool
True) -> Maybe SrcLoc -> Parser a
forall a. Maybe SrcLoc -> Parser a
ParserEmpty Maybe SrcLoc
forall a. Maybe a
Nothing
          (Bool
True, Bool
False) -> Parser a
p2
          (Bool
False, Bool
True) -> Parser a
p1
          (Bool
False, Bool
False) -> Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
ParserAlt Parser a
p1 Parser a
p2
  many :: forall a. Parser a -> Parser [a]
many = Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
ParserMany

  some :: forall a. Parser a -> Parser [a]
some Parser a
p = (:) (a -> [a] -> [a]) -> Parser a -> Parser ([a] -> [a])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p Parser ([a] -> [a]) -> Parser [a] -> Parser [a]
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser a
p

showParserABit :: Parser a -> String
showParserABit :: forall a. Parser a -> String
showParserABit = (ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String
"") (ShowS -> String) -> (Parser a -> ShowS) -> Parser a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
showParserPrec Int
0

showParserPrec :: Int -> Parser a -> ShowS
showParserPrec :: forall a. Int -> Parser a -> ShowS
showParserPrec = Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go
  where
    go :: Int -> Parser a -> ShowS
    go :: forall a. Int -> Parser a -> ShowS
go Int
d = \case
      ParserPure a
_ -> Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ String -> ShowS
showString String
"Pure _"
      ParserAp Parser (a -> a)
pf Parser a
pa ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Ap "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser (a -> a) -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser (a -> a)
pf
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
pa
      ParserSelect Parser (Either a a)
pe Parser (a -> a)
pf ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Select "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser (Either a a) -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser (Either a a)
pe
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser (a -> a) -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser (a -> a)
pf
      ParserEmpty Maybe SrcLoc
mLoc ->
        String -> ShowS
showString String
"Empty "
          ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe SrcLoc -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe SrcLoc
mLoc
      ParserAlt Parser a
p1 Parser a
p2 ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Alt "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
p1
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
p2
      ParserMany Parser a
p ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Many "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
p
      ParserAllOrNothing Maybe SrcLoc
mLoc Parser a
p ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"AllOrNothing "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe SrcLoc -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe SrcLoc
mLoc
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
p
      ParserCheck Maybe SrcLoc
mLoc Bool
forgivable a -> IO (Either String a)
_ Parser a
p ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Check "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe SrcLoc -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe SrcLoc
mLoc
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Bool -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Bool
forgivable
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" _ "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
p
      ParserCommands Maybe SrcLoc
mLoc [Command a]
cs ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Commands "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe SrcLoc -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe SrcLoc
mLoc
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Command a -> ShowS) -> [Command a] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith
              Command a -> ShowS
forall a. Command a -> ShowS
showCommandABit
              [Command a]
cs
      ParserWithConfig Maybe SrcLoc
mLoc Parser (Maybe Object)
p1 Parser a
p2 ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"WithConfig _ "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe SrcLoc -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe SrcLoc
mLoc
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser (Maybe Object) -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser (Maybe Object)
p1
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Parser a -> ShowS
forall a. Int -> Parser a -> ShowS
go Int
11 Parser a
p2
      ParserSetting Maybe SrcLoc
mLoc Setting a
p ->
        Bool -> ShowS -> ShowS
showParen (Int
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
          String -> ShowS
showString String
"Setting "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Maybe SrcLoc -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec Int
11 Maybe SrcLoc
mLoc
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ShowS
showString String
" "
            ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setting a -> ShowS
forall a. Setting a -> ShowS
showSettingABit Setting a
p

-- | A class of types that have a canonical settings parser.
--
-- There are no laws.
-- The closest rule to a law is that a user of an instance should not be surprised by its behaviour.
class HasParser a where
  settingsParser :: Parser a

-- | 'setting's are the building blocks of 'Parser's.
--
-- 'setting' lets you put together different builders to define what to parse.
--
-- Here are some common examples:
--
--     * Argument
--
--         @
--         setting
--            [ help "Document your argument"
--            , reader str -- The argument is a string
--            , argument
--            ] :: Parser String
--         @
--
--     * Switch
--
--         @
--         setting
--            [ help "Document your switch"
--            , switch True -- The value of the switch when activated
--            , long 'foo' -- "--foo"
--            , short 'f' -- "-f"
--            , value False -- The default value of the switch
--            ] :: Parser Bool
--         @
--
--     * Option
--
--         @
--         setting
--            [ help "Document your option"
--            , reader str -- The argument is a string
--            , long 'foo' -- "--foo"
--            , short 'f' -- "-f"
--            , option
--            ] :: Parser String
--         @
--
--     * Environment Variable
--
--         @
--         setting
--            [ help "Document your environment variable"
--            , reader str -- The argument is a string
--            , env "FOO_BAR"
--            ] :: Parser String
--         @
--
--     * Configuration Value
--
--         @
--         setting
--            [ help "Document your configuration value"
--            , conf "foo-bar"
--            ] :: Parser String
--         @
--
--     * Some combination
--
--         @
--         setting
--            [ help "Document your configuration value"
--            , conf "foo-bar"
--            ] :: Parser String
--         @
--
--         Note that parsing is always tried in this order when using a combined setting:
--
--         1. Argument
--         2. Switch
--         3. Option
--         4. Environment variable
--         5. Configuration value
--
--         (Hence the name of the package.)
setting :: (HasCallStack) => [Builder a] -> Parser a
setting :: forall a. HasCallStack => [Builder a] -> Parser a
setting = Maybe SrcLoc -> Setting a -> Parser a
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting a -> Parser a)
-> ([Builder a] -> Setting a) -> [Builder a] -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder a] -> Setting a
forall a. [Builder a] -> Setting a
buildSetting
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

buildSetting :: [Builder a] -> Setting a
buildSetting :: forall a. [Builder a] -> Setting a
buildSetting = Builder a -> Setting a
forall a. Builder a -> Setting a
completeBuilder (Builder a -> Setting a)
-> ([Builder a] -> Builder a) -> [Builder a] -> Setting a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder a] -> Builder a
forall a. Monoid a => [a] -> a
mconcat

-- | A setting for @Path Abs File@.
--
-- This takes care of setting the 'reader' to 'str', setting the 'metavar' to @FILE_PATH@, autocompletion, and parsing the 'FilePath' into a @Path Abs File@.
filePathSetting ::
  (HasCallStack) =>
  [Builder FilePath] ->
  Parser (Path Abs File)
filePathSetting :: HasCallStack => [Builder String] -> Parser (Path Abs File)
filePathSetting [Builder String]
builders =
  (String -> IO (Path Abs File))
-> Parser String -> Parser (Path Abs File)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO String -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' (Parser String -> Parser (Path Abs File))
-> Parser String -> Parser (Path Abs File)
forall a b. (a -> b) -> a -> b
$
    (HasCallStack => Parser String) -> Parser String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser String) -> Parser String)
-> (HasCallStack => Parser String) -> Parser String
forall a b. (a -> b) -> a -> b
$
      [Builder String] -> Parser String
forall a. HasCallStack => [Builder a] -> Parser a
setting ([Builder String] -> Parser String)
-> [Builder String] -> Parser String
forall a b. (a -> b) -> a -> b
$
        [ Reader String -> Builder String
forall a. Reader a -> Builder a
reader Reader String
forall s. IsString s => Reader s
str,
          String -> Builder String
forall a. String -> Builder a
metavar String
"FILE_PATH" -- TODO file completer
        ]
          [Builder String] -> [Builder String] -> [Builder String]
forall a. [a] -> [a] -> [a]
++ [Builder String]
builders

-- | A setting for @Path Abs dir@.
--
-- This takes care of setting the 'reader' to 'str', setting the 'metavar' to @DIRECTORY_PATH@, autocompletion, and parsing the 'FilePath' into a @Path Abs Dir@.
directoryPathSetting ::
  (HasCallStack) =>
  [Builder FilePath] ->
  Parser (Path Abs Dir)
directoryPathSetting :: HasCallStack => [Builder String] -> Parser (Path Abs Dir)
directoryPathSetting [Builder String]
builders =
  (String -> IO (Path Abs Dir))
-> Parser String -> Parser (Path Abs Dir)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO String -> IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs Dir)
resolveDir' (Parser String -> Parser (Path Abs Dir))
-> Parser String -> Parser (Path Abs Dir)
forall a b. (a -> b) -> a -> b
$
    (HasCallStack => Parser String) -> Parser String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser String) -> Parser String)
-> (HasCallStack => Parser String) -> Parser String
forall a b. (a -> b) -> a -> b
$
      [Builder String] -> Parser String
forall a. HasCallStack => [Builder a] -> Parser a
setting ([Builder String] -> Parser String)
-> [Builder String] -> Parser String
forall a b. (a -> b) -> a -> b
$
        [ Reader String -> Builder String
forall a. Reader a -> Builder a
reader Reader String
forall s. IsString s => Reader s
str,
          String -> Builder String
forall a. String -> Builder a
metavar String
"DIRECTORY_PATH" -- TODO directory completer
        ]
          [Builder String] -> [Builder String] -> [Builder String]
forall a. [a] -> [a] -> [a]
++ [Builder String]
builders

-- | A 'setting' with 'option', a 'reader' set to 'str', and the 'metavar' set to @STR@.
--
-- Note that you can override the 'metavar' with another 'metavar' in the given list of builders.
--
-- This function may help with easier migration from @optparse-applicative@.
strOption :: (HasCallStack) => (IsString string) => [Builder string] -> Parser string
strOption :: forall string.
(HasCallStack, IsString string) =>
[Builder string] -> Parser string
strOption [Builder string]
builders =
  (HasCallStack => Parser string) -> Parser string
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser string) -> Parser string)
-> (HasCallStack => Parser string) -> Parser string
forall a b. (a -> b) -> a -> b
$
    [Builder string] -> Parser string
forall a. HasCallStack => [Builder a] -> Parser a
setting ([Builder string] -> Parser string)
-> [Builder string] -> Parser string
forall a b. (a -> b) -> a -> b
$
      Builder string
forall a. Builder a
option Builder string -> [Builder string] -> [Builder string]
forall a. a -> [a] -> [a]
: Reader string -> Builder string
forall a. Reader a -> Builder a
reader Reader string
forall s. IsString s => Reader s
str Builder string -> [Builder string] -> [Builder string]
forall a. a -> [a] -> [a]
: String -> Builder string
forall a. String -> Builder a
metavar String
"STR" Builder string -> [Builder string] -> [Builder string]
forall a. a -> [a] -> [a]
: [Builder string]
builders

-- | A 'setting' with 'argument', a 'reader' set to 'str', and the 'metavar' set to @STR@.
--
-- Note that you can override the 'metavar' with another 'metavar' in the given list of builders.
--
-- This function may help with easier migration from @optparse-applicative@.
strArgument :: (HasCallStack) => (IsString string) => [Builder string] -> Parser string
strArgument :: forall string.
(HasCallStack, IsString string) =>
[Builder string] -> Parser string
strArgument [Builder string]
builders =
  (HasCallStack => Parser string) -> Parser string
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser string) -> Parser string)
-> (HasCallStack => Parser string) -> Parser string
forall a b. (a -> b) -> a -> b
$
    [Builder string] -> Parser string
forall a. HasCallStack => [Builder a] -> Parser a
setting ([Builder string] -> Parser string)
-> [Builder string] -> Parser string
forall a b. (a -> b) -> a -> b
$
      Builder string
forall a. Builder a
argument Builder string -> [Builder string] -> [Builder string]
forall a. a -> [a] -> [a]
: Reader string -> Builder string
forall a. Reader a -> Builder a
reader Reader string
forall s. IsString s => Reader s
str Builder string -> [Builder string] -> [Builder string]
forall a. a -> [a] -> [a]
: String -> Builder string
forall a. String -> Builder a
metavar String
"STR" Builder string -> [Builder string] -> [Builder string]
forall a. a -> [a] -> [a]
: [Builder string]
builders

-- | Like 'some' but with a more accurate type
someNonEmpty :: Parser a -> Parser (NonEmpty a)
someNonEmpty :: forall a. Parser a -> Parser (NonEmpty a)
someNonEmpty Parser a
p = a -> [a] -> NonEmpty a
forall a. a -> [a] -> NonEmpty a
(:|) (a -> [a] -> NonEmpty a) -> Parser a -> Parser ([a] -> NonEmpty a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p Parser ([a] -> NonEmpty a) -> Parser [a] -> Parser (NonEmpty a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many Parser a
p

-- | Try a list of parsers in order
choice :: (HasCallStack) => [Parser a] -> Parser a
choice :: forall a. HasCallStack => [Parser a] -> Parser a
choice = \case
  [] -> Maybe SrcLoc -> Parser a
forall a. Maybe SrcLoc -> Parser a
ParserEmpty Maybe SrcLoc
mLoc
  [Parser a
c] -> Parser a
c
  (Parser a
c : [Parser a]
cs) -> Parser a
c Parser a -> Parser a -> Parser a
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [Parser a] -> Parser a
forall a. HasCallStack => [Parser a] -> Parser a
choice [Parser a]
cs
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Apply a computation to the result of a parser
--
-- This is intended for use-cases like resolving a file to an absolute path.
-- It is morally ok for read-only IO actions but you will
-- have a bad time if the action is not read-only.
mapIO :: (HasCallStack) => (a -> IO b) -> Parser a -> Parser b
mapIO :: forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO a -> IO b
func = (HasCallStack => Parser a -> Parser b) -> Parser a -> Parser b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a -> Parser b) -> Parser a -> Parser b)
-> (HasCallStack => Parser a -> Parser b) -> Parser a -> Parser b
forall a b. (a -> b) -> a -> b
$ (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
HasCallStack =>
(a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIO ((a -> IO (Either String b)) -> Parser a -> Parser b)
-> (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b. (a -> b) -> a -> b
$ (b -> Either String b) -> IO b -> IO (Either String b)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either String b
forall a b. b -> Either a b
Right (IO b -> IO (Either String b))
-> (a -> IO b) -> a -> IO (Either String b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> IO b
func

-- | Run an IO action without parsing anything
--
-- This action may be run more than once, so prefer to do IO outside of the parser.
runIO :: (HasCallStack) => IO a -> Parser a
runIO :: forall a. HasCallStack => IO a -> Parser a
runIO IO a
func = (HasCallStack => Parser a) -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a) -> Parser a)
-> (HasCallStack => Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$ (() -> IO a) -> Parser () -> Parser a
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO (\() -> IO a
func) (Parser () -> Parser a) -> Parser () -> Parser a
forall a b. (a -> b) -> a -> b
$ () -> Parser ()
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Like 'checkMapMaybe' but without changing the type
checkMaybe :: (HasCallStack) => (a -> Maybe a) -> Parser a -> Parser a
checkMaybe :: forall a. HasCallStack => (a -> Maybe a) -> Parser a -> Parser a
checkMaybe a -> Maybe a
func Parser a
p =
  (HasCallStack => Parser a) -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a) -> Parser a)
-> (HasCallStack => Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$
    (a -> Maybe a) -> Parser a -> Parser a
forall a b. HasCallStack => (a -> Maybe b) -> Parser a -> Parser b
checkMapMaybe a -> Maybe a
func Parser a
p

-- | Like 'checkMapEither' but without a helpful error message.
--
-- Prefer 'checkMapEither'.
checkMapMaybe :: (HasCallStack) => (a -> Maybe b) -> Parser a -> Parser b
checkMapMaybe :: forall a b. HasCallStack => (a -> Maybe b) -> Parser a -> Parser b
checkMapMaybe a -> Maybe b
func Parser a
p =
  (HasCallStack => Parser b) -> Parser b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser b) -> Parser b)
-> (HasCallStack => Parser b) -> Parser b
forall a b. (a -> b) -> a -> b
$
    (a -> Either String b) -> Parser a -> Parser b
forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkMapEither
      ( \a
a -> case a -> Maybe b
func a
a of
          Maybe b
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left String
"checkMapMaybe failed without a helpful error message"
          Just b
b -> b -> Either String b
forall a b. b -> Either a b
Right b
b
      )
      Parser a
p

-- | Like 'checkMapEither' but without changing the type
checkEither :: (HasCallStack) => (a -> Either String b) -> Parser a -> Parser b
checkEither :: forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkEither a -> Either String b
func Parser a
p = (HasCallStack => Parser b) -> Parser b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser b) -> Parser b)
-> (HasCallStack => Parser b) -> Parser b
forall a b. (a -> b) -> a -> b
$ (a -> Either String b) -> Parser a -> Parser b
forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkMapEither a -> Either String b
func Parser a
p

-- | Check a 'Parser' after the fact, purely.
checkMapEither :: (HasCallStack) => (a -> Either String b) -> Parser a -> Parser b
checkMapEither :: forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkMapEither a -> Either String b
func Parser a
p = (HasCallStack => Parser b) -> Parser b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser b) -> Parser b)
-> (HasCallStack => Parser b) -> Parser b
forall a b. (a -> b) -> a -> b
$ (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
HasCallStack =>
(a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIO (Either String b -> IO (Either String b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> IO (Either String b))
-> (a -> Either String b) -> a -> IO (Either String b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
func) Parser a
p

-- | Check a 'Parser' after the fact, allowing IO.
checkMapIO :: (HasCallStack) => (a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIO :: forall a b.
HasCallStack =>
(a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIO = Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
ParserCheck Maybe SrcLoc
mLoc Bool
False
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Parse either all or none of the parser below.
--
-- If you don't use this function, and only some of the settings below are
-- defined, this parser will fail and the next alternative will be tried.
-- If you do use this function, this parser will error unforgivably if at least
-- one, but not all, of the settings below are defined.
--
-- If each setting has a corresponding forgivable error, consider this forgivable.
-- Consider all other forgivable errors unforgivable
--
-- For example, the following will parser will fail intsead of succeed when given the arguments below:
--
-- > ( choice
-- >     [ allOrNothing $
-- >         (,)
-- >           <$> setting [option, long "foo", reader auto, help "This one will exist", metavar "CHAR"]
-- >           <*> setting [option, long "bar", reader auto, help "This one will not exist", metavar "CHAR"],
-- >       pure ('a', 'b')
-- >     ]
-- > )
--
-- > ["--foo", "'a'"]
allOrNothing :: (HasCallStack) => Parser a -> Parser a
allOrNothing :: forall a. HasCallStack => Parser a -> Parser a
allOrNothing = Maybe SrcLoc -> Parser a -> Parser a
forall a. Maybe SrcLoc -> Parser a -> Parser a
ParserAllOrNothing Maybe SrcLoc
mLoc
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Like 'checkMapMaybe', but allow trying the other side of any alternative if the result is Nothing.
checkMapMaybeForgivable :: (HasCallStack) => (a -> Maybe b) -> Parser a -> Parser b
checkMapMaybeForgivable :: forall a b. HasCallStack => (a -> Maybe b) -> Parser a -> Parser b
checkMapMaybeForgivable a -> Maybe b
func Parser a
p =
  (HasCallStack => Parser b) -> Parser b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser b) -> Parser b)
-> (HasCallStack => Parser b) -> Parser b
forall a b. (a -> b) -> a -> b
$
    (a -> Either String b) -> Parser a -> Parser b
forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkMapEitherForgivable
      ( \a
a -> case a -> Maybe b
func a
a of
          Maybe b
Nothing -> String -> Either String b
forall a b. a -> Either a b
Left String
"checkMapMaybeForgivable failed without a helpful error message"
          Just b
b -> b -> Either String b
forall a b. b -> Either a b
Right b
b
      )
      Parser a
p

-- | Like 'checkMapEither', but allow trying the other side of any alternative if the result is Nothing.
checkMapEitherForgivable :: (HasCallStack) => (a -> Either String b) -> Parser a -> Parser b
checkMapEitherForgivable :: forall a b.
HasCallStack =>
(a -> Either String b) -> Parser a -> Parser b
checkMapEitherForgivable a -> Either String b
func Parser a
p = (HasCallStack => Parser b) -> Parser b
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser b) -> Parser b)
-> (HasCallStack => Parser b) -> Parser b
forall a b. (a -> b) -> a -> b
$ (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
HasCallStack =>
(a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIOForgivable (Either String b -> IO (Either String b)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String b -> IO (Either String b))
-> (a -> Either String b) -> a -> IO (Either String b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Either String b
func) Parser a
p

-- | Like 'checkMapIO', but allow trying the other side of any alternative if the result is Nothing.
-- TODO add a SRCLoc here
checkMapIOForgivable :: (HasCallStack) => (a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIOForgivable :: forall a b.
HasCallStack =>
(a -> IO (Either String b)) -> Parser a -> Parser b
checkMapIOForgivable = Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
forall a b.
Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
ParserCheck Maybe SrcLoc
mLoc Bool
True
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Declare multiple commands
--
-- Use 'command' to define a 'Command'.
commands :: (HasCallStack) => [Command a] -> Parser a
commands :: forall a. HasCallStack => [Command a] -> Parser a
commands = Maybe SrcLoc -> [Command a] -> Parser a
forall a. Maybe SrcLoc -> [Command a] -> Parser a
ParserCommands Maybe SrcLoc
mLoc
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Declare a single command with a name, documentation and parser
command ::
  (HasCallStack) =>
  -- | Name
  String ->
  -- | Documentation
  String ->
  -- | Parser
  Parser a ->
  Command a
command :: forall a. HasCallStack => String -> String -> Parser a -> Command a
command = Maybe SrcLoc -> String -> String -> Parser a -> Command a
forall a. Maybe SrcLoc -> String -> String -> Parser a -> Command a
Command Maybe SrcLoc
mLoc
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Load a configuration value and use it for the given parser
withConfig :: (HasCallStack) => Parser (Maybe JSON.Object) -> Parser a -> Parser a
withConfig :: forall a.
HasCallStack =>
Parser (Maybe Object) -> Parser a -> Parser a
withConfig = Maybe SrcLoc -> Parser (Maybe Object) -> Parser a -> Parser a
forall a.
Maybe SrcLoc -> Parser (Maybe Object) -> Parser a -> Parser a
ParserWithConfig Maybe SrcLoc
mLoc
  where
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)

-- | Don't load any configuration, but still shut up lint errors about 'conf'
-- being used without defining any way to load configuration.
--
-- This may be useful if you use a library's 'Parser' that uses 'conf' but do
-- not want to parse any configuration.
withoutConfig :: (HasCallStack) => Parser a -> Parser a
withoutConfig :: forall a. HasCallStack => Parser a -> Parser a
withoutConfig Parser a
p = (HasCallStack => Parser a) -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a) -> Parser a)
-> (HasCallStack => Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser (Maybe Object) -> Parser a -> Parser a
forall a.
HasCallStack =>
Parser (Maybe Object) -> Parser a -> Parser a
withConfig (Maybe Object -> Parser (Maybe Object)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Object
forall a. Maybe a
Nothing) Parser a
p

-- | Load a YAML config file and use it for the given parser
withYamlConfig :: (HasCallStack) => Parser (Maybe (Path Abs File)) -> Parser a -> Parser a
withYamlConfig :: forall a.
HasCallStack =>
Parser (Maybe (Path Abs File)) -> Parser a -> Parser a
withYamlConfig Parser (Maybe (Path Abs File))
pathParser =
  (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a)
-> (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
    Parser (Maybe Object) -> Parser a -> Parser a
forall a.
HasCallStack =>
Parser (Maybe Object) -> Parser a -> Parser a
withConfig (Parser (Maybe Object) -> Parser a -> Parser a)
-> Parser (Maybe Object) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
      (Maybe (Path Abs File) -> IO (Maybe Object))
-> Parser (Maybe (Path Abs File)) -> Parser (Maybe Object)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO ((Maybe (Maybe Object) -> Maybe Object)
-> IO (Maybe (Maybe Object)) -> IO (Maybe Object)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe (Maybe Object) -> Maybe Object
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (IO (Maybe (Maybe Object)) -> IO (Maybe Object))
-> (Maybe (Path Abs File) -> IO (Maybe (Maybe Object)))
-> Maybe (Path Abs File)
-> IO (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Path Abs File -> IO (Maybe Object))
-> Maybe (Path Abs File) -> IO (Maybe (Maybe Object))
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
mapM Path Abs File -> IO (Maybe Object)
forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile) Parser (Maybe (Path Abs File))
pathParser

-- | Load the Yaml config in the first of the filepaths that points to something that exists.
withFirstYamlConfig :: (HasCallStack) => Parser [Path Abs File] -> Parser a -> Parser a
withFirstYamlConfig :: forall a.
HasCallStack =>
Parser [Path Abs File] -> Parser a -> Parser a
withFirstYamlConfig Parser [Path Abs File]
parsers =
  (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a)
-> (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
    Parser (Maybe Object) -> Parser a -> Parser a
forall a.
HasCallStack =>
Parser (Maybe Object) -> Parser a -> Parser a
withConfig (Parser (Maybe Object) -> Parser a -> Parser a)
-> Parser (Maybe Object) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
      ([Path Abs File] -> IO (Maybe Object))
-> Parser [Path Abs File] -> Parser (Maybe Object)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO [Path Abs File] -> IO (Maybe Object)
forall a r. HasCodec a => [Path r File] -> IO (Maybe a)
readFirstYamlConfigFile (Parser [Path Abs File] -> Parser (Maybe Object))
-> Parser [Path Abs File] -> Parser (Maybe Object)
forall a b. (a -> b) -> a -> b
$
        [Path Abs File] -> [Path Abs File] -> [Path Abs File]
forall a. Semigroup a => a -> a -> a
(<>) ([Path Abs File] -> [Path Abs File] -> [Path Abs File])
-> Parser [Path Abs File]
-> Parser ([Path Abs File] -> [Path Abs File])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Path Abs File) -> [Path Abs File]
forall a. Maybe a -> [a]
maybeToList (Maybe (Path Abs File) -> [Path Abs File])
-> Parser (Maybe (Path Abs File)) -> Parser [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Path Abs File) -> Parser (Maybe (Path Abs File))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Path Abs File)
HasCallStack => Parser (Path Abs File)
configuredConfigFile) Parser ([Path Abs File] -> [Path Abs File])
-> Parser [Path Abs File] -> Parser [Path Abs File]
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Path Abs File]
parsers

-- | Combine all Yaml config files that exist into a single combined config object.
withCombinedYamlConfigs :: Parser [Path Abs File] -> Parser a -> Parser a
withCombinedYamlConfigs :: forall a. Parser [Path Abs File] -> Parser a -> Parser a
withCombinedYamlConfigs = (Object -> Object -> Object)
-> Parser [Path Abs File] -> Parser a -> Parser a
forall a.
HasCallStack =>
(Object -> Object -> Object)
-> Parser [Path Abs File] -> Parser a -> Parser a
withCombinedYamlConfigs' Object -> Object -> Object
combineConfigObjects

withCombinedYamlConfigs' :: (HasCallStack) => (Object -> JSON.Object -> JSON.Object) -> Parser [Path Abs File] -> Parser a -> Parser a
withCombinedYamlConfigs' :: forall a.
HasCallStack =>
(Object -> Object -> Object)
-> Parser [Path Abs File] -> Parser a -> Parser a
withCombinedYamlConfigs' Object -> Object -> Object
combiner Parser [Path Abs File]
parsers =
  (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a)
-> (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
    Parser (Maybe Object) -> Parser a -> Parser a
forall a.
HasCallStack =>
Parser (Maybe Object) -> Parser a -> Parser a
withConfig (Parser (Maybe Object) -> Parser a -> Parser a)
-> Parser (Maybe Object) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$
      ([Path Abs File] -> IO (Maybe Object))
-> Parser [Path Abs File] -> Parser (Maybe Object)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO ((Maybe Object -> Path Abs File -> IO (Maybe Object))
-> Maybe Object -> [Path Abs File] -> IO (Maybe Object)
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM Maybe Object -> Path Abs File -> IO (Maybe Object)
resolveYamlConfigFile Maybe Object
forall a. Maybe a
Nothing) (Parser [Path Abs File] -> Parser (Maybe Object))
-> Parser [Path Abs File] -> Parser (Maybe Object)
forall a b. (a -> b) -> a -> b
$
        [Path Abs File] -> [Path Abs File] -> [Path Abs File]
forall a. Semigroup a => a -> a -> a
(<>) ([Path Abs File] -> [Path Abs File] -> [Path Abs File])
-> Parser [Path Abs File]
-> Parser ([Path Abs File] -> [Path Abs File])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe (Path Abs File) -> [Path Abs File]
forall a. Maybe a -> [a]
maybeToList (Maybe (Path Abs File) -> [Path Abs File])
-> Parser (Maybe (Path Abs File)) -> Parser [Path Abs File]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Path Abs File) -> Parser (Maybe (Path Abs File))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (Path Abs File)
HasCallStack => Parser (Path Abs File)
configuredConfigFile) Parser ([Path Abs File] -> [Path Abs File])
-> Parser [Path Abs File] -> Parser [Path Abs File]
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser [Path Abs File]
parsers
  where
    resolveYamlConfigFile :: Maybe JSON.Object -> Path Abs File -> IO (Maybe JSON.Object)
    resolveYamlConfigFile :: Maybe Object -> Path Abs File -> IO (Maybe Object)
resolveYamlConfigFile Maybe Object
acc = (Maybe (Maybe Object) -> Maybe Object)
-> IO (Maybe (Maybe Object)) -> IO (Maybe Object)
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Maybe Object -> Maybe Object -> Maybe Object
combineMaybeObjects Maybe Object
acc (Maybe Object -> Maybe Object)
-> (Maybe (Maybe Object) -> Maybe Object)
-> Maybe (Maybe Object)
-> Maybe Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe (Maybe Object) -> Maybe Object
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join) (IO (Maybe (Maybe Object)) -> IO (Maybe Object))
-> (Path Abs File -> IO (Maybe (Maybe Object)))
-> Path Abs File
-> IO (Maybe Object)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> IO (Maybe (Maybe Object))
forall a r. HasCodec a => Path r File -> IO (Maybe a)
readYamlConfigFile
    -- left biased, first one wins
    combineMaybeObjects :: Maybe JSON.Object -> Maybe JSON.Object -> Maybe JSON.Object
    combineMaybeObjects :: Maybe Object -> Maybe Object -> Maybe Object
combineMaybeObjects Maybe Object
Nothing Maybe Object
mo = Maybe Object
mo
    combineMaybeObjects Maybe Object
mo Maybe Object
Nothing = Maybe Object
mo
    combineMaybeObjects (Just Object
o1) (Just Object
o2) = Object -> Maybe Object
forall a. a -> Maybe a
Just (Object -> Object -> Object
combiner Object
o1 Object
o2)

combineConfigObjects :: JSON.Object -> JSON.Object -> JSON.Object
combineConfigObjects :: Object -> Object -> Object
combineConfigObjects = (Value -> Value -> Value) -> Object -> Object -> Object
forall v. (v -> v -> v) -> KeyMap v -> KeyMap v -> KeyMap v
KM.unionWith Value -> Value -> Value
combineValues
  where
    combineValues :: Value -> Value -> Value
    combineValues :: Value -> Value -> Value
combineValues (Object Object
o) (Object Object
o') = Object -> Value
JSON.Object (Object -> Object -> Object
combineConfigObjects Object
o Object
o')
    combineValues Value
v Value
_ = Value
v

-- | Load @config.yaml@ from the given XDG configuration subdirectory
xdgYamlConfigFile :: (HasCallStack) => FilePath -> Parser (Path Abs File)
xdgYamlConfigFile :: HasCallStack => String -> Parser (Path Abs File)
xdgYamlConfigFile String
subdir =
  (Maybe String -> IO (Path Abs File))
-> Parser (Maybe String) -> Parser (Path Abs File)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO
    ( \Maybe String
mXdgDir -> do
        Path Abs Dir
xdgDir <- case Maybe String
mXdgDir of
          Just String
d -> String -> IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs Dir)
resolveDir' String
d
          Maybe String
Nothing -> do
            Path Abs Dir
home <- IO (Path Abs Dir)
forall (m :: * -> *). MonadIO m => m (Path Abs Dir)
getHomeDir
            Path Abs Dir -> String -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
home String
".config"
        Path Abs Dir
configDir <- Path Abs Dir -> String -> IO (Path Abs Dir)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs Dir)
resolveDir Path Abs Dir
xdgDir String
subdir
        Path Abs Dir -> String -> IO (Path Abs File)
forall (m :: * -> *).
MonadIO m =>
Path Abs Dir -> String -> m (Path Abs File)
resolveFile Path Abs Dir
configDir String
"config.yaml"
    )
    (Parser (Maybe String) -> Parser (Path Abs File))
-> Parser (Maybe String) -> Parser (Path Abs File)
forall a b. (a -> b) -> a -> b
$ Parser String -> Parser (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (Parser String -> Parser (Maybe String))
-> Parser String -> Parser (Maybe String)
forall a b. (a -> b) -> a -> b
$ (HasCallStack => Parser String) -> Parser String
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack
    ((HasCallStack => Parser String) -> Parser String)
-> (HasCallStack => Parser String) -> Parser String
forall a b. (a -> b) -> a -> b
$ [Builder String] -> Parser String
forall a. HasCallStack => [Builder a] -> Parser a
setting
      [ String -> Builder String
forall a. String -> Builder a
help String
"Path to the XDG configuration directory",
        Reader String -> Builder String
forall a. Reader a -> Builder a
reader Reader String
forall s. IsString s => Reader s
str,
        String -> Builder String
forall a. String -> Builder a
env String
"XDG_CONFIG_HOME",
        String -> Builder String
forall a. String -> Builder a
metavar String
"DIRECTORY",
        Builder String
forall a. Builder a
hidden
      ]

-- | Load a config file that is reconfigurable with an option and environment
-- variable but @config.yaml@ in the local working directory by default.
withLocalYamlConfig :: (HasCallStack) => Parser a -> Parser a
withLocalYamlConfig :: forall a. HasCallStack => Parser a -> Parser a
withLocalYamlConfig Parser a
p =
  (HasCallStack => Parser a) -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a) -> Parser a)
-> (HasCallStack => Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$
    Parser (Path Abs File) -> Parser a -> Parser a
forall a.
HasCallStack =>
Parser (Path Abs File) -> Parser a -> Parser a
withConfigurableYamlConfig ((String -> IO (Path Abs File))
-> Parser String -> Parser (Path Abs File)
forall a b. HasCallStack => (a -> IO b) -> Parser a -> Parser b
mapIO String -> IO (Path Abs File)
forall (m :: * -> *). MonadIO m => String -> m (Path Abs File)
resolveFile' (String -> Parser String
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure String
"config.yaml")) Parser a
p

-- | Use the given 'Parser' for deciding which configuration file to load, but
-- only if 'configuredConfigFile' fails to define it first.
withConfigurableYamlConfig :: (HasCallStack) => Parser (Path Abs File) -> Parser a -> Parser a
withConfigurableYamlConfig :: forall a.
HasCallStack =>
Parser (Path Abs File) -> Parser a -> Parser a
withConfigurableYamlConfig Parser (Path Abs File)
pf Parser a
pa =
  (HasCallStack => Parser a) -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser a) -> Parser a)
-> (HasCallStack => Parser a) -> Parser a
forall a b. (a -> b) -> a -> b
$ Parser (Maybe (Path Abs File)) -> Parser a -> Parser a
forall a.
HasCallStack =>
Parser (Maybe (Path Abs File)) -> Parser a -> Parser a
withYamlConfig (Path Abs File -> Maybe (Path Abs File)
forall a. a -> Maybe a
Just (Path Abs File -> Maybe (Path Abs File))
-> Parser (Path Abs File) -> Parser (Maybe (Path Abs File))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser (Path Abs File)
HasCallStack => Parser (Path Abs File)
configuredConfigFile Parser (Path Abs File)
-> Parser (Path Abs File) -> Parser (Path Abs File)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser (Path Abs File)
pf)) Parser a
pa

-- | A standard parser for defining which configuration file to load.
--
-- This has no default value so you will have to combine it somehow.
configuredConfigFile :: (HasCallStack) => Parser (Path Abs File)
configuredConfigFile :: HasCallStack => Parser (Path Abs File)
configuredConfigFile =
  HasCallStack => [Builder String] -> Parser (Path Abs File)
[Builder String] -> Parser (Path Abs File)
filePathSetting
    [ Builder String
forall a. Builder a
option,
      String -> Builder String
forall a. String -> Builder a
long String
"config-file",
      String -> Builder String
forall a. String -> Builder a
env String
"CONFIG_FILE",
      String -> Builder String
forall a. String -> Builder a
help String
"Path to the configuration file"
    ]

-- | Define a setting for a 'Bool' with a given default value.
--
-- If you pass in `long` values, it will have @--foobar@ and @--no-foobar@ switches.
-- If you pass in `env` values, it will read those environment variables too.
-- If you pass in `conf` values, it will read those configuration values too.
yesNoSwitch ::
  (HasCallStack) =>
  -- | Default value
  Bool ->
  -- | Builders
  [Builder Bool] ->
  Parser Bool
yesNoSwitch :: HasCallStack => Bool -> [Builder Bool] -> Parser Bool
yesNoSwitch Bool
defaultBool [Builder Bool]
builders =
  (HasCallStack => Parser Bool) -> Parser Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser Bool) -> Parser Bool)
-> (HasCallStack => Parser Bool) -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    HasCallStack =>
String -> String -> String -> Bool -> [Builder Bool] -> Parser Bool
String -> String -> String -> Bool -> [Builder Bool] -> Parser Bool
makeDoubleSwitch String
"" String
"no-" String
"[no-]" Bool
defaultBool [Builder Bool]
builders

-- | Define a setting for a 'Bool' with a given default value.
--
-- If you pass in `long` values, it will have @--enable-foobar@ and @--disable-foobar@ switches.
-- If you pass in `env` values, it will read those environment variables too.
-- If you pass in `conf` values, it will read those configuration values too.
enableDisableSwitch ::
  (HasCallStack) =>
  -- | Default value
  Bool ->
  -- | Builders
  [Builder Bool] ->
  Parser Bool
enableDisableSwitch :: HasCallStack => Bool -> [Builder Bool] -> Parser Bool
enableDisableSwitch Bool
defaultBool [Builder Bool]
builders =
  (HasCallStack => Parser Bool) -> Parser Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser Bool) -> Parser Bool)
-> (HasCallStack => Parser Bool) -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    HasCallStack =>
String -> String -> String -> Bool -> [Builder Bool] -> Parser Bool
String -> String -> String -> Bool -> [Builder Bool] -> Parser Bool
makeDoubleSwitch String
"enable-" String
"disable-" String
"(enable|disable)-" Bool
defaultBool [Builder Bool]
builders

makeDoubleSwitch ::
  (HasCallStack) =>
  -- | Prefix for 'True' 'long's
  String ->
  -- | Prefix for 'False' 'long's
  String ->
  -- | Prefix for the documented 'long's
  String ->
  -- | Default nvnalue
  Bool ->
  -- | Builders
  [Builder Bool] ->
  Parser Bool
makeDoubleSwitch :: HasCallStack =>
String -> String -> String -> Bool -> [Builder Bool] -> Parser Bool
makeDoubleSwitch String
truePrefix String
falsePrefix String
helpPrefix Bool
defaultBool [Builder Bool]
builders =
  (HasCallStack => Parser Bool) -> Parser Bool
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack ((HasCallStack => Parser Bool) -> Parser Bool)
-> (HasCallStack => Parser Bool) -> Parser Bool
forall a b. (a -> b) -> a -> b
$
    [Parser Bool] -> Parser Bool
forall a. HasCallStack => [Parser a] -> Parser a
choice ([Parser Bool] -> Parser Bool) -> [Parser Bool] -> Parser Bool
forall a b. (a -> b) -> a -> b
$
      [Maybe (Parser Bool)] -> [Parser Bool]
forall a. [Maybe a] -> [a]
catMaybes
        [ Parser Bool -> Maybe (Parser Bool)
forall a. a -> Maybe a
Just Parser Bool
parseDummy,
          Parser Bool -> Maybe (Parser Bool)
forall a. a -> Maybe a
Just Parser Bool
parseDisableSwitch,
          Parser Bool -> Maybe (Parser Bool)
forall a. a -> Maybe a
Just Parser Bool
parseEnableSwitch,
          Maybe (Parser Bool)
parseEnv,
          Maybe (Parser Bool)
parseConfigVal,
          Parser Bool -> Maybe (Parser Bool)
forall a. a -> Maybe a
Just (Parser Bool -> Maybe (Parser Bool))
-> Parser Bool -> Maybe (Parser Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Parser Bool
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
defaultBool
        ]
  where
    s :: Setting Bool
s = [Builder Bool] -> Setting Bool
forall a. [Builder a] -> Setting a
buildSetting [Builder Bool]
builders
    mLoc :: Maybe SrcLoc
mLoc = (String, SrcLoc) -> SrcLoc
forall a b. (a, b) -> b
snd ((String, SrcLoc) -> SrcLoc)
-> Maybe (String, SrcLoc) -> Maybe SrcLoc
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, SrcLoc)] -> Maybe (String, SrcLoc)
forall a. [a] -> Maybe a
listToMaybe (CallStack -> [(String, SrcLoc)]
getCallStack CallStack
HasCallStack => CallStack
callStack)
    parseEnableSwitch :: Parser Bool
    parseEnableSwitch :: Parser Bool
parseEnableSwitch =
      Maybe SrcLoc -> Setting Bool -> Parser Bool
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting Bool -> Parser Bool) -> Setting Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
        Setting
          { settingDasheds :: [Dashed]
settingDasheds = (Dashed -> Maybe Dashed) -> [Dashed] -> [Dashed]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Dashed -> Maybe Dashed
prefixDashedLong String
truePrefix) (Setting Bool -> [Dashed]
forall a. Setting a -> [Dashed]
settingDasheds Setting Bool
s),
            settingReaders :: [Reader Bool]
settingReaders = [],
            settingTryArgument :: Bool
settingTryArgument = Bool
False,
            settingSwitchValue :: Maybe Bool
settingSwitchValue = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True,
            settingTryOption :: Bool
settingTryOption = Bool
False,
            settingEnvVars :: Maybe (NonEmpty String)
settingEnvVars = Maybe (NonEmpty String)
forall a. Maybe a
Nothing,
            settingConfigVals :: Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
settingConfigVals = Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
forall a. Maybe a
Nothing,
            settingDefaultValue :: Maybe (Bool, String)
settingDefaultValue = Maybe (Bool, String)
forall a. Maybe a
Nothing,
            settingExamples :: [String]
settingExamples = [],
            settingHidden :: Bool
settingHidden = Bool
True,
            settingMetavar :: Maybe String
settingMetavar = Maybe String
forall a. Maybe a
Nothing,
            settingHelp :: Maybe String
settingHelp = Maybe String
forall a. Maybe a
Nothing
          }
    parseDisableSwitch :: Parser Bool
    parseDisableSwitch :: Parser Bool
parseDisableSwitch =
      Maybe SrcLoc -> Setting Bool -> Parser Bool
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting Bool -> Parser Bool) -> Setting Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
        Setting
          { settingDasheds :: [Dashed]
settingDasheds = (Dashed -> Maybe Dashed) -> [Dashed] -> [Dashed]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Dashed -> Maybe Dashed
prefixDashedLong String
falsePrefix) (Setting Bool -> [Dashed]
forall a. Setting a -> [Dashed]
settingDasheds Setting Bool
s),
            settingReaders :: [Reader Bool]
settingReaders = [],
            settingTryArgument :: Bool
settingTryArgument = Bool
False,
            settingSwitchValue :: Maybe Bool
settingSwitchValue = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
False,
            settingTryOption :: Bool
settingTryOption = Bool
False,
            settingEnvVars :: Maybe (NonEmpty String)
settingEnvVars = Maybe (NonEmpty String)
forall a. Maybe a
Nothing,
            settingConfigVals :: Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
settingConfigVals = Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
forall a. Maybe a
Nothing,
            settingDefaultValue :: Maybe (Bool, String)
settingDefaultValue = Maybe (Bool, String)
forall a. Maybe a
Nothing,
            settingExamples :: [String]
settingExamples = [],
            settingHidden :: Bool
settingHidden = Bool
True,
            settingMetavar :: Maybe String
settingMetavar = Maybe String
forall a. Maybe a
Nothing,
            settingHelp :: Maybe String
settingHelp = Maybe String
forall a. Maybe a
Nothing
          }

    parseEnv :: Maybe (Parser Bool)
    parseEnv :: Maybe (Parser Bool)
parseEnv = do
      NonEmpty String
ne <- Setting Bool -> Maybe (NonEmpty String)
forall a. Setting a -> Maybe (NonEmpty String)
settingEnvVars Setting Bool
s
      pure $
        Maybe SrcLoc -> Setting Bool -> Parser Bool
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting Bool -> Parser Bool) -> Setting Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
          Setting
            { settingDasheds :: [Dashed]
settingDasheds = [],
              settingReaders :: [Reader Bool]
settingReaders = (Reader Bool
forall a. Read a => Reader a
auto :: Reader Bool) Reader Bool -> [Reader Bool] -> [Reader Bool]
forall a. a -> [a] -> [a]
: Setting Bool -> [Reader Bool]
forall a. Setting a -> [Reader a]
settingReaders Setting Bool
s,
              settingTryArgument :: Bool
settingTryArgument = Bool
False,
              settingSwitchValue :: Maybe Bool
settingSwitchValue = Maybe Bool
forall a. Maybe a
Nothing,
              settingTryOption :: Bool
settingTryOption = Bool
False,
              settingEnvVars :: Maybe (NonEmpty String)
settingEnvVars = NonEmpty String -> Maybe (NonEmpty String)
forall a. a -> Maybe a
Just NonEmpty String
ne,
              settingConfigVals :: Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
settingConfigVals = Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
forall a. Maybe a
Nothing,
              settingDefaultValue :: Maybe (Bool, String)
settingDefaultValue = Maybe (Bool, String)
forall a. Maybe a
Nothing,
              settingExamples :: [String]
settingExamples = [],
              settingHidden :: Bool
settingHidden = Bool
False,
              settingMetavar :: Maybe String
settingMetavar = String -> Maybe String
forall a. a -> Maybe a
Just String
"BOOL",
              settingHelp :: Maybe String
settingHelp = Setting Bool -> Maybe String
forall a. Setting a -> Maybe String
settingHelp Setting Bool
s
            }
    parseConfigVal :: Maybe (Parser Bool)
    parseConfigVal :: Maybe (Parser Bool)
parseConfigVal = do
      NonEmpty (NonEmpty String, DecodingCodec Bool)
ne <- Setting Bool
-> Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
forall a.
Setting a -> Maybe (NonEmpty (NonEmpty String, DecodingCodec a))
settingConfigVals Setting Bool
s
      pure $
        Maybe SrcLoc -> Setting Bool -> Parser Bool
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting Bool -> Parser Bool) -> Setting Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
          Setting
            { settingDasheds :: [Dashed]
settingDasheds = [],
              settingReaders :: [Reader Bool]
settingReaders = [],
              settingTryArgument :: Bool
settingTryArgument = Bool
False,
              settingSwitchValue :: Maybe Bool
settingSwitchValue = Maybe Bool
forall a. Maybe a
Nothing,
              settingTryOption :: Bool
settingTryOption = Bool
False,
              settingEnvVars :: Maybe (NonEmpty String)
settingEnvVars = Maybe (NonEmpty String)
forall a. Maybe a
Nothing,
              settingConfigVals :: Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
settingConfigVals = NonEmpty (NonEmpty String, DecodingCodec Bool)
-> Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
forall a. a -> Maybe a
Just NonEmpty (NonEmpty String, DecodingCodec Bool)
ne,
              settingDefaultValue :: Maybe (Bool, String)
settingDefaultValue = Maybe (Bool, String)
forall a. Maybe a
Nothing,
              settingExamples :: [String]
settingExamples = [],
              settingHidden :: Bool
settingHidden = Bool
False,
              settingMetavar :: Maybe String
settingMetavar = Maybe String
forall a. Maybe a
Nothing,
              settingHelp :: Maybe String
settingHelp = Setting Bool -> Maybe String
forall a. Setting a -> Maybe String
settingHelp Setting Bool
s
            }
    parseDummy :: Parser Bool
    parseDummy :: Parser Bool
parseDummy =
      Maybe SrcLoc -> Setting Bool -> Parser Bool
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting Bool -> Parser Bool) -> Setting Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$
        Setting
          { settingDasheds :: [Dashed]
settingDasheds = (Dashed -> Maybe Dashed) -> [Dashed] -> [Dashed]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Dashed -> Maybe Dashed
prefixDashedLong String
helpPrefix) (Setting Bool -> [Dashed]
forall a. Setting a -> [Dashed]
settingDasheds Setting Bool
s),
            settingReaders :: [Reader Bool]
settingReaders = [],
            settingTryArgument :: Bool
settingTryArgument = Bool
False,
            settingSwitchValue :: Maybe Bool
settingSwitchValue = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
defaultBool, -- Unused
            settingTryOption :: Bool
settingTryOption = Bool
False,
            settingEnvVars :: Maybe (NonEmpty String)
settingEnvVars = Maybe (NonEmpty String)
forall a. Maybe a
Nothing,
            settingConfigVals :: Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
settingConfigVals = Maybe (NonEmpty (NonEmpty String, DecodingCodec Bool))
forall a. Maybe a
Nothing,
            settingDefaultValue :: Maybe (Bool, String)
settingDefaultValue = Maybe (Bool, String)
forall a. Maybe a
Nothing,
            settingExamples :: [String]
settingExamples = [],
            settingHidden :: Bool
settingHidden = Bool
False,
            settingMetavar :: Maybe String
settingMetavar = Maybe String
forall a. Maybe a
Nothing,
            settingHelp :: Maybe String
settingHelp = Setting Bool -> Maybe String
forall a. Setting a -> Maybe String
settingHelp Setting Bool
s
          }
    prefixDashedLong :: String -> Dashed -> Maybe Dashed
    prefixDashedLong :: String -> Dashed -> Maybe Dashed
prefixDashedLong String
prefix = \case
      DashedShort Char
_ -> Maybe Dashed
forall a. Maybe a
Nothing
      Dashed
d -> Dashed -> Maybe Dashed
forall a. a -> Maybe a
Just (Dashed -> Maybe Dashed) -> Dashed -> Maybe Dashed
forall a b. (a -> b) -> a -> b
$ String -> Dashed -> Dashed
prefixDashed String
prefix Dashed
d

-- | Read a text file but strip whitespace so it can be edited with an editor
-- that messes with line endings.
readSecretTextFile :: Path Abs File -> IO Text
readSecretTextFile :: Path Abs File -> IO Text
readSecretTextFile = (Text -> Text) -> IO Text -> IO Text
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
T.strip (IO Text -> IO Text)
-> (Path Abs File -> IO Text) -> Path Abs File -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO Text
T.readFile (String -> IO Text)
-> (Path Abs File -> String) -> Path Abs File -> IO Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path Abs File -> String
fromAbsFile

-- | Prefix all 'long's and 'short's with a given 'String'.
{-# ANN subArgs ("NOCOVER" :: String) #-}
subArgs :: String -> Parser a -> Parser a
subArgs :: forall a. String -> Parser a -> Parser a
subArgs String
prefix = (forall a. Setting a -> Setting a) -> Parser a -> Parser a
forall s.
(forall a. Setting a -> Setting a) -> Parser s -> Parser s
parserMapSetting ((forall a. Setting a -> Setting a) -> Parser a -> Parser a)
-> (forall a. Setting a -> Setting a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ \Setting a
s ->
  Setting a
s {settingDasheds = map (prefixDashed prefix) (settingDasheds s)}

-- | Helper function for calling 'subArgs' with 'toArgCase' and a @'-'@ appended.
--
-- > subArgs_ s = subArgs (toArgCase s <> "-")
subArgs_ :: String -> Parser a -> Parser a
subArgs_ :: forall a. String -> Parser a -> Parser a
subArgs_ String
s = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subArgs (ShowS
toArgCase String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"-")

-- | Prefix all 'env's with a given 'String'.
{-# ANN subEnv ("NOCOVER" :: String) #-}
subEnv :: String -> Parser a -> Parser a
subEnv :: forall a. String -> Parser a -> Parser a
subEnv String
prefix = (forall a. Setting a -> Setting a) -> Parser a -> Parser a
forall s.
(forall a. Setting a -> Setting a) -> Parser s -> Parser s
parserMapSetting ((forall a. Setting a -> Setting a) -> Parser a -> Parser a)
-> (forall a. Setting a -> Setting a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ \Setting a
s ->
  Setting a
s {settingEnvVars = NE.map (prefix <>) <$> settingEnvVars s}

-- | Helper function for calling 'subEnv' with 'toEnvCase' and a @'_'@ appended.
--
-- > subEnv_ s = subEnv (toEnvCase s <> "_")
subEnv_ :: String -> Parser a -> Parser a
subEnv_ :: forall a. String -> Parser a -> Parser a
subEnv_ String
s = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subEnv (ShowS
toEnvCase String
s String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
"_")

-- | Prefix all 'conf's with a given 'String'.
{-# ANN subConfig ("NOCOVER" :: String) #-}
subConfig :: String -> Parser a -> Parser a
subConfig :: forall a. String -> Parser a -> Parser a
subConfig String
prefix = (forall a. Setting a -> Setting a) -> Parser a -> Parser a
forall s.
(forall a. Setting a -> Setting a) -> Parser s -> Parser s
parserMapSetting ((forall a. Setting a -> Setting a) -> Parser a -> Parser a)
-> (forall a. Setting a -> Setting a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ \Setting a
s ->
  Setting a
s {settingConfigVals = NE.map (first (prefix <|)) <$> settingConfigVals s}

-- | Helper function for calling 'subConfig' with 'toConfigCase'.
--
-- > subConfig_ s = subConfig (toConfigCase s)
subConfig_ :: String -> Parser a -> Parser a
subConfig_ :: forall a. String -> Parser a -> Parser a
subConfig_ String
s = String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subConfig (ShowS
toConfigCase String
s)

-- | Helper function for calling 'subArgs_', 'subEnv_' and 'subConfig_' with
-- the same prefix.
--
-- > subAll = subArgs_ prefix . subEnv_ prefix . subConfig_ prefix
subAll :: String -> Parser a -> Parser a
subAll :: forall a. String -> Parser a -> Parser a
subAll String
prefix =
  String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subArgs_ String
prefix
    (Parser a -> Parser a)
-> (Parser a -> Parser a) -> Parser a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subEnv_ String
prefix
    (Parser a -> Parser a)
-> (Parser a -> Parser a) -> Parser a -> Parser a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subConfig_ String
prefix

-- | Use the 'settingsParser' of a given type, but prefixed with a 'subAll' and 'allOrNothing'.
--
-- > subSettings prefix = allOrNothing $ subAll prefix settingsParser
subSettings :: (HasCallStack) => (HasParser a) => String -> Parser a
subSettings :: forall a. (HasCallStack, HasParser a) => String -> Parser a
subSettings String
prefix = (HasCallStack => Parser a -> Parser a) -> Parser a -> Parser a
forall a. HasCallStack => (HasCallStack => a) -> a
withFrozenCallStack HasCallStack => Parser a -> Parser a
Parser a -> Parser a
forall a. HasCallStack => Parser a -> Parser a
allOrNothing (Parser a -> Parser a) -> Parser a -> Parser a
forall a b. (a -> b) -> a -> b
$ String -> Parser a -> Parser a
forall a. String -> Parser a -> Parser a
subAll String
prefix Parser a
forall a. HasParser a => Parser a
settingsParser

-- | Erase all source locations in a parser.
--
-- This may be useful when golden-testing the shown parser.
{-# ANN parserEraseSrcLocs ("NOCOVER" :: String) #-}
parserEraseSrcLocs :: Parser a -> Parser a
parserEraseSrcLocs :: forall a. Parser a -> Parser a
parserEraseSrcLocs = Parser a -> Parser a
forall a. Parser a -> Parser a
go
  where
    go :: forall q. Parser q -> Parser q
    go :: forall a. Parser a -> Parser a
go = \case
      ParserPure q
a -> q -> Parser q
forall a. a -> Parser a
ParserPure q
a
      ParserAp Parser (a -> q)
p1 Parser a
p2 -> Parser (a -> q) -> Parser a -> Parser q
forall a b. Parser (a -> b) -> Parser a -> Parser b
ParserAp (Parser (a -> q) -> Parser (a -> q)
forall a. Parser a -> Parser a
go Parser (a -> q)
p1) (Parser a -> Parser a
forall a. Parser a -> Parser a
go Parser a
p2)
      ParserSelect Parser (Either a q)
p1 Parser (a -> q)
p2 -> Parser (Either a q) -> Parser (a -> q) -> Parser q
forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
ParserSelect (Parser (Either a q) -> Parser (Either a q)
forall a. Parser a -> Parser a
go Parser (Either a q)
p1) (Parser (a -> q) -> Parser (a -> q)
forall a. Parser a -> Parser a
go Parser (a -> q)
p2)
      ParserEmpty Maybe SrcLoc
_ -> Maybe SrcLoc -> Parser q
forall a. Maybe SrcLoc -> Parser a
ParserEmpty Maybe SrcLoc
forall a. Maybe a
Nothing
      ParserAlt Parser q
p1 Parser q
p2 -> Parser q -> Parser q -> Parser q
forall a. Parser a -> Parser a -> Parser a
ParserAlt (Parser q -> Parser q
forall a. Parser a -> Parser a
go Parser q
p1) (Parser q -> Parser q
forall a. Parser a -> Parser a
go Parser q
p2)
      ParserMany Parser a
p -> Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
ParserMany (Parser a -> Parser a
forall a. Parser a -> Parser a
go Parser a
p)
      ParserAllOrNothing Maybe SrcLoc
_ Parser q
p -> Maybe SrcLoc -> Parser q -> Parser q
forall a. Maybe SrcLoc -> Parser a -> Parser a
ParserAllOrNothing Maybe SrcLoc
forall a. Maybe a
Nothing (Parser q -> Parser q
forall a. Parser a -> Parser a
go Parser q
p)
      ParserCheck Maybe SrcLoc
_ Bool
forgivable a -> IO (Either String q)
f Parser a
p -> Maybe SrcLoc
-> Bool -> (a -> IO (Either String q)) -> Parser a -> Parser q
forall a b.
Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
ParserCheck Maybe SrcLoc
forall a. Maybe a
Nothing Bool
forgivable a -> IO (Either String q)
f (Parser a -> Parser a
forall a. Parser a -> Parser a
go Parser a
p)
      ParserCommands Maybe SrcLoc
_ [Command q]
cs -> Maybe SrcLoc -> [Command q] -> Parser q
forall a. Maybe SrcLoc -> [Command a] -> Parser a
ParserCommands Maybe SrcLoc
forall a. Maybe a
Nothing ([Command q] -> Parser q) -> [Command q] -> Parser q
forall a b. (a -> b) -> a -> b
$ (Command q -> Command q) -> [Command q] -> [Command q]
forall a b. (a -> b) -> [a] -> [b]
map Command q -> Command q
forall a. Command a -> Command a
commandEraseSrcLocs [Command q]
cs
      ParserWithConfig Maybe SrcLoc
_ Parser (Maybe Object)
p1 Parser q
p2 -> Maybe SrcLoc -> Parser (Maybe Object) -> Parser q -> Parser q
forall a.
Maybe SrcLoc -> Parser (Maybe Object) -> Parser a -> Parser a
ParserWithConfig Maybe SrcLoc
forall a. Maybe a
Nothing (Parser (Maybe Object) -> Parser (Maybe Object)
forall a. Parser a -> Parser a
go Parser (Maybe Object)
p1) (Parser q -> Parser q
forall a. Parser a -> Parser a
go Parser q
p2)
      ParserSetting Maybe SrcLoc
_ Setting q
s -> Maybe SrcLoc -> Setting q -> Parser q
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
forall a. Maybe a
Nothing Setting q
s

commandEraseSrcLocs :: Command a -> Command a
commandEraseSrcLocs :: forall a. Command a -> Command a
commandEraseSrcLocs Command a
c =
  Command a
c
    { commandSrcLoc = Nothing,
      commandParser = parserEraseSrcLocs (commandParser c)
    }

-- | Map all 'Setting' in a 'Parser'.
{-# ANN parserMapSetting ("NOCOVER" :: String) #-}
parserMapSetting :: (forall a. Setting a -> Setting a) -> Parser s -> Parser s
parserMapSetting :: forall s.
(forall a. Setting a -> Setting a) -> Parser s -> Parser s
parserMapSetting forall a. Setting a -> Setting a
func = Identity (Parser s) -> Parser s
forall a. Identity a -> a
runIdentity (Identity (Parser s) -> Parser s)
-> (Parser s -> Identity (Parser s)) -> Parser s -> Parser s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Setting a -> Identity (Setting a))
-> Parser s -> Identity (Parser s)
forall (f :: * -> *) s.
Applicative f =>
(forall a. Setting a -> f (Setting a)) -> Parser s -> f (Parser s)
parserTraverseSetting (Setting a -> Identity (Setting a)
forall a. a -> Identity a
Identity (Setting a -> Identity (Setting a))
-> (Setting a -> Setting a) -> Setting a -> Identity (Setting a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Setting a -> Setting a
forall a. Setting a -> Setting a
func)

-- | Traverse all 'Setting's in a 'Parser'.
{-# ANN parserTraverseSetting ("NOCOVER" :: String) #-}
parserTraverseSetting ::
  forall f s.
  (Applicative f) =>
  (forall a. Setting a -> f (Setting a)) ->
  Parser s ->
  f (Parser s)
parserTraverseSetting :: forall (f :: * -> *) s.
Applicative f =>
(forall a. Setting a -> f (Setting a)) -> Parser s -> f (Parser s)
parserTraverseSetting forall a. Setting a -> f (Setting a)
func = Parser s -> f (Parser s)
forall q. Parser q -> f (Parser q)
go
  where
    go :: forall q. Parser q -> f (Parser q)
    go :: forall q. Parser q -> f (Parser q)
go = \case
      ParserPure q
a -> Parser q -> f (Parser q)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser q -> f (Parser q)) -> Parser q -> f (Parser q)
forall a b. (a -> b) -> a -> b
$ q -> Parser q
forall a. a -> Parser a
ParserPure q
a
      ParserAp Parser (a -> q)
p1 Parser a
p2 -> Parser (a -> q) -> Parser a -> Parser q
forall a b. Parser (a -> b) -> Parser a -> Parser b
ParserAp (Parser (a -> q) -> Parser a -> Parser q)
-> f (Parser (a -> q)) -> f (Parser a -> Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (a -> q) -> f (Parser (a -> q))
forall q. Parser q -> f (Parser q)
go Parser (a -> q)
p1 f (Parser a -> Parser q) -> f (Parser a) -> f (Parser q)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser a -> f (Parser a)
forall q. Parser q -> f (Parser q)
go Parser a
p2
      ParserSelect Parser (Either a q)
p1 Parser (a -> q)
p2 -> Parser (Either a q) -> Parser (a -> q) -> Parser q
forall a b. Parser (Either a b) -> Parser (a -> b) -> Parser b
ParserSelect (Parser (Either a q) -> Parser (a -> q) -> Parser q)
-> f (Parser (Either a q)) -> f (Parser (a -> q) -> Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Either a q) -> f (Parser (Either a q))
forall q. Parser q -> f (Parser q)
go Parser (Either a q)
p1 f (Parser (a -> q) -> Parser q)
-> f (Parser (a -> q)) -> f (Parser q)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (a -> q) -> f (Parser (a -> q))
forall q. Parser q -> f (Parser q)
go Parser (a -> q)
p2
      ParserEmpty Maybe SrcLoc
mLoc -> Parser q -> f (Parser q)
forall a. a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Parser q -> f (Parser q)) -> Parser q -> f (Parser q)
forall a b. (a -> b) -> a -> b
$ Maybe SrcLoc -> Parser q
forall a. Maybe SrcLoc -> Parser a
ParserEmpty Maybe SrcLoc
mLoc
      ParserAlt Parser q
p1 Parser q
p2 -> Parser q -> Parser q -> Parser q
forall a. Parser a -> Parser a -> Parser a
ParserAlt (Parser q -> Parser q -> Parser q)
-> f (Parser q) -> f (Parser q -> Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser q -> f (Parser q)
forall q. Parser q -> f (Parser q)
go Parser q
p1 f (Parser q -> Parser q) -> f (Parser q) -> f (Parser q)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser q -> f (Parser q)
forall q. Parser q -> f (Parser q)
go Parser q
p2
      ParserMany Parser a
p -> Parser a -> Parser q
Parser a -> Parser [a]
forall a. Parser a -> Parser [a]
ParserMany (Parser a -> Parser q) -> f (Parser a) -> f (Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> f (Parser a)
forall q. Parser q -> f (Parser q)
go Parser a
p
      ParserAllOrNothing Maybe SrcLoc
mLoc Parser q
p -> Maybe SrcLoc -> Parser q -> Parser q
forall a. Maybe SrcLoc -> Parser a -> Parser a
ParserAllOrNothing Maybe SrcLoc
mLoc (Parser q -> Parser q) -> f (Parser q) -> f (Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser q -> f (Parser q)
forall q. Parser q -> f (Parser q)
go Parser q
p
      ParserCheck Maybe SrcLoc
mLoc Bool
forgivable a -> IO (Either String q)
f Parser a
p -> Maybe SrcLoc
-> Bool -> (a -> IO (Either String q)) -> Parser a -> Parser q
forall a b.
Maybe SrcLoc
-> Bool -> (a -> IO (Either String b)) -> Parser a -> Parser b
ParserCheck Maybe SrcLoc
mLoc Bool
forgivable a -> IO (Either String q)
f (Parser a -> Parser q) -> f (Parser a) -> f (Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a -> f (Parser a)
forall q. Parser q -> f (Parser q)
go Parser a
p
      ParserCommands Maybe SrcLoc
mLoc [Command q]
cs -> Maybe SrcLoc -> [Command q] -> Parser q
forall a. Maybe SrcLoc -> [Command a] -> Parser a
ParserCommands Maybe SrcLoc
mLoc ([Command q] -> Parser q) -> f [Command q] -> f (Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Command q -> f (Command q)) -> [Command q] -> f [Command q]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse ((forall a. Setting a -> f (Setting a))
-> Command q -> f (Command q)
forall (f :: * -> *) s.
Applicative f =>
(forall a. Setting a -> f (Setting a))
-> Command s -> f (Command s)
commandTraverseSetting Setting a -> f (Setting a)
forall a. Setting a -> f (Setting a)
func) [Command q]
cs
      ParserWithConfig Maybe SrcLoc
mLoc Parser (Maybe Object)
p1 Parser q
p2 -> Maybe SrcLoc -> Parser (Maybe Object) -> Parser q -> Parser q
forall a.
Maybe SrcLoc -> Parser (Maybe Object) -> Parser a -> Parser a
ParserWithConfig Maybe SrcLoc
mLoc (Parser (Maybe Object) -> Parser q -> Parser q)
-> f (Parser (Maybe Object)) -> f (Parser q -> Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Maybe Object) -> f (Parser (Maybe Object))
forall q. Parser q -> f (Parser q)
go Parser (Maybe Object)
p1 f (Parser q -> Parser q) -> f (Parser q) -> f (Parser q)
forall a b. f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser q -> f (Parser q)
forall q. Parser q -> f (Parser q)
go Parser q
p2
      ParserSetting Maybe SrcLoc
mLoc Setting q
s -> Maybe SrcLoc -> Setting q -> Parser q
forall a. Maybe SrcLoc -> Setting a -> Parser a
ParserSetting Maybe SrcLoc
mLoc (Setting q -> Parser q) -> f (Setting q) -> f (Parser q)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Setting q -> f (Setting q)
forall a. Setting a -> f (Setting a)
func Setting q
s

{-# ANN commandTraverseSetting ("NOCOVER" :: String) #-}
commandTraverseSetting ::
  forall f s.
  (Applicative f) =>
  (forall a. Setting a -> f (Setting a)) ->
  Command s ->
  f (Command s)
commandTraverseSetting :: forall (f :: * -> *) s.
Applicative f =>
(forall a. Setting a -> f (Setting a))
-> Command s -> f (Command s)
commandTraverseSetting forall a. Setting a -> f (Setting a)
func Command s
c = do
  (\Parser s
p -> Command s
c {commandParser = p})
    (Parser s -> Command s) -> f (Parser s) -> f (Command s)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Setting a -> f (Setting a)) -> Parser s -> f (Parser s)
forall (f :: * -> *) s.
Applicative f =>
(forall a. Setting a -> f (Setting a)) -> Parser s -> f (Parser s)
parserTraverseSetting Setting a -> f (Setting a)
forall a. Setting a -> f (Setting a)
func (Command s -> Parser s
forall a. Command a -> Parser a
commandParser Command s
c)

parserSettingsSet :: Parser a -> Set SrcLocHash
parserSettingsSet :: forall a. Parser a -> Set SrcLocHash
parserSettingsSet = Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go
  where
    go :: Parser a -> Set SrcLocHash
    go :: forall a. Parser a -> Set SrcLocHash
go = \case
      ParserPure a
_ -> Set SrcLocHash
forall a. Set a
S.empty
      ParserAp Parser (a -> a)
p1 Parser a
p2 -> Set SrcLocHash -> Set SrcLocHash -> Set SrcLocHash
forall a. Ord a => Set a -> Set a -> Set a
S.union (Parser (a -> a) -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser (a -> a)
p1) (Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p2)
      ParserSelect Parser (Either a a)
p1 Parser (a -> a)
p2 -> Set SrcLocHash -> Set SrcLocHash -> Set SrcLocHash
forall a. Ord a => Set a -> Set a -> Set a
S.union (Parser (Either a a) -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser (Either a a)
p1) (Parser (a -> a) -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser (a -> a)
p2)
      ParserEmpty Maybe SrcLoc
_ -> Set SrcLocHash
forall a. Set a
S.empty
      ParserAlt Parser a
p1 Parser a
p2 -> Set SrcLocHash -> Set SrcLocHash -> Set SrcLocHash
forall a. Ord a => Set a -> Set a -> Set a
S.union (Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p1) (Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p2)
      ParserMany Parser a
p -> Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p
      ParserAllOrNothing Maybe SrcLoc
_ Parser a
p -> Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p -- TODO is this right?
      ParserCheck Maybe SrcLoc
_ Bool
_ a -> IO (Either String a)
_ Parser a
p -> Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p
      ParserCommands Maybe SrcLoc
_ [Command a]
cs -> [Set SrcLocHash] -> Set SrcLocHash
forall (f :: * -> *) a. (Foldable f, Ord a) => f (Set a) -> Set a
S.unions ([Set SrcLocHash] -> Set SrcLocHash)
-> [Set SrcLocHash] -> Set SrcLocHash
forall a b. (a -> b) -> a -> b
$ (Command a -> Set SrcLocHash) -> [Command a] -> [Set SrcLocHash]
forall a b. (a -> b) -> [a] -> [b]
map (Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go (Parser a -> Set SrcLocHash)
-> (Command a -> Parser a) -> Command a -> Set SrcLocHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Command a -> Parser a
forall a. Command a -> Parser a
commandParser) [Command a]
cs
      ParserWithConfig Maybe SrcLoc
_ Parser (Maybe Object)
p1 Parser a
p2 -> Set SrcLocHash -> Set SrcLocHash -> Set SrcLocHash
forall a. Ord a => Set a -> Set a -> Set a
S.union (Parser (Maybe Object) -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser (Maybe Object)
p1) (Parser a -> Set SrcLocHash
forall a. Parser a -> Set SrcLocHash
go Parser a
p2)
      -- The nothing part shouldn't happen but I don't know when it doesn't
      ParserSetting Maybe SrcLoc
mLoc Setting a
_ -> Set SrcLocHash
-> (SrcLoc -> Set SrcLocHash) -> Maybe SrcLoc -> Set SrcLocHash
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Set SrcLocHash
forall a. Set a
S.empty (SrcLocHash -> Set SrcLocHash
forall a. a -> Set a
S.singleton (SrcLocHash -> Set SrcLocHash)
-> (SrcLoc -> SrcLocHash) -> SrcLoc -> Set SrcLocHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> SrcLocHash
hashSrcLoc) Maybe SrcLoc
mLoc

newtype SrcLocHash = SrcLocHash Int
  deriving (Int -> SrcLocHash -> ShowS
[SrcLocHash] -> ShowS
SrcLocHash -> String
(Int -> SrcLocHash -> ShowS)
-> (SrcLocHash -> String)
-> ([SrcLocHash] -> ShowS)
-> Show SrcLocHash
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SrcLocHash -> ShowS
showsPrec :: Int -> SrcLocHash -> ShowS
$cshow :: SrcLocHash -> String
show :: SrcLocHash -> String
$cshowList :: [SrcLocHash] -> ShowS
showList :: [SrcLocHash] -> ShowS
Show, SrcLocHash -> SrcLocHash -> Bool
(SrcLocHash -> SrcLocHash -> Bool)
-> (SrcLocHash -> SrcLocHash -> Bool) -> Eq SrcLocHash
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SrcLocHash -> SrcLocHash -> Bool
== :: SrcLocHash -> SrcLocHash -> Bool
$c/= :: SrcLocHash -> SrcLocHash -> Bool
/= :: SrcLocHash -> SrcLocHash -> Bool
Eq, Eq SrcLocHash
Eq SrcLocHash =>
(SrcLocHash -> SrcLocHash -> Ordering)
-> (SrcLocHash -> SrcLocHash -> Bool)
-> (SrcLocHash -> SrcLocHash -> Bool)
-> (SrcLocHash -> SrcLocHash -> Bool)
-> (SrcLocHash -> SrcLocHash -> Bool)
-> (SrcLocHash -> SrcLocHash -> SrcLocHash)
-> (SrcLocHash -> SrcLocHash -> SrcLocHash)
-> Ord SrcLocHash
SrcLocHash -> SrcLocHash -> Bool
SrcLocHash -> SrcLocHash -> Ordering
SrcLocHash -> SrcLocHash -> SrcLocHash
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: SrcLocHash -> SrcLocHash -> Ordering
compare :: SrcLocHash -> SrcLocHash -> Ordering
$c< :: SrcLocHash -> SrcLocHash -> Bool
< :: SrcLocHash -> SrcLocHash -> Bool
$c<= :: SrcLocHash -> SrcLocHash -> Bool
<= :: SrcLocHash -> SrcLocHash -> Bool
$c> :: SrcLocHash -> SrcLocHash -> Bool
> :: SrcLocHash -> SrcLocHash -> Bool
$c>= :: SrcLocHash -> SrcLocHash -> Bool
>= :: SrcLocHash -> SrcLocHash -> Bool
$cmax :: SrcLocHash -> SrcLocHash -> SrcLocHash
max :: SrcLocHash -> SrcLocHash -> SrcLocHash
$cmin :: SrcLocHash -> SrcLocHash -> SrcLocHash
min :: SrcLocHash -> SrcLocHash -> SrcLocHash
Ord)

hashSrcLoc :: SrcLoc -> SrcLocHash
hashSrcLoc :: SrcLoc -> SrcLocHash
hashSrcLoc = Int -> SrcLocHash
SrcLocHash (Int -> SrcLocHash) -> (SrcLoc -> Int) -> SrcLoc -> SrcLocHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Int
forall a. Hashable a => a -> Int
hash (String -> Int) -> (SrcLoc -> String) -> SrcLoc -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> String
prettySrcLoc