{- |
Description :  Command-line options and DSV parsing and printing
Maintainer  :  defanor <defanor@uberspace.net>
Stability   :  unstable
Portability :  non-portable (uses GHC extensions)

Coalpit is a library for building command-line interfaces: the goal is
to build interfaces quickly and easily (by deriving those), while
keeping them language-agnostic and more user- and shell
scripting-friendly than JSON and similar formats.

-}

{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Coalpit ( fromDSV
               , fromDSVList
               , toDSV
               , toDSVList
               , dsvFromList
               , Coalpit(..)
                 -- * Usage
               , usage
               , usageString
               , Usage(..)
                 -- * Options
               , SelNamePolicy(..)
               , Options(..)
               , defOpt
                 -- * Parsing and composition helpers
               , escape
               , pString
               , pFieldSep
               , pRecordSep
               ) where

import GHC.Generics
import Text.Parsec
import Text.Parsec.String
import Data.Char (toLower)
import Data.Proxy (Proxy(..))
import qualified Data.List.NonEmpty as NE
import Data.List.NonEmpty (NonEmpty(..))
import Data.List (intercalate)
import Data.Word (Word8, Word16, Word32, Word64)
import Numeric.Natural (Natural)
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Time.Clock (DiffTime, NominalDiffTime, UniversalTime, UTCTime)
import Data.Time.Format ( TimeLocale, formatTime
                        , iso8601DateFormat, defaultTimeLocale
                        , ParseTime, readSTime)
import Data.Time.Calendar (Day)
import Data.Time.LocalTime (TimeOfDay, LocalTime, ZonedTime)
import Data.Scientific (Scientific, FPFormat(..), formatScientific, scientificP)
import Text.ParserCombinators.ReadP (readP_to_S)
import Data.Complex (Complex)
import Data.Version (Version, parseVersion, showVersion)
import System.Exit (ExitCode)
import Network.URI (URI, parseURIReference, uriToString)

-- | Usage description: can be translated into help messages or
-- documentation formats.
data Usage = UConstructor String
           -- ^ Data constructor.
           | URecursive String
           -- ^ Constructor of a recursive data structure (its second
           -- appearance in the tree).
           | USelector Bool String Usage
           -- ^ Record selector.
           | UOptional Usage
           -- ^ Optional element.
           | USum Usage Usage
           -- ^ Sum.
           | UProduct Usage Usage
           -- ^ Product.
           | UUnit
           -- ^ Unit.
           | UType String
           -- ^ Type name (e.g., \"INT\").
           deriving (Int -> Usage -> ShowS
[Usage] -> ShowS
Usage -> String
(Int -> Usage -> ShowS)
-> (Usage -> String) -> ([Usage] -> ShowS) -> Show Usage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Usage -> ShowS
showsPrec :: Int -> Usage -> ShowS
$cshow :: Usage -> String
show :: Usage -> String
$cshowList :: [Usage] -> ShowS
showList :: [Usage] -> ShowS
Show)

-- | How to handle selector names.
data SelNamePolicy = SNDisable
                   -- ^ Do not parse or print selector names
                   | SNAvoid
                   -- ^ Allow selector names on parsing, but do not
                   -- print them
                   | SNPrefer
                   -- ^ Allow selector names on parsing, print them
                   | SNRequire
                   -- ^ Require selector names on parsing, print them
  deriving (Int -> SelNamePolicy -> ShowS
[SelNamePolicy] -> ShowS
SelNamePolicy -> String
(Int -> SelNamePolicy -> ShowS)
-> (SelNamePolicy -> String)
-> ([SelNamePolicy] -> ShowS)
-> Show SelNamePolicy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelNamePolicy -> ShowS
showsPrec :: Int -> SelNamePolicy -> ShowS
$cshow :: SelNamePolicy -> String
show :: SelNamePolicy -> String
$cshowList :: [SelNamePolicy] -> ShowS
showList :: [SelNamePolicy] -> ShowS
Show, SelNamePolicy -> SelNamePolicy -> Bool
(SelNamePolicy -> SelNamePolicy -> Bool)
-> (SelNamePolicy -> SelNamePolicy -> Bool) -> Eq SelNamePolicy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelNamePolicy -> SelNamePolicy -> Bool
== :: SelNamePolicy -> SelNamePolicy -> Bool
$c/= :: SelNamePolicy -> SelNamePolicy -> Bool
/= :: SelNamePolicy -> SelNamePolicy -> Bool
Eq)

-- | Printing and parsing options.
data Options = Options { Options -> NonEmpty Char
fieldSeparators :: NonEmpty Char
                       -- ^ Separators between fields
                       , Options -> NonEmpty Char
recordSeparators :: NonEmpty Char
                       -- ^ Separators between records (which may
                       -- correspond to lines)
                       , Options -> ShowS
conNameMod :: String -> String
                       -- ^ Constructor name modifier
                       , Options -> ShowS
selNameMod :: String -> String
                       -- ^ Record selector name modifier
                       , Options -> SelNamePolicy
selNamePolicy :: SelNamePolicy
                       , Options -> TimeLocale
timeLocale :: TimeLocale
                       , Options -> String
dateFormat :: String
                       -- ^ See "Data.Time.Format".
                       , Options -> String
timeFormat :: String
                       , Options -> String
dateTimeFormat :: String
                       , Options -> FPFormat
scientificFormat :: FPFormat
                       , Options -> Maybe Int
scientificDecimals :: Maybe Int
                       , Options -> ShowS
uriUserInfo :: String -> String
                       -- ^ Used to map userinfo parts of URIs.
                       }

-- | Default options.
defOpt :: Options
defOpt :: Options
defOpt = NonEmpty Char
-> NonEmpty Char
-> ShowS
-> ShowS
-> SelNamePolicy
-> TimeLocale
-> String
-> String
-> String
-> FPFormat
-> Maybe Int
-> ShowS
-> Options
Options (Char
' ' Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [Char
'\t']) (Char
'\n' Char -> String -> NonEmpty Char
forall a. a -> [a] -> NonEmpty a
:| [])
  ((Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) ((String
"--" String -> ShowS
forall a. [a] -> [a] -> [a]
++) ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Char) -> ShowS
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower) SelNamePolicy
SNAvoid
  TimeLocale
defaultTimeLocale (Maybe String -> String
iso8601DateFormat Maybe String
forall a. Maybe a
Nothing) String
"%H:%M:%S"
  (Maybe String -> String
iso8601DateFormat (String -> Maybe String
forall a. a -> Maybe a
Just String
"%H:%M:%S")) FPFormat
Generic Maybe Int
forall a. Maybe a
Nothing ShowS
forall a. a -> a
id

parseDSV :: Parser a -> String -> Either String a
parseDSV :: forall a. Parser a -> String -> Either String a
parseDSV Parser a
p String
s = case Parser a -> String -> String -> Either ParseError a
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser a
p String
"DSV" String
s of
  Left ParseError
err -> String -> Either String a
forall a b. a -> Either a b
Left (String -> Either String a) -> String -> Either String a
forall a b. (a -> b) -> a -> b
$ ParseError -> String
forall a. Show a => a -> String
show ParseError
err
  Right a
x -> a -> Either String a
forall a b. b -> Either a b
Right a
x

-- | Parse a single record from a string.
fromDSV :: Coalpit a => Options -> String -> Either String a
fromDSV :: forall a. Coalpit a => Options -> String -> Either String a
fromDSV Options
opt String
str = Parser a -> String -> Either String a
forall a. Parser a -> String -> Either String a
parseDSV (Options -> Parser a
forall a. Coalpit a => Options -> Parser a
coalpitParser Options
opt) String
str

-- | Parse multiple records from a string.
fromDSVList :: Coalpit a => Options -> String -> Either String [a]
fromDSVList :: forall a. Coalpit a => Options -> String -> Either String [a]
fromDSVList Options
opt String
str =
  Parser [a] -> String -> Either String [a]
forall a. Parser a -> String -> Either String a
parseDSV (Options -> Parser a
forall a. Coalpit a => Options -> Parser a
coalpitParser Options
opt Parser a -> ParsecT String () Identity () -> Parser [a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepEndBy` Options -> ParsecT String () Identity ()
forall m. Options -> Parsec String m ()
pRecordSep Options
opt) String
str

-- | Enquote and escape a string, if it contains any characters that
-- need it.
escape :: Options -> String -> String
escape :: Options -> ShowS
escape Options
opt String
str
  | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
str) Bool -> Bool -> Bool
&&
    (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (\Char
fs -> Bool -> Bool
not (Char
fs Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
str))
    (Char
'\\'
     Char -> ShowS
forall a. a -> [a] -> [a]
: Char
'\"'
     Char -> ShowS
forall a. a -> [a] -> [a]
: NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList (Options -> NonEmpty Char
fieldSeparators Options
opt)
     String -> ShowS
forall a. [a] -> [a] -> [a]
++ NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList (Options -> NonEmpty Char
recordSeparators Options
opt)) = String
str
  | Bool
otherwise = Char
'"' Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escaped String
str String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"\""
  where
    escaped :: String -> String
    escaped :: ShowS
escaped [] = []
    escaped (Char
c:String
rest)
      | Char
c Char -> String -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
"\\\"" = Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escaped String
rest
      | Bool
otherwise = Char
c Char -> ShowS
forall a. a -> [a] -> [a]
: ShowS
escaped String
rest

-- | Build a record ("line") out of individual strings, escaping those
-- if needed.
dsvFromList :: Options -> [String] -> String
dsvFromList :: Options -> [String] -> String
dsvFromList Options
opt [String]
l = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate [NonEmpty Char -> Char
forall a. NonEmpty a -> a
NE.head (Options -> NonEmpty Char
fieldSeparators Options
opt)]
                    (ShowS -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (Options -> ShowS
escape Options
opt) [String]
l)

-- | Serialize a value.
toDSV :: Coalpit a => Options -> a -> String
toDSV :: forall a. Coalpit a => Options -> a -> String
toDSV Options
opt a
x = Options -> [String] -> String
dsvFromList Options
opt (Options -> a -> [String]
forall a. Coalpit a => Options -> a -> [String]
coalpitPrint Options
opt a
x)

-- | Serialize multiple values.
toDSVList :: Coalpit a => Options -> [a] -> String
toDSVList :: forall a. Coalpit a => Options -> [a] -> String
toDSVList Options
opt [a]
l =
  (a -> String) -> [a] -> String
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\a
x -> Options -> a -> String
forall a. Coalpit a => Options -> a -> String
toDSV Options
opt a
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ [NonEmpty Char -> Char
forall a. NonEmpty a -> a
NE.head (Options -> NonEmpty Char
recordSeparators Options
opt)]) [a]
l

-- | Compose 'Usage' description.
usage :: Coalpit a => Options -> Proxy a -> Usage
usage :: forall a. Coalpit a => Options -> Proxy a -> Usage
usage Options
opt = Options -> [String] -> Proxy a -> Usage
forall a. Coalpit a => Options -> [String] -> Proxy a -> Usage
coalpitDescription Options
opt []

-- | Compose a usage string.
usageString :: Coalpit a => Options -> Proxy a -> String
usageString :: forall a. Coalpit a => Options -> Proxy a -> String
usageString Options
opt = Usage -> String
usageToString (Usage -> String) -> (Proxy a -> Usage) -> Proxy a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> Proxy a -> Usage
forall a. Coalpit a => Options -> Proxy a -> Usage
usage Options
opt

-- | Translate 'Usage' into a string, used by 'usageString'.
usageToString :: Usage -> String
usageToString :: Usage -> String
usageToString (UConstructor String
c) = String
c
usageToString (URecursive String
c) = String
c String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"..."
usageToString (USelector Bool
False String
s Usage
u) = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"] " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Usage -> String
usageToString Usage
u
usageToString (USelector Bool
True String
s Usage
u) = String
s String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Usage -> String
usageToString Usage
u
usageToString (UOptional Usage
u) = String
"[" String -> ShowS
forall a. [a] -> [a] -> [a]
++ Usage -> String
usageToString Usage
u String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"]"
usageToString (USum Usage
ul Usage
ur) = [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ String
"("
                                    , Usage -> String
usageToString Usage
ul
                                    , String
" | "
                                    , Usage -> String
usageToString Usage
ur
                                    , String
")"]
usageToString (UProduct Usage
u1 Usage
UUnit) = Usage -> String
usageToString Usage
u1
usageToString (UProduct Usage
u1 Usage
u2) = Usage -> String
usageToString Usage
u1 String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Usage -> String
usageToString Usage
u2
usageToString Usage
UUnit = String
""
usageToString (UType String
t) = String
t

-- | Parse a field separator.
pFieldSep :: Options -> Parsec String m ()
pFieldSep :: forall m. Options -> Parsec String m ()
pFieldSep Options
opt =
  String -> ParsecT String m Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Char -> String) -> NonEmpty Char -> String
forall a b. (a -> b) -> a -> b
$ Options -> NonEmpty Char
fieldSeparators Options
opt) ParsecT String m Identity Char
-> ParsecT String m Identity () -> ParsecT String m Identity ()
forall a b.
ParsecT String m Identity a
-> ParsecT String m Identity b -> ParsecT String m Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT String m Identity ()
forall a. a -> ParsecT String m Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Parse a record (line) separator.
pRecordSep :: Options -> Parsec String m ()
pRecordSep :: forall m. Options -> Parsec String m ()
pRecordSep Options
opt =
  [ParsecT String m Identity ()] -> ParsecT String m Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice (ParsecT String m Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof
          ParsecT String m Identity ()
-> [ParsecT String m Identity ()] -> [ParsecT String m Identity ()]
forall a. a -> [a] -> [a]
: (Char -> ParsecT String m Identity ())
-> String -> [ParsecT String m Identity ()]
forall a b. (a -> b) -> [a] -> [b]
map (\Char
c -> Char -> ParsecT String m Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
c ParsecT String m Identity Char
-> ParsecT String m Identity () -> ParsecT String m Identity ()
forall a b.
ParsecT String m Identity a
-> ParsecT String m Identity b -> ParsecT String m Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT String m Identity ()
forall a. a -> ParsecT String m Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
           (NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty Char -> String) -> NonEmpty Char -> String
forall a b. (a -> b) -> a -> b
$ Options -> NonEmpty Char
recordSeparators Options
opt))

-- | Parse a token: either a quoted string or a string without
-- unescaped separators. The opposite of 'escape'.
pString :: Options -> Parsec String m String
pString :: forall m. Options -> Parsec String m String
pString Options
opt =
  (ParsecT String m Identity String
-> ParsecT String m Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String m Identity String
forall {u}. ParsecT String u Identity String
quotedString ParsecT String m Identity String
-> String -> ParsecT String m Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"quoted string"))
  ParsecT String m Identity String
-> ParsecT String m Identity String
-> ParsecT String m Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (ParsecT String m Identity String
forall {u}. ParsecT String u Identity String
unquotedString ParsecT String m Identity String
-> String -> ParsecT String m Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"unquoted string")
  where
    endChars :: String
endChars = NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList (Options -> NonEmpty Char
fieldSeparators Options
opt)
               String -> ShowS
forall a. [a] -> [a] -> [a]
++ NonEmpty Char -> String
forall a. NonEmpty a -> [a]
NE.toList (Options -> NonEmpty Char
recordSeparators Options
opt)
    unquotedString :: ParsecT String u Identity String
unquotedString = do
      Char
c <- String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
escapedChar String
endChars
      String
s <- ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
escapedChar String
endChars)
        (ParsecT String u Identity () -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT String u Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof ParsecT String u Identity ()
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf String
endChars ParsecT String u Identity Char
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
      String -> ParsecT String u Identity String
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char
cChar -> ShowS
forall a. a -> [a] -> [a]
:String
s)
    escapedChar :: String -> ParsecT s u m Char
escapedChar String
ecs = (Char -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'\\' ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> String -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
oneOf (Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
: String
ecs)) ParsecT s u m Char -> ParsecT s u m Char -> ParsecT s u m Char
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT s u m Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar
    quotedString :: ParsecT String u Identity String
quotedString = Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
      ParsecT String u Identity Char
-> ParsecT String u Identity String
-> ParsecT String u Identity String
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT String u Identity Char
-> ParsecT String u Identity Char
-> ParsecT String u Identity String
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
manyTill (String -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m Char
escapedChar String
"\"") (Char -> ParsecT String u Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"')

-- | Parses a time argument.
pTime :: ParseTime a => Options -> String -> Parser a
pTime :: forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt String
tf = ParsecT String () Identity a -> ParsecT String () Identity a
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity a -> ParsecT String () Identity a)
-> ParsecT String () Identity a -> ParsecT String () Identity a
forall a b. (a -> b) -> a -> b
$ do
    String
x <- Options -> Parsec String () String
forall m. Options -> Parsec String m String
pString Options
opt
    case Bool -> TimeLocale -> String -> ReadS a
forall t. ParseTime t => Bool -> TimeLocale -> String -> ReadS t
readSTime Bool
False (Options -> TimeLocale
timeLocale Options
opt) String
tf String
x of
      [(a
t, String
"")] -> a -> ParsecT String () Identity a
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
t
      [(a, String)]
_ -> String -> ParsecT String () Identity a
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Failed to parse time"

-- | Read an argument using its 'Read' instance.
pRead :: Read a => Options -> Parser a
pRead :: forall a. Read a => Options -> Parser a
pRead Options
opt = do
  String
x <- Options -> Parsec String () String
forall m. Options -> Parsec String m String
pString Options
opt
  case ReadS a
forall a. Read a => ReadS a
reads String
x of
    [(a
n, String
"")] -> a -> Parser a
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
n
    [(a, String)]
_ -> String -> Parser a
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser a) -> String -> Parser a
forall a b. (a -> b) -> a -> b
$ String
"Failed to read: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x

-- | Coalpit class: parsing, printing, usage strings.
class Coalpit a where
  coalpitParser :: Options -> Parser a
  default coalpitParser :: (Generic a, GCoalpit (Rep a)) => Options -> Parser a
  coalpitParser Options
opt = Rep a Any -> a
forall a x. Generic a => Rep a x -> a
forall x. Rep a x -> a
to (Rep a Any -> a)
-> ParsecT String () Identity (Rep a Any) -> Parser a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> ParsecT String () Identity (Rep a Any)
forall p. Options -> Parser (Rep a p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt

  coalpitPrint :: Options -> a -> [String]
  default coalpitPrint :: (Generic a, GCoalpit (Rep a)) => Options -> a -> [String]
  coalpitPrint Options
opt a
a = Options -> Rep a Any -> [String]
forall p. Options -> Rep a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt (a -> Rep a Any
forall x. a -> Rep a x
forall a x. Generic a => a -> Rep a x
from a
a)

  coalpitDescription :: Options -> [String] -> Proxy a -> Usage
  default coalpitDescription :: (GCoalpit (Rep a))
                    => Options -> [String] -> Proxy a -> Usage
  coalpitDescription Options
opt [String]
path Proxy a
Proxy =
    Options -> [String] -> Proxy (Rep a Any) -> Usage
forall p. Options -> [String] -> Proxy (Rep a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (Rep a p)
forall {p}. Proxy (Rep a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (Rep a p))

class GCoalpit a where
  gCoalpitParser :: Options -> Parser (a p)
  gCoalpitPrint :: Options -> a p -> [String]
  gCoalpitDescription :: Options -> [String] -> Proxy (a p) -> Usage


-- Units
instance GCoalpit U1 where
  gCoalpitParser :: forall p. Options -> Parser (U1 p)
gCoalpitParser Options
_ = U1 p -> ParsecT String () Identity (U1 p)
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure U1 p
forall k (p :: k). U1 p
U1
  gCoalpitPrint :: forall p. Options -> U1 p -> [String]
gCoalpitPrint Options
_ U1 p
U1 = []
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy (U1 p) -> Usage
gCoalpitDescription Options
_ [String]
_ (Proxy (U1 p)
Proxy :: Proxy (U1 f)) = Usage
UUnit


-- Products
instance (GCoalpit a, GCoalpit b) => GCoalpit (a :*: b) where
  gCoalpitParser :: forall p. Options -> Parser ((:*:) a b p)
gCoalpitParser Options
opt =
    (a p -> b p -> (:*:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k).
f p -> g p -> (:*:) f g p
(:*:) (a p -> b p -> (:*:) a b p)
-> ParsecT String () Identity (a p)
-> ParsecT String () Identity (b p -> (:*:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
     (Options -> ParsecT String () Identity (a p)
forall p. Options -> Parser (a p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt ParsecT String () Identity (a p)
-> ParsecT String () Identity ()
-> ParsecT String () Identity (a p)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Options -> ParsecT String () Identity ()
forall m. Options -> Parsec String m ()
pFieldSep Options
opt) ParsecT String () Identity (b p -> (:*:) a b p)
-> ParsecT String () Identity (b p)
-> ParsecT String () Identity ((:*:) a b p)
forall a b.
ParsecT String () Identity (a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Options -> ParsecT String () Identity (b p)
forall p. Options -> Parser (b p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt)
    ParsecT String () Identity ((:*:) a b p)
-> String -> ParsecT String () Identity ((:*:) a b p)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"product"
  gCoalpitPrint :: forall p. Options -> (:*:) a b p -> [String]
gCoalpitPrint Options
opt (a p
x :*: b p
y) =
    Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ Options -> b p -> [String]
forall p. Options -> b p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt b p
y
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy ((:*:) a b p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy ((:*:) a b p)
Proxy :: Proxy ((a :*: b) p)) =
    Usage -> Usage -> Usage
UProduct (Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p)))
    (Options -> [String] -> Proxy (b p) -> Usage
forall p. Options -> [String] -> Proxy (b p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (b p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (b p)))


-- Sums
instance
  (GCoalpit a, GCoalpit b) => GCoalpit (a :+: b) where
  gCoalpitParser :: forall p. Options -> Parser ((:+:) a b p)
gCoalpitParser Options
opt =
    (ParsecT String () Identity ((:+:) a b p)
-> ParsecT String () Identity ((:+:) a b p)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (a p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). f p -> (:+:) f g p
L1 (a p -> (:+:) a b p)
-> ParsecT String () Identity (a p)
-> ParsecT String () Identity ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> ParsecT String () Identity (a p)
forall p. Options -> Parser (a p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt))
    ParsecT String () Identity ((:+:) a b p)
-> ParsecT String () Identity ((:+:) a b p)
-> ParsecT String () Identity ((:+:) a b p)
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
    (b p -> (:+:) a b p
forall k (f :: k -> *) (g :: k -> *) (p :: k). g p -> (:+:) f g p
R1 (b p -> (:+:) a b p)
-> ParsecT String () Identity (b p)
-> ParsecT String () Identity ((:+:) a b p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Options -> ParsecT String () Identity (b p)
forall p. Options -> Parser (b p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt)
  gCoalpitPrint :: forall p. Options -> (:+:) a b p -> [String]
gCoalpitPrint Options
opt (L1 a p
x) = Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x
  gCoalpitPrint Options
opt (R1 b p
x) = Options -> b p -> [String]
forall p. Options -> b p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt b p
x
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy ((:+:) a b p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy ((:+:) a b p)
Proxy :: Proxy ((a :+: b) p)) =
      Usage -> Usage -> Usage
USum (Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p)))
       (Options -> [String] -> Proxy (b p) -> Usage
forall p. Options -> [String] -> Proxy (b p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (b p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (b p)))

-- Record Selectors

parseS1 :: (GCoalpit a) => String -> Options -> Parser (S1 selA a p)
parseS1 :: forall (a :: * -> *) (selA :: Meta) p.
GCoalpit a =>
String -> Options -> Parser (S1 selA a p)
parseS1 String
nameA Options
opt =
  let sName :: ParsecT String u Identity ()
sName = case (String
nameA, Options -> SelNamePolicy
selNamePolicy Options
opt) of
        (String
"", SelNamePolicy
_) -> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (String
_, SelNamePolicy
SNDisable) -> () -> ParsecT String u Identity ()
forall a. a -> ParsecT String u Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        (String
_, SelNamePolicy
SNRequire) -> String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Options -> ShowS
selNameMod Options
opt String
nameA) ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Options -> ParsecT String u Identity ()
forall m. Options -> Parsec String m ()
pFieldSep Options
opt
        (String
_, SelNamePolicy
_) -> ParsecT String u Identity () -> ParsecT String u Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional
          (ParsecT String u Identity () -> ParsecT String u Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String u Identity () -> ParsecT String u Identity ())
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b. (a -> b) -> a -> b
$ (String -> ParsecT String u Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (Options -> ShowS
selNameMod Options
opt String
nameA)) ParsecT String u Identity String
-> ParsecT String u Identity () -> ParsecT String u Identity ()
forall a b.
ParsecT String u Identity a
-> ParsecT String u Identity b -> ParsecT String u Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Options -> ParsecT String u Identity ()
forall m. Options -> Parsec String m ()
pFieldSep Options
opt)
  in a p -> M1 S selA a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (a p -> M1 S selA a p)
-> ParsecT String () Identity (a p)
-> ParsecT String () Identity (M1 S selA a p)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ParsecT String () Identity ()
forall {u}. ParsecT String u Identity ()
sName ParsecT String () Identity ()
-> ParsecT String () Identity (a p)
-> ParsecT String () Identity (a p)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Options -> ParsecT String () Identity (a p)
forall p. Options -> Parser (a p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt)

printS1 :: (GCoalpit a, Selector selA) => Options -> S1 selA a p -> [String]
printS1 :: forall (a :: * -> *) (selA :: Meta) p.
(GCoalpit a, Selector selA) =>
Options -> S1 selA a p -> [String]
printS1 Options
opt sel :: S1 selA a p
sel@(M1 a p
x) = case (S1 selA a p -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t selA f a -> String
selName S1 selA a p
sel, Options -> SelNamePolicy
selNamePolicy Options
opt) of
                           (String
"", SelNamePolicy
_) -> Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x
                           (String
_, SelNamePolicy
SNDisable) -> Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x
                           (String
_, SelNamePolicy
SNAvoid) -> Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x
                           (String
name, SelNamePolicy
_) -> Options -> ShowS
selNameMod Options
opt String
name String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x

helpS1 :: (GCoalpit a)
       => String -> Options -> [String] -> Proxy (S1 selA a p) -> Usage
helpS1 :: forall (a :: * -> *) (selA :: Meta) p.
GCoalpit a =>
String -> Options -> [String] -> Proxy (S1 selA a p) -> Usage
helpS1 String
nameA Options
opt [String]
path (Proxy (S1 selA a p)
Proxy :: Proxy (S1 selA a p)) =
  case (String
nameA, Options -> SelNamePolicy
selNamePolicy Options
opt) of
    (String
"", SelNamePolicy
_) -> Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p))
    (String
_, SelNamePolicy
SNDisable) -> Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p))
    (String
_, SelNamePolicy
snpol) -> Bool -> String -> Usage -> Usage
USelector (SelNamePolicy
snpol SelNamePolicy -> SelNamePolicy -> Bool
forall a. Eq a => a -> a -> Bool
== SelNamePolicy
SNRequire) (Options -> ShowS
selNameMod Options
opt String
nameA)
      (Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p)))

instance (GCoalpit a, Selector selA) => GCoalpit (S1 selA a) where
  gCoalpitParser :: forall p. Options -> Parser (S1 selA a p)
gCoalpitParser = String -> Options -> Parser (S1 selA a p)
forall (a :: * -> *) (selA :: Meta) p.
GCoalpit a =>
String -> Options -> Parser (S1 selA a p)
parseS1 (M1 S selA a Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t selA f a -> String
selName (S1 selA a p
forall {p}. S1 selA a p
forall a. HasCallStack => a
undefined :: S1 selA a p))
  gCoalpitPrint :: forall p. Options -> S1 selA a p -> [String]
gCoalpitPrint = Options -> S1 selA a p -> [String]
forall (a :: * -> *) (selA :: Meta) p.
(GCoalpit a, Selector selA) =>
Options -> S1 selA a p -> [String]
printS1
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy (S1 selA a p) -> Usage
gCoalpitDescription = String -> Options -> [String] -> Proxy (S1 selA a p) -> Usage
forall (a :: * -> *) (selA :: Meta) p.
GCoalpit a =>
String -> Options -> [String] -> Proxy (S1 selA a p) -> Usage
helpS1 (M1 S selA a Any -> String
forall {k} (s :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Selector s =>
t s f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t selA f a -> String
selName (S1 selA a p
forall {p}. S1 selA a p
forall a. HasCallStack => a
undefined :: S1 selA a p))

-- Constructors

-- | Handles recursive constructors.
handleRecCon :: GCoalpit a
             => String
             -- ^ Constructor name
             -> Options
             -> [String]
             -> Proxy (a p)
             -> Usage
handleRecCon :: forall (a :: * -> *) p.
GCoalpit a =>
String -> Options -> [String] -> Proxy (a p) -> Usage
handleRecCon String
nameA Options
opt [String]
path (Proxy (a p)
Proxy :: Proxy (a p)) =
  let n :: String
n = Options -> ShowS
conNameMod Options
opt String
nameA
  in if String
nameA String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
path
     then String -> Usage
URecursive String
n
     else Usage -> Usage -> Usage
UProduct (String -> Usage
UConstructor String
n)
          (Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt (String
nameA String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String]
path) (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p)))

-- A constructor wrapping just a unit: no field separator is required
-- after such a constructor.
instance {-#OVERLAPPING#-} (Constructor conA) => GCoalpit (C1 conA U1) where
  gCoalpitParser :: forall p. Options -> Parser (C1 conA U1 p)
gCoalpitParser Options
opt =
    ((String -> Parsec String () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string
       (Options -> ShowS
conNameMod Options
opt ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ M1 C conA U1 Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t conA f a -> String
conName (C1 conA U1 w
forall {w}. C1 conA U1 w
forall a. HasCallStack => a
undefined :: C1 conA U1 w))
       Parsec String () String -> String -> Parsec String () String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"constructor name"))
    Parsec String () String
-> ParsecT String () Identity (C1 conA U1 p)
-> ParsecT String () Identity (C1 conA U1 p)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((U1 p -> C1 conA U1 p)
-> ParsecT String () Identity (U1 p)
-> ParsecT String () Identity (C1 conA U1 p)
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap U1 p -> C1 conA U1 p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Options -> ParsecT String () Identity (U1 p)
forall p. Options -> Parser (U1 p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt))
  gCoalpitPrint :: forall p. Options -> C1 conA U1 p -> [String]
gCoalpitPrint Options
opt (M1 U1 p
x) = Options -> ShowS
conNameMod Options
opt (M1 C conA U1 Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t conA f a -> String
conName (C1 conA U1 w
forall {w}. C1 conA U1 w
forall a. HasCallStack => a
undefined :: C1 conA U1 w))
                       String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> U1 p -> [String]
forall p. Options -> U1 p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt U1 p
x
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy (C1 conA U1 p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (C1 conA U1 p)
Proxy :: Proxy (C1 conA U1 p)) =
    (String -> Options -> [String] -> Proxy (U1 p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
String -> Options -> [String] -> Proxy (a p) -> Usage
handleRecCon (M1 C conA U1 Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t conA f a -> String
conName (C1 conA U1 w
forall {w}. C1 conA U1 w
forall a. HasCallStack => a
undefined :: C1 conA U1 w)) Options
opt [String]
path
     (Proxy (U1 p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (U1 p)))

-- A constructor with non-unit children, with a field separator
-- between constructor name and its children.
instance (GCoalpit a, Constructor conA) => GCoalpit (C1 conA a) where
  gCoalpitParser :: forall p. Options -> Parser (C1 conA a p)
gCoalpitParser Options
opt =
    ((String -> Parsec String () String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string
       (Options -> ShowS
conNameMod Options
opt ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$ M1 C conA a Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t conA f a -> String
conName (C1 conA a w
forall {w}. C1 conA a w
forall a. HasCallStack => a
undefined :: C1 conA a w))
       Parsec String () String -> String -> Parsec String () String
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"constructor name"))
    Parsec String () String
-> ParsecT String () Identity () -> ParsecT String () Identity ()
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Options -> ParsecT String () Identity ()
forall m. Options -> Parsec String m ()
pFieldSep Options
opt)
    ParsecT String () Identity ()
-> ParsecT String () Identity (C1 conA a p)
-> ParsecT String () Identity (C1 conA a p)
forall a b.
ParsecT String () Identity a
-> ParsecT String () Identity b -> ParsecT String () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((a p -> C1 conA a p)
-> ParsecT String () Identity (a p)
-> ParsecT String () Identity (C1 conA a p)
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a p -> C1 conA a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (Options -> ParsecT String () Identity (a p)
forall p. Options -> Parser (a p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser Options
opt))
  gCoalpitPrint :: forall p. Options -> C1 conA a p -> [String]
gCoalpitPrint Options
opt (M1 a p
x) = Options -> ShowS
conNameMod Options
opt (M1 C conA a Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t conA f a -> String
conName (C1 conA a w
forall {w}. C1 conA a w
forall a. HasCallStack => a
undefined :: C1 conA a w))
                       String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy (C1 conA a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (C1 conA a p)
Proxy :: Proxy (C1 conA a p)) =
    (String -> Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
String -> Options -> [String] -> Proxy (a p) -> Usage
handleRecCon (M1 C conA a Any -> String
forall {k} (c :: k) k1 (t :: k -> (k1 -> *) -> k1 -> *)
       (f :: k1 -> *) (a :: k1).
Constructor c =>
t c f a -> String
forall k1 (t :: Meta -> (k1 -> *) -> k1 -> *) (f :: k1 -> *)
       (a :: k1).
t conA f a -> String
conName (C1 conA a w
forall {w}. C1 conA a w
forall a. HasCallStack => a
undefined :: C1 conA a w)) Options
opt [String]
path
     (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p)))

-- Data types
instance (GCoalpit a) => GCoalpit (D1 conA a) where
  gCoalpitParser :: forall p. Options -> Parser (D1 conA a p)
gCoalpitParser = (a p -> D1 conA a p)
-> ParsecT String () Identity (a p)
-> ParsecT String () Identity (D1 conA a p)
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a p -> D1 conA a p
forall k i (c :: Meta) (f :: k -> *) (p :: k). f p -> M1 i c f p
M1 (ParsecT String () Identity (a p)
 -> ParsecT String () Identity (D1 conA a p))
-> (Options -> ParsecT String () Identity (a p))
-> Options
-> ParsecT String () Identity (D1 conA a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ParsecT String () Identity (a p)
forall p. Options -> Parser (a p)
forall (a :: * -> *) p. GCoalpit a => Options -> Parser (a p)
gCoalpitParser
  gCoalpitPrint :: forall p. Options -> D1 conA a p -> [String]
gCoalpitPrint Options
opt (M1 a p
x) = Options -> a p -> [String]
forall p. Options -> a p -> [String]
forall (a :: * -> *) p. GCoalpit a => Options -> a p -> [String]
gCoalpitPrint Options
opt a p
x
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy (D1 conA a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (D1 conA a p)
Proxy :: Proxy (D1 conA a p)) =
    Options -> [String] -> Proxy (a p) -> Usage
forall p. Options -> [String] -> Proxy (a p) -> Usage
forall (a :: * -> *) p.
GCoalpit a =>
Options -> [String] -> Proxy (a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (a p)
forall {k} (t :: k). Proxy t
Proxy :: Proxy (a p))

-- Constraints and such
instance (Coalpit a) => GCoalpit (K1 i a) where
  gCoalpitParser :: forall p. Options -> Parser (K1 i a p)
gCoalpitParser = (a -> K1 i a p)
-> ParsecT String () Identity a
-> ParsecT String () Identity (K1 i a p)
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> K1 i a p
forall k i c (p :: k). c -> K1 i c p
K1 (ParsecT String () Identity a
 -> ParsecT String () Identity (K1 i a p))
-> (Options -> ParsecT String () Identity a)
-> Options
-> ParsecT String () Identity (K1 i a p)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Options -> ParsecT String () Identity a
forall a. Coalpit a => Options -> Parser a
coalpitParser
  gCoalpitPrint :: forall p. Options -> K1 i a p -> [String]
gCoalpitPrint Options
opt (K1 a
x) = Options -> a -> [String]
forall a. Coalpit a => Options -> a -> [String]
coalpitPrint Options
opt a
x
  gCoalpitDescription :: forall p. Options -> [String] -> Proxy (K1 i a p) -> Usage
gCoalpitDescription Options
opt [String]
path (Proxy (K1 i a p)
Proxy :: Proxy (K1 x a p)) =
    Options -> [String] -> Proxy a -> Usage
forall a. Coalpit a => Options -> [String] -> Proxy a -> Usage
coalpitDescription Options
opt [String]
path (Proxy a
forall {k} (t :: k). Proxy t
Proxy :: Proxy a)


-- Common types

instance Coalpit Int where
  coalpitParser :: Options -> Parser Int
coalpitParser Options
opt = Options -> Parser Int
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Int -> [String]
coalpitPrint Options
_ Int
i = [Int -> String
forall a. Show a => a -> String
show Int
i]
  coalpitDescription :: Options -> [String] -> Proxy Int -> Usage
coalpitDescription Options
_ [String]
_ Proxy Int
_ = String -> Usage
UType String
"INT"

instance Coalpit Integer where
  coalpitParser :: Options -> Parser Integer
coalpitParser Options
opt = Options -> Parser Integer
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Integer -> [String]
coalpitPrint Options
_ Integer
i = [Integer -> String
forall a. Show a => a -> String
show Integer
i]
  coalpitDescription :: Options -> [String] -> Proxy Integer -> Usage
coalpitDescription Options
_ [String]
_ Proxy Integer
_ = String -> Usage
UType String
"INTEGER"

instance Coalpit Word8 where
  coalpitParser :: Options -> Parser Word8
coalpitParser Options
opt = Options -> Parser Word8
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Word8 -> [String]
coalpitPrint Options
_ Word8
i = [Word8 -> String
forall a. Show a => a -> String
show Word8
i]
  coalpitDescription :: Options -> [String] -> Proxy Word8 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Word8
_ = String -> Usage
UType String
"WORD8"

instance Coalpit Word16 where
  coalpitParser :: Options -> Parser Word16
coalpitParser Options
opt = Options -> Parser Word16
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Word16 -> [String]
coalpitPrint Options
_ Word16
i = [Word16 -> String
forall a. Show a => a -> String
show Word16
i]
  coalpitDescription :: Options -> [String] -> Proxy Word16 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Word16
_ = String -> Usage
UType String
"WORD16"

instance Coalpit Word32 where
  coalpitParser :: Options -> Parser Word32
coalpitParser Options
opt = Options -> Parser Word32
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Word32 -> [String]
coalpitPrint Options
_ Word32
i = [Word32 -> String
forall a. Show a => a -> String
show Word32
i]
  coalpitDescription :: Options -> [String] -> Proxy Word32 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Word32
_ = String -> Usage
UType String
"WORD32"

instance Coalpit Word64 where
  coalpitParser :: Options -> Parser Word64
coalpitParser Options
opt = Options -> Parser Word64
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Word64 -> [String]
coalpitPrint Options
_ Word64
i = [Word64 -> String
forall a. Show a => a -> String
show Word64
i]
  coalpitDescription :: Options -> [String] -> Proxy Word64 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Word64
_ = String -> Usage
UType String
"WORD64"

instance Coalpit Int8 where
  coalpitParser :: Options -> Parser Int8
coalpitParser Options
opt = Options -> Parser Int8
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Int8 -> [String]
coalpitPrint Options
_ Int8
i = [Int8 -> String
forall a. Show a => a -> String
show Int8
i]
  coalpitDescription :: Options -> [String] -> Proxy Int8 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Int8
_ = String -> Usage
UType String
"INT8"

instance Coalpit Int16 where
  coalpitParser :: Options -> Parser Int16
coalpitParser Options
opt = Options -> Parser Int16
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Int16 -> [String]
coalpitPrint Options
_ Int16
i = [Int16 -> String
forall a. Show a => a -> String
show Int16
i]
  coalpitDescription :: Options -> [String] -> Proxy Int16 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Int16
_ = String -> Usage
UType String
"INT16"

instance Coalpit Int32 where
  coalpitParser :: Options -> Parser Int32
coalpitParser Options
opt = Options -> Parser Int32
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Int32 -> [String]
coalpitPrint Options
_ Int32
i = [Int32 -> String
forall a. Show a => a -> String
show Int32
i]
  coalpitDescription :: Options -> [String] -> Proxy Int32 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Int32
_ = String -> Usage
UType String
"INT32"

instance Coalpit Int64 where
  coalpitParser :: Options -> Parser Int64
coalpitParser Options
opt = Options -> Parser Int64
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Int64 -> [String]
coalpitPrint Options
_ Int64
i = [Int64 -> String
forall a. Show a => a -> String
show Int64
i]
  coalpitDescription :: Options -> [String] -> Proxy Int64 -> Usage
coalpitDescription Options
_ [String]
_ Proxy Int64
_ = String -> Usage
UType String
"INT64"

instance Coalpit Natural where
  coalpitParser :: Options -> Parser Natural
coalpitParser Options
opt = Options -> Parser Natural
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Natural -> [String]
coalpitPrint Options
_ Natural
i = [Natural -> String
forall a. Show a => a -> String
show Natural
i]
  coalpitDescription :: Options -> [String] -> Proxy Natural -> Usage
coalpitDescription Options
_ [String]
_ Proxy Natural
_ = String -> Usage
UType String
"NATURAL"

instance Coalpit Rational where
  coalpitParser :: Options -> Parser Rational
coalpitParser Options
opt = Options -> Parser Rational
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Rational -> [String]
coalpitPrint Options
_ Rational
i = [Rational -> String
forall a. Show a => a -> String
show Rational
i]
  coalpitDescription :: Options -> [String] -> Proxy Rational -> Usage
coalpitDescription Options
_ [String]
_ Proxy Rational
_ = String -> Usage
UType String
"RATIONAL"

instance Coalpit Double where
  coalpitParser :: Options -> Parser Double
coalpitParser Options
opt = Options -> Parser Double
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Double -> [String]
coalpitPrint Options
_ Double
i = [Double -> String
forall a. Show a => a -> String
show Double
i]
  coalpitDescription :: Options -> [String] -> Proxy Double -> Usage
coalpitDescription Options
_ [String]
_ Proxy Double
_ = String -> Usage
UType String
"DOUBLE"

instance Coalpit Float where
  coalpitParser :: Options -> Parser Float
coalpitParser Options
opt = Options -> Parser Float
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Float -> [String]
coalpitPrint Options
_ Float
i = [Float -> String
forall a. Show a => a -> String
show Float
i]
  coalpitDescription :: Options -> [String] -> Proxy Float -> Usage
coalpitDescription Options
_ [String]
_ Proxy Float
_ = String -> Usage
UType String
"FLOAT"

instance Coalpit Char where
  coalpitParser :: Options -> Parser Char
coalpitParser Options
opt = Options -> Parser Char
forall a. Read a => Options -> Parser a
pRead Options
opt
  coalpitPrint :: Options -> Char -> [String]
coalpitPrint Options
_ Char
c = [Char -> String
forall a. Show a => a -> String
show Char
c]
  coalpitDescription :: Options -> [String] -> Proxy Char -> Usage
coalpitDescription Options
_ [String]
_ Proxy Char
_ = String -> Usage
UType String
"CHAR"


instance {-#OVERLAPPING#-} Coalpit String where
  coalpitParser :: Options -> Parsec String () String
coalpitParser Options
opt = Options -> Parsec String () String
forall m. Options -> Parsec String m String
pString Options
opt
  coalpitPrint :: Options -> String -> [String]
coalpitPrint Options
_ String
i = [String
i]
  coalpitDescription :: Options -> [String] -> Proxy String -> Usage
coalpitDescription Options
_ [String]
_ Proxy String
_ = String -> Usage
UType String
"STRING"

instance Coalpit Scientific where
  coalpitParser :: Options -> Parser Scientific
coalpitParser Options
opt = Parser Scientific -> Parser Scientific
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Scientific -> Parser Scientific)
-> Parser Scientific -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ do
    String
x <- Options -> Parsec String () String
forall m. Options -> Parsec String m String
pString Options
opt
    case [(Scientific, String)] -> [(Scientific, String)]
forall a. [a] -> [a]
reverse ([(Scientific, String)] -> [(Scientific, String)])
-> [(Scientific, String)] -> [(Scientific, String)]
forall a b. (a -> b) -> a -> b
$ ReadP Scientific -> ReadS Scientific
forall a. ReadP a -> ReadS a
readP_to_S ReadP Scientific
scientificP String
x of
      (Scientific
n, String
""):[(Scientific, String)]
_ -> Scientific -> Parser Scientific
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Scientific
n
      [(Scientific, String)]
_ -> String -> Parser Scientific
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Scientific) -> String -> Parser Scientific
forall a b. (a -> b) -> a -> b
$ String
"Failed to read a scientific number: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
  coalpitPrint :: Options -> Scientific -> [String]
coalpitPrint Options
opt Scientific
n = [FPFormat -> Maybe Int -> Scientific -> String
formatScientific
                  (Options -> FPFormat
scientificFormat Options
opt) (Options -> Maybe Int
scientificDecimals Options
opt) Scientific
n]
  coalpitDescription :: Options -> [String] -> Proxy Scientific -> Usage
coalpitDescription Options
_ [String]
_ Proxy Scientific
_ = String -> Usage
UType String
"SCIENTIFIC"

instance Coalpit Version where
  coalpitParser :: Options -> Parser Version
coalpitParser Options
opt = Parser Version -> Parser Version
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser Version -> Parser Version)
-> Parser Version -> Parser Version
forall a b. (a -> b) -> a -> b
$ do
    String
x <- Options -> Parsec String () String
forall m. Options -> Parsec String m String
pString Options
opt
    case [(Version, String)] -> [(Version, String)]
forall a. [a] -> [a]
reverse ([(Version, String)] -> [(Version, String)])
-> [(Version, String)] -> [(Version, String)]
forall a b. (a -> b) -> a -> b
$ ReadP Version -> ReadS Version
forall a. ReadP a -> ReadS a
readP_to_S ReadP Version
parseVersion String
x of
      (Version
v, String
""):[(Version, String)]
_ -> Version -> Parser Version
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v
      [(Version, String)]
_ -> String -> Parser Version
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Version) -> String -> Parser Version
forall a b. (a -> b) -> a -> b
$ String
"Failed to read a version: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x
  coalpitPrint :: Options -> Version -> [String]
coalpitPrint Options
_ Version
v = [Version -> String
showVersion Version
v]
  coalpitDescription :: Options -> [String] -> Proxy Version -> Usage
coalpitDescription Options
_ [String]
_ Proxy Version
_ = String -> Usage
UType String
"VERSION"


-- | An URI reference (absolute or relative).
instance Coalpit URI where
  coalpitParser :: Options -> Parser URI
coalpitParser Options
opt = Parser URI -> Parser URI
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parser URI -> Parser URI) -> Parser URI -> Parser URI
forall a b. (a -> b) -> a -> b
$ do
    String
x <- Options -> Parsec String () String
forall m. Options -> Parsec String m String
pString Options
opt
    Parser URI -> (URI -> Parser URI) -> Maybe URI -> Parser URI
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser URI
forall a. String -> ParsecT String () Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser URI) -> String -> Parser URI
forall a b. (a -> b) -> a -> b
$ String
"Failed to parse URI: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
x) URI -> Parser URI
forall a. a -> ParsecT String () Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (String -> Maybe URI
parseURIReference String
x)
  coalpitPrint :: Options -> URI -> [String]
coalpitPrint Options
opt URI
u = [ShowS -> URI -> ShowS
uriToString (Options -> ShowS
uriUserInfo Options
opt) URI
u String
""]
  coalpitDescription :: Options -> [String] -> Proxy URI -> Usage
coalpitDescription Options
_ [String]
_ Proxy URI
_ = String -> Usage
UType String
"URI"


-- | Uses 'dateTimeFormat'.
instance Coalpit UTCTime where
  coalpitParser :: Options -> Parser UTCTime
coalpitParser Options
opt = Options -> String -> Parser UTCTime
forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt (Options -> String
dateTimeFormat Options
opt)
  coalpitPrint :: Options -> UTCTime -> [String]
coalpitPrint Options
opt UTCTime
t = [TimeLocale -> String -> UTCTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime (Options -> TimeLocale
timeLocale Options
opt) (Options -> String
dateTimeFormat Options
opt) UTCTime
t]
  coalpitDescription :: Options -> [String] -> Proxy UTCTime -> Usage
coalpitDescription Options
_ [String]
_ Proxy UTCTime
_ = String -> Usage
UType String
"UTC_TIME"

-- | Uses 'dateTimeFormat'.
instance Coalpit ZonedTime where
  coalpitParser :: Options -> Parser ZonedTime
coalpitParser Options
opt = Options -> String -> Parser ZonedTime
forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt (Options -> String
dateTimeFormat Options
opt)
  coalpitPrint :: Options -> ZonedTime -> [String]
coalpitPrint Options
opt ZonedTime
t = [TimeLocale -> String -> ZonedTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime (Options -> TimeLocale
timeLocale Options
opt) (Options -> String
dateTimeFormat Options
opt) ZonedTime
t]
  coalpitDescription :: Options -> [String] -> Proxy ZonedTime -> Usage
coalpitDescription Options
_ [String]
_ Proxy ZonedTime
_ = String -> Usage
UType String
"ZONED_TIME"

-- | Uses 'dateTimeFormat'.
instance Coalpit LocalTime where
  coalpitParser :: Options -> Parser LocalTime
coalpitParser Options
opt = Options -> String -> Parser LocalTime
forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt (Options -> String
dateTimeFormat Options
opt)
  coalpitPrint :: Options -> LocalTime -> [String]
coalpitPrint Options
opt LocalTime
t = [TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime (Options -> TimeLocale
timeLocale Options
opt) (Options -> String
dateTimeFormat Options
opt) LocalTime
t]
  coalpitDescription :: Options -> [String] -> Proxy LocalTime -> Usage
coalpitDescription Options
_ [String]
_ Proxy LocalTime
_ = String -> Usage
UType String
"LOCAL_TIME"

-- | Uses 'dateTimeFormat'.
instance Coalpit UniversalTime where
  coalpitParser :: Options -> Parser UniversalTime
coalpitParser Options
opt = Options -> String -> Parser UniversalTime
forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt (Options -> String
dateTimeFormat Options
opt)
  coalpitPrint :: Options -> UniversalTime -> [String]
coalpitPrint Options
opt UniversalTime
t = [TimeLocale -> String -> UniversalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime (Options -> TimeLocale
timeLocale Options
opt) (Options -> String
dateTimeFormat Options
opt) UniversalTime
t]
  coalpitDescription :: Options -> [String] -> Proxy UniversalTime -> Usage
coalpitDescription Options
_ [String]
_ Proxy UniversalTime
_ = String -> Usage
UType String
"UNIVERSAL_TIME"

-- | Uses 'timeFormat'.
instance Coalpit TimeOfDay where
  coalpitParser :: Options -> Parser TimeOfDay
coalpitParser Options
opt = Options -> String -> Parser TimeOfDay
forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt (Options -> String
timeFormat Options
opt)
  coalpitPrint :: Options -> TimeOfDay -> [String]
coalpitPrint Options
opt TimeOfDay
t = [TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime (Options -> TimeLocale
timeLocale Options
opt) (Options -> String
timeFormat Options
opt) TimeOfDay
t]
  coalpitDescription :: Options -> [String] -> Proxy TimeOfDay -> Usage
coalpitDescription Options
_ [String]
_ Proxy TimeOfDay
_ = String -> Usage
UType String
"TIME_OF_DAY"

-- | Uses 'dateFormat'.
instance Coalpit Day where
  coalpitParser :: Options -> Parser Day
coalpitParser Options
opt = Options -> String -> Parser Day
forall a. ParseTime a => Options -> String -> Parser a
pTime Options
opt (Options -> String
dateFormat Options
opt)
  coalpitPrint :: Options -> Day -> [String]
coalpitPrint Options
opt Day
t = [TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime (Options -> TimeLocale
timeLocale Options
opt) (Options -> String
dateFormat Options
opt) Day
t]
  coalpitDescription :: Options -> [String] -> Proxy Day -> Usage
coalpitDescription Options
_ [String]
_ Proxy Day
_ = String -> Usage
UType String
"DAY"

-- | Converts to/from 'Scientific'.
instance Coalpit NominalDiffTime where
  coalpitParser :: Options -> Parser NominalDiffTime
coalpitParser Options
opt = Rational -> NominalDiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> NominalDiffTime)
-> (Scientific -> Rational) -> Scientific -> NominalDiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Rational
forall a. Real a => a -> Rational
toRational
                  (Scientific -> NominalDiffTime)
-> Parser Scientific -> Parser NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options -> Parser Scientific
forall a. Coalpit a => Options -> Parser a
coalpitParser Options
opt :: Parser Scientific)
  coalpitPrint :: Options -> NominalDiffTime -> [String]
coalpitPrint Options
opt = Options -> Scientific -> [String]
forall a. Coalpit a => Options -> a -> [String]
coalpitPrint Options
opt (Scientific -> [String])
-> (NominalDiffTime -> Scientific) -> NominalDiffTime -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Rational -> Scientific)
-> (NominalDiffTime -> Rational) -> NominalDiffTime -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Rational
forall a. Real a => a -> Rational
toRational :: NominalDiffTime -> Scientific)
  coalpitDescription :: Options -> [String] -> Proxy NominalDiffTime -> Usage
coalpitDescription Options
_ [String]
_ Proxy NominalDiffTime
_ = String -> Usage
UType String
"NOMINAL_DIFF_TIME"

-- | Converts to/from 'Scientific'.
instance Coalpit DiffTime where
  coalpitParser :: Options -> Parser DiffTime
coalpitParser Options
opt = Rational -> DiffTime
forall a. Fractional a => Rational -> a
fromRational (Rational -> DiffTime)
-> (Scientific -> Rational) -> Scientific -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> Rational
forall a. Real a => a -> Rational
toRational
                  (Scientific -> DiffTime) -> Parser Scientific -> Parser DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Options -> Parser Scientific
forall a. Coalpit a => Options -> Parser a
coalpitParser Options
opt :: Parser Scientific)
  coalpitPrint :: Options -> DiffTime -> [String]
coalpitPrint Options
opt = Options -> Scientific -> [String]
forall a. Coalpit a => Options -> a -> [String]
coalpitPrint Options
opt (Scientific -> [String])
-> (DiffTime -> Scientific) -> DiffTime -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
    (Rational -> Scientific
forall a. Fractional a => Rational -> a
fromRational (Rational -> Scientific)
-> (DiffTime -> Rational) -> DiffTime -> Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DiffTime -> Rational
forall a. Real a => a -> Rational
toRational :: DiffTime -> Scientific)
  coalpitDescription :: Options -> [String] -> Proxy DiffTime -> Usage
coalpitDescription Options
_ [String]
_ Proxy DiffTime
_ = String -> Usage
UType String
"DIFF_TIME"

instance Coalpit ()
instance Coalpit Bool
instance Coalpit Ordering
instance Coalpit ExitCode
instance Coalpit a => Coalpit (Complex a)
instance Coalpit a => Coalpit (Maybe a)
instance Coalpit a => Coalpit [a]
instance Coalpit a => Coalpit (NonEmpty a)
instance (Coalpit a, Coalpit b) => Coalpit (Either a b)
instance (Coalpit a, Coalpit b) => Coalpit (a, b)
instance (Coalpit a, Coalpit b, Coalpit c) => Coalpit (a, b, c)
instance (Coalpit a, Coalpit b, Coalpit c, Coalpit d) => Coalpit (a, b, c, d)