------------------------------------------------------------------------------
-- |
-- Module      : Data.TTC
-- Description : Textual Type Classes
-- Copyright   : Copyright (c) 2019-2025 Travis Cardwell
-- License     : MIT
--
-- TTC, an initialism of /Textual Type Classes/, is a library that provides
-- type classes for conversion between data types and textual data types
-- (strings).
--
-- The 'Render' type class renders a data type as a textual data type, similar
-- to 'Show'.  Use 'Render' in your business logic, and only use 'Show' for
-- debugging, as use of 'Show' instances in business logic is a common source
-- of bugs.
--
-- The 'Parse' type class parses a data type from a textual data type, similar
-- to 'Read'.  Unlike 'Read', 'Parse' allows you to specify meaningful error
-- messages.
--
-- 'Render' and 'Parse' work with multiple textual data types.  They are not
-- limited to 'String' (like 'Show' and 'Read'), and implementations can use
-- the textual data type that is most appropriate for each data type.
--
-- Conversion between textual data types is managed by the 'Textual' type
-- class.  This library provides instances to support the following textual
-- data types:
--
-- * 'String' (@S@)
-- * Strict 'T.Text' (@T@)
-- * Lazy 'TL.Text' (@TL@)
-- * @Text@ 'TLB.Builder' (@TLB@)
-- * 'ST.ShortText' (@ST@)
-- * Strict 'BS.ByteString' (@BS@)
-- * Lazy 'BSL.ByteString' (@BSL@)
-- * @ByteString@ 'BSB.Builder' (@BSB@)
-- * 'SBS.ShortByteString' (@SBS@)
--
-- This library is meant to be imported qualified, as follows:
--
-- @
-- import qualified Data.TTC as TTC
-- @
--
-- Note that this library has a similar API to the
-- [ETTC](https://github.com/ExtremaIS/ttc-haskell/tree/main/ettc) library,
-- which uses a @Utf8Convertible@ type class instead of 'Textual'.  The TTC
-- API types are simpler, but it is not possible to add support for additional
-- textual data types without changing the library itself.  The ETTC API types
-- are more complex, leading to longer compilation times, but one can add
-- support for additional textual data types by defining new @Utf8Convertible@
-- instances.  Both libraries are maintained, allowing you to use the one that
-- best matches the needs of your project.
------------------------------------------------------------------------------

{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

module Data.TTC
  ( -- * Textual
    Textual
  , convert
    -- ** \"To\" Conversions
    -- $TextualTo
  , toS
  , toT
  , toTL
  , toTLB
  , toST
  , toBS
  , toBSL
  , toBSB
  , toSBS
    -- ** \"From\" Conversions
    -- $TextualFrom
  , fromS
  , fromT
  , fromTL
  , fromTLB
  , fromST
  , fromBS
  , fromBSL
  , fromBSB
  , fromSBS
    -- ** \"As\" Conversions
    -- $TextualAs
  , asS
  , asT
  , asTL
  , asTLB
  , asST
  , asBS
  , asBSL
  , asBSB
  , asSBS
    -- * Render
  , Render(..)
  , RenderDefault(..)
    -- ** Render Utility Functions
    -- $RenderUtilityFunctions
  , renderWithShow
    -- ** Rendering Specific Types
    -- $RenderSpecific
  , renderS
  , renderT
  , renderTL
  , renderTLB
  , renderST
  , renderBS
  , renderBSL
  , renderBSB
  , renderSBS
    -- * Parse
  , Parse(..)
  , ParseDefault(..)
    -- ** Parse Utility Functions
    -- $ParseUtilityFunctions
    -- *** Parse With A Single Error Message
    -- $ParseWithASingleErrorMessage
  , withError
  , withErrorS
  , withErrorT
  , withErrorTL
  , withErrorTLB
  , withErrorST
  , withErrorBS
  , withErrorBSL
  , withErrorBSB
  , withErrorSBS
    -- *** Parse With An Error Prefix
    -- $ParseWithAnErrorPrefix
  , prefixError
  , prefixErrorS
  , prefixErrorT
  , prefixErrorTL
  , prefixErrorTLB
  , prefixErrorST
  , prefixErrorBS
  , prefixErrorBSL
  , prefixErrorBSB
  , prefixErrorSBS
    -- *** 'Read' Parsing
  , parseWithRead
  , parseWithRead'
  , maybeParseWithRead
    -- *** 'Enum' Parsing
  , parseEnum
  , parseEnum'
    -- ** Parsing From Specific Types
    -- $ParseSpecific
  , parseS
  , parseT
  , parseTL
  , parseTLB
  , parseST
  , parseBS
  , parseBSL
  , parseBSB
  , parseSBS
    -- ** 'Maybe' Parsing
    -- $ParseMaybe
  , parseMaybe
  , parseMaybeS
  , parseMaybeT
  , parseMaybeTL
  , parseMaybeTLB
  , parseMaybeST
  , parseMaybeBS
  , parseMaybeBSL
  , parseMaybeBSB
  , parseMaybeSBS
    -- ** 'MonadFail' Parsing
    -- $ParseOrFail
  , parseOrFail
  , parseOrFailS
  , parseOrFailT
  , parseOrFailTL
  , parseOrFailTLB
  , parseOrFailST
  , parseOrFailBS
  , parseOrFailBSL
  , parseOrFailBSB
  , parseOrFailSBS
    -- ** Unsafe Parsing
    -- $ParseUnsafe
  , parseUnsafe
  , parseUnsafeS
  , parseUnsafeT
  , parseUnsafeTL
  , parseUnsafeTLB
  , parseUnsafeST
  , parseUnsafeBS
  , parseUnsafeBSL
  , parseUnsafeBSB
  , parseUnsafeSBS
    -- ** 'ReadS' Instances
  , readsWithParse
  , readsEnum
    -- * Template Haskell
    -- ** Constant Validation
    -- $ConstantValidation
  , valid
  , validOf
  , mkValid
  , untypedValidOf
  , mkUntypedValid
  , mkUntypedValidQQ
    -- * Default Instances
    -- $DefaultInstances
  , defaultRenderInstance
  , defaultRenderInstances
  , defaultParseInstance
  , defaultParseInstances
  , defaultRenderAndParseInstance
  , defaultRenderAndParseInstances
  ) where

-- https://hackage.haskell.org/package/base
import Data.Int (Int8, Int16, Int32, Int64)
import Data.Proxy (Proxy(Proxy), asProxyTypeOf)
import Data.String (IsString(fromString))
import Data.Word (Word8, Word16, Word32, Word64)
import GHC.Stack (HasCallStack)
import Text.Read (readMaybe)

-- https://hackage.haskell.org/package/bytestring
import qualified Data.ByteString as BS
import qualified Data.ByteString.Builder as BSB
import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Short as SBS

-- https://hackage.haskell.org/package/template-haskell
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Quote as Q
import qualified Language.Haskell.TH.Syntax as THS

-- https://hackage.haskell.org/package/text
import qualified Data.Text as T
import qualified Data.Text.Encoding as TE
import qualified Data.Text.Encoding.Error as TEE
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Lazy.Encoding as TLE

-- https://hackage.haskell.org/package/text-short
import qualified Data.Text.Short as ST

------------------------------------------------------------------------------
-- $Textual

-- | Convert from one textual data type to another
--
-- The following textual data types are supported:
--
-- * 'String' (@S@)
-- * Strict 'T.Text' (@T@)
-- * Lazy 'TL.Text' (@TL@)
-- * @Text@ 'TLB.Builder' (@TLB@)
-- * 'ST.ShortText' (@ST@)
-- * Strict 'BS.ByteString' (@BS@)
-- * Lazy 'BSL.ByteString' (@BSL@)
-- * @ByteString@ 'BSB.Builder' (@BSB@)
-- * 'SBS.ShortByteString' (@SBS@)
--
-- Note that support for additional textual data types cannot be implemented
-- by writing instances.  Adding support for additional textual data types
-- requires changing the class definition itself.  If you need support for
-- additional textual data types, consider using the
-- [ETTC](https://github.com/ExtremaIS/ttc-haskell/tree/main/ettc) library
-- instead.
--
-- Encoded values are assumed to be valid UTF-8 encoded text.  Conversions
-- must be pure, and any invalid bytes must be replaced with the Unicode
-- replacement character @U+FFFD@.  In cases where different behavior is
-- required, process encoded values separately.
--
-- For more details, see the following article:
-- <https://www.extrema.is/articles/ttc-textual-type-classes/textual-type-class>
--
-- @since 0.1.0.0
class Textual t where
  -- | Convert from a textual data type to a 'String'
  --
  -- @since 0.1.0.0
  toS :: t -> String

  -- | Convert from a textual data type to strict 'T.Text'
  --
  -- @since 0.1.0.0
  toT :: t -> T.Text

  -- | Convert from a textual data type to lazy 'TL.Text'
  --
  -- @since 0.1.0.0
  toTL :: t -> TL.Text

  -- | Convert from a textual data type to a @Text@ 'TLB.Builder'
  --
  -- @since 1.1.0.0
  toTLB :: t -> TLB.Builder

  -- | Convert from a textual data type to 'ST.ShortText'
  --
  -- @since 1.4.0.0
  toST :: t -> ST.ShortText

  -- | Convert from a textual data type to a strict 'BS.ByteString'
  --
  -- @since 0.1.0.0
  toBS :: t -> BS.ByteString

  -- | Convert from a textual data type to a lazy 'BS.ByteString'
  --
  -- @since 0.1.0.0
  toBSL :: t -> BSL.ByteString

  -- | Convert from a textual data type to a @ByteString@ 'BSB.Builder'
  --
  -- @since 1.1.0.0
  toBSB :: t -> BSB.Builder

  -- | Convert from a textual data type to a 'SBS.ShortByteString'
  --
  -- @since 1.1.0.0
  toSBS :: t -> SBS.ShortByteString

  -- | Convert from one textual data type to another
  --
  -- @since 0.1.0.0
  convert' :: Textual t' => t' -> t

instance Textual String where
  toS :: String -> String
toS = String -> String
forall a. a -> a
id
  toT :: String -> Text
toT = String -> Text
T.pack
  toTL :: String -> Text
toTL = String -> Text
TL.pack
  toTLB :: String -> Builder
toTLB = String -> Builder
TLB.fromString
  toST :: String -> ShortText
toST = String -> ShortText
ST.fromString
  toBS :: String -> ByteString
toBS = Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  toBSL :: String -> ByteString
toBSL = Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack
  toBSB :: String -> Builder
toBSB = ByteString -> Builder
BSB.byteString (ByteString -> Builder)
-> (String -> ByteString) -> String -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  toSBS :: String -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (String -> ByteString) -> String -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8 (Text -> ByteString) -> (String -> Text) -> String -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack
  convert' :: forall t'. Textual t' => t' -> String
convert' = t' -> String
forall t'. Textual t' => t' -> String
toS
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual T.Text where
  toS :: Text -> String
toS = Text -> String
T.unpack
  toT :: Text -> Text
toT = Text -> Text
forall a. a -> a
id
  toTL :: Text -> Text
toTL = Text -> Text
TL.fromStrict
  toTLB :: Text -> Builder
toTLB = Text -> Builder
TLB.fromText
  toST :: Text -> ShortText
toST = Text -> ShortText
ST.fromText
  toBS :: Text -> ByteString
toBS = Text -> ByteString
TE.encodeUtf8
  toBSL :: Text -> ByteString
toBSL = Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> (Text -> Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.fromStrict
  toBSB :: Text -> Builder
toBSB = ByteString -> Builder
BSB.byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
  toSBS :: Text -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Text -> ByteString) -> Text -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TE.encodeUtf8
  convert' :: forall t'. Textual t' => t' -> Text
convert' = t' -> Text
forall t'. Textual t' => t' -> Text
toT
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual TL.Text where
  toS :: Text -> String
toS = Text -> String
TL.unpack
  toT :: Text -> Text
toT = Text -> Text
TL.toStrict
  toTL :: Text -> Text
toTL = Text -> Text
forall a. a -> a
id
  toTLB :: Text -> Builder
toTLB = Text -> Builder
TLB.fromLazyText
  toST :: Text -> ShortText
toST = Text -> ShortText
ST.fromText (Text -> ShortText) -> (Text -> Text) -> Text -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
  toBS :: Text -> ByteString
toBS = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
  toBSL :: Text -> ByteString
toBSL = Text -> ByteString
TLE.encodeUtf8
  toBSB :: Text -> Builder
toBSB = ByteString -> Builder
BSB.lazyByteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
  toSBS :: Text -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Text -> ByteString) -> Text -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Text -> ByteString) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8
  convert' :: forall t'. Textual t' => t' -> Text
convert' = t' -> Text
forall t'. Textual t' => t' -> Text
toTL
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual TLB.Builder where
  toS :: Builder -> String
toS = Text -> String
TL.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  toT :: Builder -> Text
toT = Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  toTL :: Builder -> Text
toTL = Builder -> Text
TLB.toLazyText
  toTLB :: Builder -> Builder
toTLB = Builder -> Builder
forall a. a -> a
id
  toST :: Builder -> ShortText
toST = Text -> ShortText
ST.fromText (Text -> ShortText) -> (Builder -> Text) -> Builder -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  toBS :: Builder -> ByteString
toBS = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  toBSL :: Builder -> ByteString
toBSL = Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  toBSB :: Builder -> Builder
toBSB = ByteString -> Builder
BSB.lazyByteString (ByteString -> Builder)
-> (Builder -> ByteString) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  toSBS :: Builder -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Builder -> ByteString) -> Builder -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
TLE.encodeUtf8 (Text -> ByteString) -> (Builder -> Text) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
TLB.toLazyText
  convert' :: forall t'. Textual t' => t' -> Builder
convert' = t' -> Builder
forall t'. Textual t' => t' -> Builder
toTLB
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual ST.ShortText where
  toS :: ShortText -> String
toS = ShortText -> String
ST.toString
  toT :: ShortText -> Text
toT = ShortText -> Text
ST.toText
  toTL :: ShortText -> Text
toTL = Text -> Text
TL.fromStrict (Text -> Text) -> (ShortText -> Text) -> ShortText -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ST.toText
  toTLB :: ShortText -> Builder
toTLB = Text -> Builder
TLB.fromText (Text -> Builder) -> (ShortText -> Text) -> ShortText -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> Text
ST.toText
  toST :: ShortText -> ShortText
toST = ShortText -> ShortText
forall a. a -> a
id
  toBS :: ShortText -> ByteString
toBS = ShortText -> ByteString
ST.toByteString
  toBSL :: ShortText -> ByteString
toBSL = ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (ShortText -> ByteString) -> ShortText -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ByteString
ST.toByteString
  toBSB :: ShortText -> Builder
toBSB = ByteString -> Builder
BSB.byteString (ByteString -> Builder)
-> (ShortText -> ByteString) -> ShortText -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> ByteString
ST.toByteString
  toSBS :: ShortText -> ShortByteString
toSBS = ShortText -> ShortByteString
ST.toShortByteString
  convert' :: forall t'. Textual t' => t' -> ShortText
convert' = t' -> ShortText
forall t'. Textual t' => t' -> ShortText
toST
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual BS.ByteString where
  toS :: ByteString -> String
toS = Text -> String
T.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toT :: ByteString -> Text
toT = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toTL :: ByteString -> Text
toTL = OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict
  toTLB :: ByteString -> Builder
toTLB = Text -> Builder
TLB.fromText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toST :: ByteString -> ShortText
toST = Text -> ShortText
ST.fromText (Text -> ShortText)
-> (ByteString -> Text) -> ByteString -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toBS :: ByteString -> ByteString
toBS = ByteString -> ByteString
forall a. a -> a
id
  toBSL :: ByteString -> ByteString
toBSL = ByteString -> ByteString
BSL.fromStrict
  toBSB :: ByteString -> Builder
toBSB = ByteString -> Builder
BSB.byteString
  toSBS :: ByteString -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort
  convert' :: forall t'. Textual t' => t' -> ByteString
convert' = t' -> ByteString
forall t'. Textual t' => t' -> ByteString
toBS
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual BSL.ByteString where
  toS :: ByteString -> String
toS = Text -> String
TL.unpack (Text -> String) -> (ByteString -> Text) -> ByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toT :: ByteString -> Text
toT = Text -> Text
TL.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toTL :: ByteString -> Text
toTL = OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toTLB :: ByteString -> Builder
toTLB = Text -> Builder
TLB.fromLazyText (Text -> Builder) -> (ByteString -> Text) -> ByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toST :: ByteString -> ShortText
toST = Text -> ShortText
ST.fromText (Text -> ShortText)
-> (ByteString -> Text) -> ByteString -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict (Text -> Text) -> (ByteString -> Text) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
  toBS :: ByteString -> ByteString
toBS = ByteString -> ByteString
BSL.toStrict
  toBSL :: ByteString -> ByteString
toBSL = ByteString -> ByteString
forall a. a -> a
id
  toBSB :: ByteString -> Builder
toBSB = ByteString -> Builder
BSB.lazyByteString
  toSBS :: ByteString -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (ByteString -> ByteString) -> ByteString -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict
  convert' :: forall t'. Textual t' => t' -> ByteString
convert' = t' -> ByteString
forall t'. Textual t' => t' -> ByteString
toBSL
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual BSB.Builder where
  toS :: Builder -> String
toS =
    Text -> String
TL.unpack (Text -> String) -> (Builder -> Text) -> Builder -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toT :: Builder -> Text
toT =
    Text -> Text
TL.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toTL :: Builder -> Text
toTL = OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toTLB :: Builder -> Builder
toTLB
    = Text -> Builder
TLB.fromLazyText
    (Text -> Builder) -> (Builder -> Text) -> Builder -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
    (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toST :: Builder -> ShortText
toST
    = Text -> ShortText
ST.fromText
    (Text -> ShortText) -> (Builder -> Text) -> Builder -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
TL.toStrict
    (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode
    (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toBS :: Builder -> ByteString
toBS = ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  toBSL :: Builder -> ByteString
toBSL = Builder -> ByteString
BSB.toLazyByteString
  toBSB :: Builder -> Builder
toBSB = Builder -> Builder
forall a. a -> a
id
  toSBS :: Builder -> ShortByteString
toSBS = ByteString -> ShortByteString
SBS.toShort (ByteString -> ShortByteString)
-> (Builder -> ByteString) -> Builder -> ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
BSB.toLazyByteString
  convert' :: forall t'. Textual t' => t' -> Builder
convert' = t' -> Builder
forall t'. Textual t' => t' -> Builder
toBSB
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

instance Textual SBS.ShortByteString where
  toS :: ShortByteString -> String
toS = Text -> String
T.unpack (Text -> String)
-> (ShortByteString -> Text) -> ShortByteString -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toT :: ShortByteString -> Text
toT = OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toTL :: ShortByteString -> Text
toTL = OnDecodeError -> ByteString -> Text
TLE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toTLB :: ShortByteString -> Builder
toTLB = Text -> Builder
TLB.fromText (Text -> Builder)
-> (ShortByteString -> Text) -> ShortByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toST :: ShortByteString -> ShortText
toST = Text -> ShortText
ST.fromText (Text -> ShortText)
-> (ShortByteString -> Text) -> ShortByteString -> ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnDecodeError -> ByteString -> Text
TE.decodeUtf8With OnDecodeError
TEE.lenientDecode (ByteString -> Text)
-> (ShortByteString -> ByteString) -> ShortByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toBS :: ShortByteString -> ByteString
toBS = ShortByteString -> ByteString
SBS.fromShort
  toBSL :: ShortByteString -> ByteString
toBSL = ByteString -> ByteString
BSL.fromStrict (ByteString -> ByteString)
-> (ShortByteString -> ByteString) -> ShortByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toBSB :: ShortByteString -> Builder
toBSB = ByteString -> Builder
BSB.byteString (ByteString -> Builder)
-> (ShortByteString -> ByteString) -> ShortByteString -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> ByteString
SBS.fromShort
  toSBS :: ShortByteString -> ShortByteString
toSBS = ShortByteString -> ShortByteString
forall a. a -> a
id
  convert' :: forall t'. Textual t' => t' -> ShortByteString
convert' = t' -> ShortByteString
forall t'. Textual t' => t' -> ShortByteString
toSBS
  {-# INLINE toS #-}
  {-# INLINE toT #-}
  {-# INLINE toTL #-}
  {-# INLINE toTLB #-}
  {-# INLINE toST #-}
  {-# INLINE toBS #-}
  {-# INLINE toBSL #-}
  {-# INLINE toBSB #-}
  {-# INLINE toSBS #-}
  {-# INLINE convert' #-}

------------------------------------------------------------------------------

-- | Convert from one textual data type to another
--
-- The order of the type arguments was changed in version 1.5.0.0.
--
-- @since 0.1.0.0
convert :: forall t t'. (Textual t, Textual t') => t -> t'
convert :: forall t t'. (Textual t, Textual t') => t -> t'
convert = t -> t'
forall t'. Textual t' => t' -> t'
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE convert #-}

------------------------------------------------------------------------------
-- $TextualTo
--
-- These functions are equivalent to 'convert', but they specify the type
-- being converted to.  Use them to avoid having to write type annotations in
-- cases where the type is ambiguous.  Using these functions may make code
-- easier to understand even in cases where the types are not ambiguous.

-- $TextualFrom
--
-- These functions are equivalent to 'convert', but they specify the type
-- being converted from.  Use them to avoid having to write type annotations
-- in cases where the type is ambiguous.  Using these functions may make code
-- easier to understand even in cases where the types are not ambiguous.

-- | Convert from a 'String' to a textual data type
--
-- @since 0.1.0.0
fromS :: Textual t => String -> t
fromS :: forall t. Textual t => String -> t
fromS = String -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromS #-}

-- | Convert from strict 'T.Text' to a textual data type
--
-- @since 0.1.0.0
fromT :: Textual t => T.Text -> t
fromT :: forall t. Textual t => Text -> t
fromT = Text -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromT #-}

-- | Convert from lazy 'TL.Text' to a textual data type
--
-- @since 0.1.0.0
fromTL :: Textual t => TL.Text -> t
fromTL :: forall t. Textual t => Text -> t
fromTL = Text -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromTL #-}

-- | Convert from a @Text@ 'TLB.Builder' to a textual data type
--
-- @since 1.1.0.0
fromTLB :: Textual t => TLB.Builder -> t
fromTLB :: forall t. Textual t => Builder -> t
fromTLB = Builder -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromTLB #-}

-- | Convert from a 'ST.ShortText' to a textual data type
--
-- @since 1.4.0.0
fromST :: Textual t => ST.ShortText -> t
fromST :: forall t. Textual t => ShortText -> t
fromST = ShortText -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromST #-}

-- | Convert from a strict 'BS.ByteString' to a textual data type
--
-- @since 0.1.0.0
fromBS :: Textual t => BS.ByteString -> t
fromBS :: forall t. Textual t => ByteString -> t
fromBS = ByteString -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromBS #-}

-- | Convert from a lazy 'BSL.ByteString' to a textual data type
--
-- @since 0.1.0.0
fromBSL :: Textual t => BSL.ByteString -> t
fromBSL :: forall t. Textual t => ByteString -> t
fromBSL = ByteString -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromBSL #-}

-- | Convert from a @ByteString@ 'TLB.Builder' to a textual data type
--
-- @since 1.1.0.0
fromBSB :: Textual t => BSB.Builder -> t
fromBSB :: forall t. Textual t => Builder -> t
fromBSB = Builder -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromBSB #-}

-- | Convert from a 'SBS.ShortByteString' to a textual data type
--
-- @since 1.1.0.0
fromSBS :: Textual t => SBS.ShortByteString -> t
fromSBS :: forall t. Textual t => ShortByteString -> t
fromSBS = ShortByteString -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE fromSBS #-}

------------------------------------------------------------------------------
-- $TextualAs
--
-- These functions are used to convert a textual data type argument to a
-- specific type.  Use them to reduce boilerplate in small function
-- definitions.

-- | Convert a textual data type argument to a 'String'
--
-- @since 0.1.0.0
asS :: forall t a. Textual t => (String -> a) -> t -> a
asS :: forall t a. Textual t => (String -> a) -> t -> a
asS String -> a
f = String -> a
f (String -> a) -> (t -> String) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t'. Textual t' => t' -> String
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asS #-}

-- | Convert a textual data type argument to strict 'T.Text'
--
-- @since 0.1.0.0
asT :: forall t a. Textual t => (T.Text -> a) -> t -> a
asT :: forall t a. Textual t => (Text -> a) -> t -> a
asT Text -> a
f = Text -> a
f (Text -> a) -> (t -> Text) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall t'. Textual t' => t' -> Text
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asT #-}

-- | Convert a textual data type argument to lazy 'TL.Text'
--
-- @since 0.1.0.0
asTL :: forall t a. Textual t => (TL.Text -> a) -> t -> a
asTL :: forall t a. Textual t => (Text -> a) -> t -> a
asTL Text -> a
f = Text -> a
f (Text -> a) -> (t -> Text) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall t'. Textual t' => t' -> Text
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asTL #-}

-- | Convert a textual data type argument to a @Text@ 'TLB.Builder'
--
-- @since 1.1.0.0
asTLB :: forall t a. Textual t => (TLB.Builder -> a) -> t -> a
asTLB :: forall t a. Textual t => (Builder -> a) -> t -> a
asTLB Builder -> a
f = Builder -> a
f (Builder -> a) -> (t -> Builder) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Builder
forall t'. Textual t' => t' -> Builder
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asTLB #-}

-- | Convert a textual data type argument to a 'ST.ShortText'
--
-- @since 1.4.0.0
asST :: forall t a. Textual t => (ST.ShortText -> a) -> t -> a
asST :: forall t a. Textual t => (ShortText -> a) -> t -> a
asST ShortText -> a
f = ShortText -> a
f (ShortText -> a) -> (t -> ShortText) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShortText
forall t'. Textual t' => t' -> ShortText
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asST #-}

-- | Convert a textual data type argument to a strict 'BS.ByteString'
--
-- @since 0.1.0.0
asBS :: forall t a. Textual t => (BS.ByteString -> a) -> t -> a
asBS :: forall t a. Textual t => (ByteString -> a) -> t -> a
asBS ByteString -> a
f = ByteString -> a
f (ByteString -> a) -> (t -> ByteString) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall t'. Textual t' => t' -> ByteString
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asBS #-}

-- | Convert a textual data type argument to a lazy 'BSL.ByteString'
--
-- @since 0.1.0.0
asBSL :: forall t a. Textual t => (BSL.ByteString -> a) -> t -> a
asBSL :: forall t a. Textual t => (ByteString -> a) -> t -> a
asBSL ByteString -> a
f = ByteString -> a
f (ByteString -> a) -> (t -> ByteString) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall t'. Textual t' => t' -> ByteString
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asBSL #-}

-- | Convert a textual data type argument to a @ByteString@ 'TLB.Builder'
--
-- @since 1.1.0.0
asBSB :: forall t a. Textual t => (BSB.Builder -> a ) -> t -> a
asBSB :: forall t a. Textual t => (Builder -> a) -> t -> a
asBSB Builder -> a
f = Builder -> a
f (Builder -> a) -> (t -> Builder) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Builder
forall t'. Textual t' => t' -> Builder
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asBSB #-}

-- | Convert a textual data type argument to a 'SBS.ShortByteString'
--
-- @since 1.1.0.0
asSBS :: forall t a. Textual t => (SBS.ShortByteString -> a) -> t -> a
asSBS :: forall t a. Textual t => (ShortByteString -> a) -> t -> a
asSBS ShortByteString -> a
f = ShortByteString -> a
f (ShortByteString -> a) -> (t -> ShortByteString) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShortByteString
forall t'. Textual t' => t' -> ShortByteString
forall t t'. (Textual t, Textual t') => t' -> t
convert'
{-# INLINE asSBS #-}

------------------------------------------------------------------------------
-- $Render

-- | Render a data type as a textual data type
--
-- Use 'Render' in your business logic, and only use 'Show' for debugging, as
-- use of 'Show' instances in business logic is a common source of bugs.
--
-- When defining an instance, render to the textual data type that is most
-- natural for the data type, and then use 'convert' to handle the conversion
-- to any textual data type.  This is particularly wrappers around a textual
-- data type.  Example:
--
-- @
-- newtype Username = Username { usernameText :: Text }
--
-- instance TTC.Render Username where
--   render = TTC.convert . usernameText
-- @
--
-- To use @render@ in a context where the types are ambiguous, use the
-- [@TypeApplications@](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html)
-- GHC extension to specify one or both types.  Example:
--
-- @
-- -- Render to Text
-- render @_ @Text foo
-- @
--
-- Alternatively, use one of the functions that render to a specific textual
-- data type (such as 'renderS').  Using these functions may make code easier
-- to understand even in cases where the types are not ambiguous.
--
-- See the @uname@ and @prompt@ example programs in the @ttc-examples@
-- directory of the source repository.
--
-- For more details, see the following article:
-- <https://www.extrema.is/articles/ttc-textual-type-classes/render-and-parse>
--
-- Since a type may have at most one instance of a given type class, special
-- care must be taken when defining type class instances in a shared library.
-- In particular, orphan instances should generally not be used in shared
-- libraries since they prevent users of the libraries from writing their own
-- instances.  Use @newtype@ wrappers instead.
--
-- There are no default instances for the 'Render' type class, so that all
-- instances can be customized per project when desired.  Instances for some
-- basic data types are defined for the 'RenderDefault' type class, however,
-- and the Template Haskell functions documented below can be used to load
-- these definitions with minimal boilerplate.
--
-- @since 0.1.0.0
class Render a where
  -- | Render a data type as a textual data type
  --
  -- @since 0.1.0.0
  render :: Textual t => a -> t

  default render :: (RenderDefault a, Textual t) => a -> t
  render = a -> t
forall a t. (RenderDefault a, Textual t) => a -> t
forall t. Textual t => a -> t
renderDefault

------------------------------------------------------------------------------

-- | Default 'Render' instances for some common types
--
-- * The 'Bool' instance renders using the 'Show' instance.  This instance was
--   added in version 1.5.0.0.
-- * The 'Char' instance renders a single-character string.
-- * Numeric type instances all render using the 'Show' instance.
-- * Textual data type instances all convert to the target textual data type.
--
-- @since 1.1.0.0
class RenderDefault a where
  -- | Render a data type as a textual data type
  --
  -- @since 1.1.0.0
  renderDefault :: Textual t => a -> t

instance RenderDefault Bool where
  renderDefault :: forall t. Textual t => Bool -> t
renderDefault = Bool -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Char where
  renderDefault :: forall t. Textual t => Char -> t
renderDefault Char
c = String -> t
forall t. Textual t => String -> t
fromS [Char
c]

instance RenderDefault Double where
  renderDefault :: forall t. Textual t => Double -> t
renderDefault = Double -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Float where
  renderDefault :: forall t. Textual t => Float -> t
renderDefault = Float -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Integer where
  renderDefault :: forall t. Textual t => Integer -> t
renderDefault = Integer -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Int where
  renderDefault :: forall t. Textual t => Int -> t
renderDefault = Int -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Int8 where
  renderDefault :: forall t. Textual t => Int8 -> t
renderDefault = Int8 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Int16 where
  renderDefault :: forall t. Textual t => Int16 -> t
renderDefault = Int16 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Int32 where
  renderDefault :: forall t. Textual t => Int32 -> t
renderDefault = Int32 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Int64 where
  renderDefault :: forall t. Textual t => Int64 -> t
renderDefault = Int64 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Word where
  renderDefault :: forall t. Textual t => Word -> t
renderDefault = Word -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Word8 where
  renderDefault :: forall t. Textual t => Word8 -> t
renderDefault = Word8 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Word16 where
  renderDefault :: forall t. Textual t => Word16 -> t
renderDefault = Word16 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Word32 where
  renderDefault :: forall t. Textual t => Word32 -> t
renderDefault = Word32 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault Word64 where
  renderDefault :: forall t. Textual t => Word64 -> t
renderDefault = Word64 -> t
forall t a. (Show a, Textual t) => a -> t
renderWithShow

instance RenderDefault String where
  renderDefault :: forall t. Textual t => String -> t
renderDefault = String -> t
forall t. Textual t => String -> t
fromS

instance RenderDefault T.Text where
  renderDefault :: forall t. Textual t => Text -> t
renderDefault = Text -> t
forall t. Textual t => Text -> t
fromT

instance RenderDefault TL.Text where
  renderDefault :: forall t. Textual t => Text -> t
renderDefault = Text -> t
forall t. Textual t => Text -> t
fromTL

instance RenderDefault TLB.Builder where
  renderDefault :: forall t. Textual t => Builder -> t
renderDefault = Builder -> t
forall t. Textual t => Builder -> t
fromTLB

instance RenderDefault ST.ShortText where
  renderDefault :: forall t. Textual t => ShortText -> t
renderDefault = ShortText -> t
forall t. Textual t => ShortText -> t
fromST

instance RenderDefault BS.ByteString where
  renderDefault :: forall t. Textual t => ByteString -> t
renderDefault = ByteString -> t
forall t. Textual t => ByteString -> t
fromBS

instance RenderDefault BSL.ByteString where
  renderDefault :: forall t. Textual t => ByteString -> t
renderDefault = ByteString -> t
forall t. Textual t => ByteString -> t
fromBSL

instance RenderDefault BSB.Builder where
  renderDefault :: forall t. Textual t => Builder -> t
renderDefault = Builder -> t
forall t. Textual t => Builder -> t
fromBSB

instance RenderDefault SBS.ShortByteString where
  renderDefault :: forall t. Textual t => ShortByteString -> t
renderDefault = ShortByteString -> t
forall t. Textual t => ShortByteString -> t
fromSBS

------------------------------------------------------------------------------
-- $RenderUtilityFunctions
--
-- These functions are used to implement 'Render' instances.

-- | Render a value to a textual data type using a 'Show' instance
--
-- To use this function in a context where the types are ambiguous, use the
-- [@TypeApplications@](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html)
-- GHC extension to specify one or both types.  Example:
--
-- @
-- -- Render to Text
-- renderWithShow @Text foo
-- @
--
-- See the @enum@ example program in the @ttc-examples@ directory of the
-- source repository.
--
-- @since 0.1.0.0
renderWithShow :: forall t a. (Show a, Textual t) => a -> t
renderWithShow :: forall t a. (Show a, Textual t) => a -> t
renderWithShow = String -> t
forall t'. Textual t' => t' -> t
forall t t'. (Textual t, Textual t') => t' -> t
convert' (String -> t) -> (a -> String) -> a -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
{-# INLINE renderWithShow #-}

------------------------------------------------------------------------------
-- $RenderSpecific
--
-- These functions are equivalent to 'render', but they specify the textual
-- data type being rendered to.  Use them to avoid having to write type
-- annotations in cases where the type is ambiguous.  Using these functions
-- may make code easier to understand even in cases where the types are not
-- ambiguous.

-- | Render to a 'String'
--
-- @since 0.1.0.0
renderS :: Render a => a -> String
renderS :: forall a. Render a => a -> String
renderS = a -> String
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderS #-}

-- | Render to strict 'T.Text'
--
-- @since 0.1.0.0
renderT :: Render a => a -> T.Text
renderT :: forall a. Render a => a -> Text
renderT = a -> Text
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderT #-}

-- | Render to lazy 'TL.Text'
--
-- @since 0.1.0.0
renderTL :: Render a => a -> TL.Text
renderTL :: forall a. Render a => a -> Text
renderTL = a -> Text
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderTL #-}

-- | Render to a @Text@ 'TLB.Builder'
--
-- @since 0.4.0.0
renderTLB :: Render a => a -> TLB.Builder
renderTLB :: forall a. Render a => a -> Builder
renderTLB = a -> Builder
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderTLB #-}

-- | Render to a 'ST.ShortText'
--
-- @since 1.4.0.0
renderST :: Render a => a -> ST.ShortText
renderST :: forall a. Render a => a -> ShortText
renderST = a -> ShortText
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderST #-}

-- | Render to a strict 'BS.ByteString'
--
-- @since 0.1.0.0
renderBS :: Render a => a -> BS.ByteString
renderBS :: forall a. Render a => a -> ByteString
renderBS = a -> ByteString
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderBS #-}

-- | Render to a lazy 'BSL.ByteString'
--
-- @since 0.1.0.0
renderBSL :: Render a => a -> BSL.ByteString
renderBSL :: forall a. Render a => a -> ByteString
renderBSL = a -> ByteString
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderBSL #-}

-- | Render to a @ByteString@ 'BSB.Builder'
--
-- @since 0.4.0.0
renderBSB :: Render a => a -> BSB.Builder
renderBSB :: forall a. Render a => a -> Builder
renderBSB = a -> Builder
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderBSB #-}

-- | Render to a 'SBS.ShortByteString'
--
-- @since 0.4.0.0
renderSBS :: Render a => a -> SBS.ShortByteString
renderSBS :: forall a. Render a => a -> ShortByteString
renderSBS = a -> ShortByteString
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render
{-# INLINE renderSBS #-}

------------------------------------------------------------------------------
-- $Parse

-- | Parse a data type from a textual data type
--
-- Unlike 'Read', 'Parse' allows you to specify meaningful error messages.
--
-- When defining an instance, first convert the textual data type to the
-- textual data type that is most natural for the data type.  The @as@
-- functions (such as 'asS') provide a convenient way to do this.  Note that
-- error is also a textual data type.  The 'withError' and 'prefixError'
-- functions can be used to reduce boilerplate.  Example:
--
-- @
-- newtype Username = Username { usernameText :: Text }
--
-- instance TTC.Parse Username where
--   parse = TTC.asT $ \t -> TTC.prefixErrorS "invalid username: " $ do
--     unless (T.all isAsciiLower t) $ Left "not only lowercase ASCII letters"
--     let len = T.length t
--     when (len < 3) $ Left "fewer than 3 characters"
--     when (len > 12) $ Left "more than 12 characters"
--     pure $ Username t
-- @
--
-- To use @parse@ in a context where the types are ambiguous, use the
-- [@TypeApplications@](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/type_applications.html)
-- GHC extension to specify one or more types.  Example:
--
-- @
-- -- Parse from Text
-- parse @_ @Text foo
--
-- -- Parse using String errors
-- parse @_ @_ @String foo
--
-- -- Parse from Text using String errors
-- parse @_ @Text @String foo
-- @
--
-- Alternatively, use one of the functions that parse from a specific textual
-- data type (such as 'renderS').  Using these functions may make code easier
-- to understand even in cases where the types are not ambiguous.
--
-- See the @uname@ and @prompt@ example programs in the @ttc-examples@
-- directory of the source repository.
--
-- For more details, see the following article:
-- <https://www.extrema.is/articles/ttc-textual-type-classes/render-and-parse>
--
-- Since a type may have at most one instance of a given type class, special
-- care must be taken when defining type class instances in a shared library.
-- In particular, orphan instances should generally not be used in shared
-- libraries since they prevent users of the libraries from writing their own
-- instances.  Use @newtype@ wrappers instead.
--
-- There are no default instances for the 'Parse' type class, so that all
-- instances can be customized per project when desired.  Instances for some
-- basic data types are defined for the 'ParseDefault' type class, however,
-- and the Template Haskell functions documented below can be used to load
-- these definitions with minimal boilerplate.
--
-- @since 0.3.0.0
class Parse a where
  -- | Parse a data type from a textual data type
  --
  -- @since 0.3.0.0
  parse :: (Textual t, Textual e) => t -> Either e a

  default parse :: (Textual t, Textual e, ParseDefault a) => t -> Either e a
  parse = t -> Either e a
forall a t e.
(ParseDefault a, Textual t, Textual e) =>
t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parseDefault

-- This function is equivalent to 'parse' with the error type fixed to
-- 'String', used internally when the error is ignored.
--
-- @since 0.3.0.0
parse' :: forall t a. (Parse a, Textual t) => t -> Either String a
parse' :: forall t a. (Parse a, Textual t) => t -> Either String a
parse' = t -> Either String a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parse' #-}

------------------------------------------------------------------------------

-- | The 'ParseDefault' type class provides some default 'Parse' instances.
--
-- * The 'Bool' instance parses using the 'Read' instance.  This instance was
--   added in version 1.5.0.0.
-- * The 'Char' instance parses single-character strings.
-- * Numeric type instances all parse using the 'Read' instance.
-- * Textual data type instances all convert from the source textual data
--   type.
--
-- @since 1.1.0.0
class ParseDefault a where
  -- | Parse a data type from a textual data type
  --
  -- @since 1.1.0.0
  parseDefault :: (Textual t, Textual e) => t -> Either e a

instance ParseDefault Bool where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Bool
parseDefault = String -> t -> Either e Bool
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Bool"

instance ParseDefault Char where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Char
parseDefault = (String -> Either e Char) -> t -> Either e Char
forall t a. Textual t => (String -> a) -> t -> a
asS ((String -> Either e Char) -> t -> Either e Char)
-> (String -> Either e Char) -> t -> Either e Char
forall a b. (a -> b) -> a -> b
$ \case
    [Char
c] -> Char -> Either e Char
forall a b. b -> Either a b
Right Char
c
    String
_cs -> e -> Either e Char
forall a b. a -> Either a b
Left (e -> Either e Char) -> e -> Either e Char
forall a b. (a -> b) -> a -> b
$ String -> e
forall t. Textual t => String -> t
fromS String
"invalid Char"

instance ParseDefault Double where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Double
parseDefault = String -> t -> Either e Double
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Double"

instance ParseDefault Float where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Float
parseDefault = String -> t -> Either e Float
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Float"

instance ParseDefault Integer where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Integer
parseDefault = String -> t -> Either e Integer
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Integer"

instance ParseDefault Int where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Int
parseDefault = String -> t -> Either e Int
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Int"

instance ParseDefault Int8 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Int8
parseDefault = String -> t -> Either e Int8
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Int8"

instance ParseDefault Int16 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Int16
parseDefault = String -> t -> Either e Int16
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Int16"

instance ParseDefault Int32 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Int32
parseDefault = String -> t -> Either e Int32
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Int32"

instance ParseDefault Int64 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Int64
parseDefault = String -> t -> Either e Int64
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Int64"

instance ParseDefault Word where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Word
parseDefault = String -> t -> Either e Word
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Word"

instance ParseDefault Word8 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Word8
parseDefault = String -> t -> Either e Word8
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Word8"

instance ParseDefault Word16 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Word16
parseDefault = String -> t -> Either e Word16
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Word16"

instance ParseDefault Word32 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Word32
parseDefault = String -> t -> Either e Word32
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Word32"

instance ParseDefault Word64 where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Word64
parseDefault = String -> t -> Either e Word64
forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
"Word64"

instance ParseDefault String where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e String
parseDefault = String -> Either e String
forall a b. b -> Either a b
Right (String -> Either e String)
-> (t -> String) -> t -> Either e String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t'. Textual t' => t' -> String
toS

instance ParseDefault T.Text where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Text
parseDefault = Text -> Either e Text
forall a b. b -> Either a b
Right (Text -> Either e Text) -> (t -> Text) -> t -> Either e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall t'. Textual t' => t' -> Text
toT

instance ParseDefault TL.Text where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Text
parseDefault = Text -> Either e Text
forall a b. b -> Either a b
Right (Text -> Either e Text) -> (t -> Text) -> t -> Either e Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Text
forall t'. Textual t' => t' -> Text
toTL

instance ParseDefault TLB.Builder where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Builder
parseDefault = Builder -> Either e Builder
forall a b. b -> Either a b
Right (Builder -> Either e Builder)
-> (t -> Builder) -> t -> Either e Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Builder
forall t'. Textual t' => t' -> Builder
toTLB

instance ParseDefault ST.ShortText where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e ShortText
parseDefault = ShortText -> Either e ShortText
forall a b. b -> Either a b
Right (ShortText -> Either e ShortText)
-> (t -> ShortText) -> t -> Either e ShortText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShortText
forall t'. Textual t' => t' -> ShortText
toST

instance ParseDefault BS.ByteString where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e ByteString
parseDefault = ByteString -> Either e ByteString
forall a b. b -> Either a b
Right (ByteString -> Either e ByteString)
-> (t -> ByteString) -> t -> Either e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall t'. Textual t' => t' -> ByteString
toBS

instance ParseDefault BSL.ByteString where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e ByteString
parseDefault = ByteString -> Either e ByteString
forall a b. b -> Either a b
Right (ByteString -> Either e ByteString)
-> (t -> ByteString) -> t -> Either e ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ByteString
forall t'. Textual t' => t' -> ByteString
toBSL

instance ParseDefault BSB.Builder where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e Builder
parseDefault = Builder -> Either e Builder
forall a b. b -> Either a b
Right (Builder -> Either e Builder)
-> (t -> Builder) -> t -> Either e Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Builder
forall t'. Textual t' => t' -> Builder
toBSB

instance ParseDefault SBS.ShortByteString where
  parseDefault :: forall t e. (Textual t, Textual e) => t -> Either e ShortByteString
parseDefault = ShortByteString -> Either e ShortByteString
forall a b. b -> Either a b
Right (ShortByteString -> Either e ShortByteString)
-> (t -> ShortByteString) -> t -> Either e ShortByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> ShortByteString
forall t'. Textual t' => t' -> ShortByteString
toSBS

------------------------------------------------------------------------------
-- $ParseUtilityFunctions
--
-- These functions are used to implement 'Parse' instances.

------------------------------------------------------------------------------
-- $ParseWithASingleErrorMessage
--
-- The 'withError' function takes an error message and a 'Maybe' value.  It
-- returns a 'Parse' result: the error when the 'Maybe' value is 'Nothing', or
-- the value inside the 'Just'.  This provides a convenient way to return the
-- same error message for any parse error.  The rest of the functions are
-- equivalent to 'withError', but they specify the type of the error message.
-- Use them to avoid having to write type annotations in cases where the type
-- is ambiguous.

-- | Create a 'Parse' result from a 'Textual' error message and a 'Maybe'
-- value
--
-- @since 1.2.0.0
withError
  :: forall e' e a. (Textual e', Textual e)
  => e'
  -> Maybe a
  -> Either e a
withError :: forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError e'
err = Either e a -> (a -> Either e a) -> Maybe a -> Either e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> e -> Either e a
forall a b. (a -> b) -> a -> b
$ e' -> e
forall t'. Textual t' => t' -> e
forall t t'. (Textual t, Textual t') => t' -> t
convert' e'
err) a -> Either e a
forall a b. b -> Either a b
Right
{-# INLINE withError #-}

-- | Create a 'Parse' result from a 'String' error message and a 'Maybe' value
--
-- @since 1.2.0.0
withErrorS
  :: forall e a. Textual e
  => String
  -> Maybe a
  -> Either e a
withErrorS :: forall e a. Textual e => String -> Maybe a -> Either e a
withErrorS = String -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorS #-}

-- | Create a 'Parse' result from a 'T.Text' error message and a 'Maybe' value
--
-- @since 1.2.0.0
withErrorT
  :: forall e a. Textual e
  => T.Text
  -> Maybe a
  -> Either e a
withErrorT :: forall e a. Textual e => Text -> Maybe a -> Either e a
withErrorT = Text -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorT #-}

-- | Create a 'Parse' result from a 'TL.Text' error message and a 'Maybe'
-- value
--
-- @since 1.2.0.0
withErrorTL
  :: forall e a. Textual e
  => TL.Text
  -> Maybe a
  -> Either e a
withErrorTL :: forall e a. Textual e => Text -> Maybe a -> Either e a
withErrorTL = Text -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorTL #-}

-- | Create a 'Parse' result from a 'TLB.Builder' error message and a 'Maybe'
-- value
--
-- @since 1.2.0.0
withErrorTLB
  :: forall e a. Textual e
  => TLB.Builder
  -> Maybe a
  -> Either e a
withErrorTLB :: forall e a. Textual e => Builder -> Maybe a -> Either e a
withErrorTLB = Builder -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorTLB #-}

-- | Create a 'Parse' result from a 'ST.ShortText' error message and a 'Maybe'
-- value
--
-- @since 1.4.0.0
withErrorST
  :: forall e a. Textual e
  => ST.ShortText
  -> Maybe a
  -> Either e a
withErrorST :: forall e a. Textual e => ShortText -> Maybe a -> Either e a
withErrorST = ShortText -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorST #-}

-- | Create a 'Parse' result from a 'BS.ByteString' error message and a
-- 'Maybe' value
--
-- @since 1.2.0.0
withErrorBS
  :: forall e a. Textual e
  => BS.ByteString
  -> Maybe a
  -> Either e a
withErrorBS :: forall e a. Textual e => ByteString -> Maybe a -> Either e a
withErrorBS = ByteString -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorBS #-}

-- | Create a 'Parse' result from a 'BSL.ByteString' error message and a
-- 'Maybe' value
--
-- @since 1.2.0.0
withErrorBSL
  :: forall e a. Textual e
  => BSL.ByteString
  -> Maybe a
  -> Either e a
withErrorBSL :: forall e a. Textual e => ByteString -> Maybe a -> Either e a
withErrorBSL = ByteString -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorBSL #-}

-- | Create a 'Parse' result from a 'BSB.Builder' error message and a
-- 'Maybe' value
--
-- @since 1.2.0.0
withErrorBSB
  :: forall e a. Textual e
  => BSB.Builder
  -> Maybe a
  -> Either e a
withErrorBSB :: forall e a. Textual e => Builder -> Maybe a -> Either e a
withErrorBSB = Builder -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorBSB #-}

-- | Create a 'Parse' result from a 'SBS.ShortByteString' error message and a
-- 'Maybe' value
--
-- @since 1.2.0.0
withErrorSBS
  :: forall e a. Textual e
  => SBS.ShortByteString
  -> Maybe a
  -> Either e a
withErrorSBS :: forall e a. Textual e => ShortByteString -> Maybe a -> Either e a
withErrorSBS = ShortByteString -> Maybe a -> Either e a
forall e' e a.
(Textual e', Textual e) =>
e' -> Maybe a -> Either e a
withError
{-# INLINE withErrorSBS #-}

------------------------------------------------------------------------------
-- $ParseWithAnErrorPrefix
--
-- The 'prefixError' function adds a common prefix to error messages of a
-- 'Parse' result.  The rest of the functions are equivalent to 'prefixError',
-- but they specify the type of the error message.  Use them to avoid having
-- to write type annotations in cases where the type is ambiguous.

-- | Add a prefix to 'Textual' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixError
  :: forall e' e a. (Monoid e', Textual e', Textual e)
  => e'
  -> Either e' a
  -> Either e a
prefixError :: forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError e'
prefix = (e' -> Either e a)
-> (a -> Either e a) -> Either e' a -> Either e a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (e -> Either e a
forall a b. a -> Either a b
Left (e -> Either e a) -> (e' -> e) -> e' -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> e
forall t'. Textual t' => t' -> e
forall t t'. (Textual t, Textual t') => t' -> t
convert' (e' -> e) -> (e' -> e') -> e' -> e
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e' -> e' -> e'
forall a. Monoid a => a -> a -> a
mappend e'
prefix) a -> Either e a
forall a b. b -> Either a b
Right
{-# INLINE prefixError #-}

-- | Add a prefix to 'String' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorS
  :: forall e a. Textual e
  => String
  -> Either String a
  -> Either e a
prefixErrorS :: forall e a. Textual e => String -> Either String a -> Either e a
prefixErrorS = String -> Either String a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorS #-}

-- | Add a prefix to 'T.Text' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorT
  :: forall e a. Textual e
  => T.Text
  -> Either T.Text a
  -> Either e a
prefixErrorT :: forall e a. Textual e => Text -> Either Text a -> Either e a
prefixErrorT = Text -> Either Text a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorT #-}

-- | Add a prefix to 'TL.Text' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorTL
  :: forall e a. Textual e
  => TL.Text
  -> Either TL.Text a
  -> Either e a
prefixErrorTL :: forall e a. Textual e => Text -> Either Text a -> Either e a
prefixErrorTL = Text -> Either Text a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorTL #-}

-- | Add a prefix to 'TLB.Builder' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorTLB
  :: forall e a. Textual e
  => TLB.Builder
  -> Either TLB.Builder a
  -> Either e a
prefixErrorTLB :: forall e a. Textual e => Builder -> Either Builder a -> Either e a
prefixErrorTLB = Builder -> Either Builder a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorTLB #-}

-- | Add a prefix to 'ST.ShortText' error messages of a 'Parse' result
--
-- @since 1.4.0.0
prefixErrorST
  :: forall e a. Textual e
  => ST.ShortText
  -> Either ST.ShortText a
  -> Either e a
prefixErrorST :: forall e a.
Textual e =>
ShortText -> Either ShortText a -> Either e a
prefixErrorST = ShortText -> Either ShortText a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorST #-}

-- | Add a prefix to 'BS.ByteString' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorBS
  :: forall e a. Textual e
  => BS.ByteString
  -> Either BS.ByteString a
  -> Either e a
prefixErrorBS :: forall e a.
Textual e =>
ByteString -> Either ByteString a -> Either e a
prefixErrorBS = ByteString -> Either ByteString a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorBS #-}

-- | Add a prefix to 'BSL.ByteString' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorBSL
  :: forall e a. Textual e
  => BSL.ByteString
  -> Either BSL.ByteString a
  -> Either e a
prefixErrorBSL :: forall e a.
Textual e =>
ByteString -> Either ByteString a -> Either e a
prefixErrorBSL = ByteString -> Either ByteString a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorBSL #-}

-- | Add a prefix to 'BSB.Builder' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorBSB
  :: forall e a. Textual e
  => BSB.Builder
  -> Either BSB.Builder a
  -> Either e a
prefixErrorBSB :: forall e a. Textual e => Builder -> Either Builder a -> Either e a
prefixErrorBSB = Builder -> Either Builder a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorBSB #-}

-- | Add a prefix to 'SBS.ShortByteString' error messages of a 'Parse' result
--
-- @since 1.2.0.0
prefixErrorSBS
  :: forall e a. Textual e
  => SBS.ShortByteString
  -> Either SBS.ShortByteString a
  -> Either e a
prefixErrorSBS :: forall e a.
Textual e =>
ShortByteString -> Either ShortByteString a -> Either e a
prefixErrorSBS = ShortByteString -> Either ShortByteString a -> Either e a
forall e' e a.
(Monoid e', Textual e', Textual e) =>
e' -> Either e' a -> Either e a
prefixError
{-# INLINE prefixErrorSBS #-}

------------------------------------------------------------------------------
-- $ReadParsing

-- | Parse a value using a 'Read' instance
--
-- @since 0.1.0.0
parseWithRead
  :: forall t e a. (Read a, Textual t)
  => e           -- ^ invalid input error
  -> t           -- ^ textual input to parse
  -> Either e a  -- ^ error or parsed value
parseWithRead :: forall t e a. (Read a, Textual t) => e -> t -> Either e a
parseWithRead e
invalidError = Either e a -> (a -> Either e a) -> Maybe a -> Either e a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (e -> Either e a
forall a b. a -> Either a b
Left e
invalidError) a -> Either e a
forall a b. b -> Either a b
Right (Maybe a -> Either e a) -> (t -> Maybe a) -> t -> Either e a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (t -> String) -> t -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t'. Textual t' => t' -> String
toS
{-# INLINEABLE parseWithRead #-}

-- | Parse a value using a 'Read' instance with default error messages
--
-- The following English error message is returned:
--
-- * \"invalid {name}\" when the parse fails
--
-- @since 0.3.0.0
parseWithRead'
  :: forall t e a. (Read a, Textual t, Textual e)
  => String      -- ^ name to include in error messages
  -> t           -- ^ textual input to parse
  -> Either e a  -- ^ error or parsed value
parseWithRead' :: forall t e a.
(Read a, Textual t, Textual e) =>
String -> t -> Either e a
parseWithRead' String
name = e -> t -> Either e a
forall t e a. (Read a, Textual t) => e -> t -> Either e a
parseWithRead (String -> e
forall t. Textual t => String -> t
fromS (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ String
"invalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
{-# INLINEABLE parseWithRead' #-}

-- | Parse a value to a 'Maybe' result using a 'Read' instance
--
-- @since 0.3.0.0
maybeParseWithRead
  :: forall t a. (Read a, Textual t)
  => t        -- ^ textual input to parse
  -> Maybe a  -- ^ parsed value or 'Nothing' if invalid
maybeParseWithRead :: forall t a. (Read a, Textual t) => t -> Maybe a
maybeParseWithRead = String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe (String -> Maybe a) -> (t -> String) -> t -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t'. Textual t' => t' -> String
toS

------------------------------------------------------------------------------
-- $EnumParsing

-- | Parse a value in an enumeration
--
-- The 'Render' instance determines the textual values to parse from.
--
-- This function is intended to be used with types that have few choices, as
-- the implementation uses a linear algorithm.
--
-- See the @enum@ example program in the @ttc-examples@ directory of the
-- source repository.
--
-- @since 0.1.0.0
parseEnum
  :: forall t e a. (Bounded a, Enum a, Render a, Textual t)
  => Bool        -- ^ case-insensitive when 'True'
  -> Bool        -- ^ accept unique prefixes when 'True'
  -> e           -- ^ invalid input error
  -> e           -- ^ ambiguous input error
  -> t           -- ^ textual input to parse
  -> Either e a  -- ^ error or parsed value
parseEnum :: forall t e a.
(Bounded a, Enum a, Render a, Textual t) =>
Bool -> Bool -> e -> e -> t -> Either e a
parseEnum Bool
allowCI Bool
allowPrefix e
invalidError e
ambiguousError t
t =
    let t' :: Text
t' = Text -> Text
norm (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ t -> Text
forall t'. Textual t' => t' -> Text
toT t
t
    in  case [a
v | a
v <- [a
forall a. Bounded a => a
minBound ..], Text
t' Text -> Text -> Bool
`match` Text -> Text
norm (a -> Text
forall a t. (Render a, Textual t) => a -> t
forall t. Textual t => a -> t
render a
v)] of
          [a
v] -> a -> Either e a
forall a b. b -> Either a b
Right a
v
          []  -> e -> Either e a
forall a b. a -> Either a b
Left e
invalidError
          [a]
_vs -> e -> Either e a
forall a b. a -> Either a b
Left e
ambiguousError
  where
    norm :: T.Text -> T.Text
    norm :: Text -> Text
norm = if Bool
allowCI then Text -> Text
T.toLower else Text -> Text
forall a. a -> a
id

    match :: T.Text -> T.Text -> Bool
    match :: Text -> Text -> Bool
match = if Bool
allowPrefix then Text -> Text -> Bool
T.isPrefixOf else Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
(==)

-- | Parse a value in an enumeration using default error messages
--
-- The 'Render' instance determines the textual values to parse from.
--
-- The following English error messages are returned:
--
-- * \"invalid {name}\" when there are no matches
-- * \"ambiguous {name}\" when there is more than one match
--
-- This function is intended to be used with types that have few choices, as
-- the implementation uses a linear algorithm.
--
-- @since 0.4.0.0
parseEnum'
  :: forall t e a. (Bounded a, Enum a, Render a, Textual t, Textual e)
  => String      -- ^ name to include in error messages
  -> Bool        -- ^ case-insensitive when 'True'
  -> Bool        -- ^ accept unique prefixes when 'True'
  -> t           -- ^ textual input to parse
  -> Either e a  -- ^ error or parsed value
parseEnum' :: forall t e a.
(Bounded a, Enum a, Render a, Textual t, Textual e) =>
String -> Bool -> Bool -> t -> Either e a
parseEnum' String
name Bool
allowCI Bool
allowPrefix =
    Bool -> Bool -> e -> e -> t -> Either e a
forall t e a.
(Bounded a, Enum a, Render a, Textual t) =>
Bool -> Bool -> e -> e -> t -> Either e a
parseEnum
      Bool
allowCI Bool
allowPrefix
      (String -> e
forall t. Textual t => String -> t
fromS (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ String
"invalid " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
      (String -> e
forall t. Textual t => String -> t
fromS (String -> e) -> String -> e
forall a b. (a -> b) -> a -> b
$ String
"ambiguous " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
name)
{-# INLINEABLE parseEnum' #-}

------------------------------------------------------------------------------
-- $ParseSpecific
--
-- These functions are equivalent to 'parse', but they specify the textual
-- data type being parsed from.  Use them to avoid having to write type
-- annotations in cases where the type is ambiguous.  Using these functions
-- may make code easier to understand even in cases where the types are not
-- ambiguous.

-- | Parse from a 'String'
--
-- @since 0.3.0.0
parseS :: forall e a. (Parse a, Textual e) => String -> Either e a
parseS :: forall e a. (Parse a, Textual e) => String -> Either e a
parseS = String -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseS #-}

-- | Parse from strict 'T.Text'
--
-- @since 0.3.0.0
parseT :: forall e a. (Parse a, Textual e) => T.Text -> Either e a
parseT :: forall e a. (Parse a, Textual e) => Text -> Either e a
parseT = Text -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseT #-}

-- | Parse from lazy 'TL.Text'
--
-- @since 0.3.0.0
parseTL :: forall e a. (Parse a, Textual e) => TL.Text -> Either e a
parseTL :: forall e a. (Parse a, Textual e) => Text -> Either e a
parseTL = Text -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseTL #-}

-- | Parse from a @Text@ 'TLB.Builder'
--
-- @since 1.1.0.0
parseTLB :: forall e a. (Parse a, Textual e) => TLB.Builder -> Either e a
parseTLB :: forall e a. (Parse a, Textual e) => Builder -> Either e a
parseTLB = Builder -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseTLB #-}

-- | Parse from a 'ST.ShortText'
--
-- @since 1.4.0.0
parseST :: forall e a. (Parse a, Textual e) => ST.ShortText -> Either e a
parseST :: forall e a. (Parse a, Textual e) => ShortText -> Either e a
parseST = ShortText -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseST #-}

-- | Parse from a strict 'BS.ByteString'
--
-- @since 0.3.0.0
parseBS :: forall e a. (Parse a, Textual e) => BS.ByteString -> Either e a
parseBS :: forall e a. (Parse a, Textual e) => ByteString -> Either e a
parseBS = ByteString -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseBS #-}

-- | Parse from a lazy 'BSL.ByteString'
--
-- @since 0.3.0.0
parseBSL :: forall e a. (Parse a, Textual e) => BSL.ByteString -> Either e a
parseBSL :: forall e a. (Parse a, Textual e) => ByteString -> Either e a
parseBSL = ByteString -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseBSL #-}

-- | Parse from a @ByteString@ 'BSB.Builder'
--
-- @since 1.1.0.0
parseBSB :: forall e a. (Parse a, Textual e) => BSB.Builder -> Either e a
parseBSB :: forall e a. (Parse a, Textual e) => Builder -> Either e a
parseBSB = Builder -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseBSB #-}

-- | Parse from a 'SBS.ShortByteString'
--
-- @since 1.1.0.0
parseSBS
  :: forall e a. (Parse a, Textual e)
  => SBS.ShortByteString
  -> Either e a
parseSBS :: forall e a. (Parse a, Textual e) => ShortByteString -> Either e a
parseSBS = ShortByteString -> Either e a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseSBS #-}

------------------------------------------------------------------------------
-- $ParseMaybe
--
-- The 'parseMaybe' function parses to a 'Maybe' result instead of an 'Either'
-- result.
--
-- The rest of the functions are equivalent to 'parseMaybe', but they specify
-- the type being parsed from.  Use them to avoid having to write type
-- annotations in cases where the type is ambiguous.  Using these functions
-- may make code easier to understand even in cases where the types are not
-- ambiguous.

-- | Parse to a 'Maybe' result
--
-- @since 0.3.0.0
parseMaybe :: forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe :: forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe = (String -> Maybe a) -> (a -> Maybe a) -> Either String a -> Maybe a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe a -> String -> Maybe a
forall a b. a -> b -> a
const Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Either String a -> Maybe a)
-> (t -> Either String a) -> t -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Either String a
forall t a. (Parse a, Textual t) => t -> Either String a
parse'
{-# INLINE parseMaybe #-}

-- | Parse from a 'String' to a 'Maybe' result
--
-- @since 0.3.0.0
parseMaybeS :: Parse a => String -> Maybe a
parseMaybeS :: forall a. Parse a => String -> Maybe a
parseMaybeS = String -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeS #-}

-- | Parse from strict 'T.Text' to a 'Maybe' result
--
-- @since 0.3.0.0
parseMaybeT :: Parse a => T.Text -> Maybe a
parseMaybeT :: forall a. Parse a => Text -> Maybe a
parseMaybeT = Text -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeT #-}

-- | Parse from lazy 'TL.Text' to a 'Maybe' result
--
-- @since 0.3.0.0
parseMaybeTL :: Parse a => TL.Text -> Maybe a
parseMaybeTL :: forall a. Parse a => Text -> Maybe a
parseMaybeTL = Text -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeTL #-}

-- | Parse from a @Text@ 'TLB.Builder' to a 'Maybe' result
--
-- @since 1.1.0.0
parseMaybeTLB :: Parse a => TLB.Builder -> Maybe a
parseMaybeTLB :: forall a. Parse a => Builder -> Maybe a
parseMaybeTLB = Builder -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeTLB #-}

-- | Parse from a 'ST.ShortText' to a 'Maybe' result
--
-- @since 1.4.0.0
parseMaybeST :: Parse a => ST.ShortText -> Maybe a
parseMaybeST :: forall a. Parse a => ShortText -> Maybe a
parseMaybeST = ShortText -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeST #-}

-- | Parse from a strict 'BS.ByteString' to a 'Maybe' result
--
-- @since 0.3.0.0
parseMaybeBS :: Parse a => BS.ByteString -> Maybe a
parseMaybeBS :: forall a. Parse a => ByteString -> Maybe a
parseMaybeBS = ByteString -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeBS #-}

-- | Parse from a lazy 'BSL.ByteString' to a 'Maybe' result
--
-- @since 0.3.0.0
parseMaybeBSL :: Parse a => BSL.ByteString -> Maybe a
parseMaybeBSL :: forall a. Parse a => ByteString -> Maybe a
parseMaybeBSL = ByteString -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeBSL #-}

-- | Parse from a @ByteString@ 'BSB.Builder' to a 'Maybe' result
--
-- @since 1.1.0.0
parseMaybeBSB :: Parse a => BSB.Builder -> Maybe a
parseMaybeBSB :: forall a. Parse a => Builder -> Maybe a
parseMaybeBSB = Builder -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeBSB #-}

-- | Parse from a 'SBS.ShortByteString' to a 'Maybe' result
--
-- @since 1.1.0.0
parseMaybeSBS :: Parse a => SBS.ShortByteString -> Maybe a
parseMaybeSBS :: forall a. Parse a => ShortByteString -> Maybe a
parseMaybeSBS = ShortByteString -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe
{-# INLINE parseMaybeSBS #-}

------------------------------------------------------------------------------
-- $ParseOrFail
--
-- The 'parseOrFail' function fails using 'MonadFail' on error instead of
-- using an 'Either' result.
--
-- The rest of the functions are equivalent to 'parseOrFail', but they specify
-- the type being parsed from.  Use them to avoid having to write type
-- annotations in cases where the type is ambiguous.  Using these functions
-- may make code easier to understand even in cases where the types are not
-- ambiguous.

-- | Parse or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFail :: forall t a m. (MonadFail m, Parse a, Textual t) => t -> m a
parseOrFail :: forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail = (String -> m a) -> (a -> m a) -> Either String a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> m a
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> m a
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either String a -> m a) -> (t -> Either String a) -> t -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Either String a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseOrFail #-}

-- | Parse from a 'String' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailS :: forall a m. (MonadFail m, Parse a) => String -> m a
parseOrFailS :: forall a (m :: * -> *). (MonadFail m, Parse a) => String -> m a
parseOrFailS = String -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailS #-}

-- | Parse from strict 'T.Text' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailT :: forall a m. (MonadFail m, Parse a) => T.Text -> m a
parseOrFailT :: forall a (m :: * -> *). (MonadFail m, Parse a) => Text -> m a
parseOrFailT = Text -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailT #-}

-- | Parse from lazy 'TL.Text' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailTL :: forall a m. (MonadFail m, Parse a) => TL.Text -> m a
parseOrFailTL :: forall a (m :: * -> *). (MonadFail m, Parse a) => Text -> m a
parseOrFailTL = Text -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailTL #-}

-- | Parse from a @Text@ 'TLB.Builder' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailTLB :: forall a m. (MonadFail m, Parse a) => TLB.Builder -> m a
parseOrFailTLB :: forall a (m :: * -> *). (MonadFail m, Parse a) => Builder -> m a
parseOrFailTLB = Builder -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailTLB #-}

-- | Parse from a 'ST.ShortText' or fail using 'MonadFail'
--
-- @since 1.4.0.0
parseOrFailST :: forall a m. (MonadFail m, Parse a) => ST.ShortText -> m a
parseOrFailST :: forall a (m :: * -> *). (MonadFail m, Parse a) => ShortText -> m a
parseOrFailST = ShortText -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailST #-}

-- | Parse from a strict 'BS.ByteString' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailBS :: forall a m. (MonadFail m, Parse a) => BS.ByteString -> m a
parseOrFailBS :: forall a (m :: * -> *). (MonadFail m, Parse a) => ByteString -> m a
parseOrFailBS = ByteString -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailBS #-}

-- | Parse from a lazy 'BSL.ByteString' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailBSL :: forall a m. (MonadFail m, Parse a) => BSL.ByteString -> m a
parseOrFailBSL :: forall a (m :: * -> *). (MonadFail m, Parse a) => ByteString -> m a
parseOrFailBSL = ByteString -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailBSL #-}

-- | Parse from a @ByteString@ 'BSB.Builder' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailBSB :: forall a m. (MonadFail m, Parse a) => BSB.Builder -> m a
parseOrFailBSB :: forall a (m :: * -> *). (MonadFail m, Parse a) => Builder -> m a
parseOrFailBSB = Builder -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailBSB #-}

-- | Parse from a 'SBS.ShortByteString' or fail using 'MonadFail'
--
-- @since 1.3.0.0
parseOrFailSBS
  :: forall a m. (MonadFail m, Parse a)
  => SBS.ShortByteString
  -> m a
parseOrFailSBS :: forall a (m :: * -> *).
(MonadFail m, Parse a) =>
ShortByteString -> m a
parseOrFailSBS = ShortByteString -> m a
forall t a (m :: * -> *).
(MonadFail m, Parse a, Textual t) =>
t -> m a
parseOrFail
{-# INLINE parseOrFailSBS #-}

------------------------------------------------------------------------------
-- $ParseUnsafe
--
-- The 'parseUnsafe' function raises an exception on error instead of using an
-- 'Either' result.  It should only be used when an error is not possible.
--
-- The rest of the functions are equivalent to 'parseUnsafe', but they specify
-- the type being parsed from.  Use them to avoid having to write type
-- annotations in cases where the type is ambiguous.  Using these functions
-- may make code easier to understand even in cases where the types are not
-- ambiguous.

-- | Parse or raise an exception
--
-- @since 0.1.0.0
parseUnsafe :: forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe :: forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe = (String -> a) -> (a -> a) -> Either String a -> a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> (String -> String) -> String -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"parseUnsafe: " String -> String -> String
forall a. [a] -> [a] -> [a]
++)) a -> a
forall a. a -> a
id (Either String a -> a) -> (t -> Either String a) -> t -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> Either String a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse
{-# INLINE parseUnsafe #-}

-- | Parse from a 'String' or raise an exception
--
-- @since 0.1.0.0
parseUnsafeS :: (HasCallStack, Parse a) => String -> a
parseUnsafeS :: forall a. (HasCallStack, Parse a) => String -> a
parseUnsafeS = String -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeS #-}

-- | Parse from strict 'T.Text' or raise an exception
--
-- @since 0.1.0.0
parseUnsafeT :: (HasCallStack, Parse a) => T.Text -> a
parseUnsafeT :: forall a. (HasCallStack, Parse a) => Text -> a
parseUnsafeT = Text -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeT #-}

-- | Parse from lazy 'TL.Text' or raise an exception
--
-- @since 0.1.0.0
parseUnsafeTL :: (HasCallStack, Parse a) => TL.Text -> a
parseUnsafeTL :: forall a. (HasCallStack, Parse a) => Text -> a
parseUnsafeTL = Text -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeTL #-}

-- | Parse from a @Text@ 'TLB.Builder' or raise an exception
--
-- @since 1.1.0.0
parseUnsafeTLB :: (HasCallStack, Parse a) => TLB.Builder -> a
parseUnsafeTLB :: forall a. (HasCallStack, Parse a) => Builder -> a
parseUnsafeTLB = Builder -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeTLB #-}

-- | Parse from a 'ST.ShortText' or raise an exception
--
-- @since 1.4.0.0
parseUnsafeST :: (HasCallStack, Parse a) => ST.ShortText -> a
parseUnsafeST :: forall a. (HasCallStack, Parse a) => ShortText -> a
parseUnsafeST = ShortText -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeST #-}

-- | Parse from a strict 'BS.ByteString' or raise an exception
--
-- @since 0.1.0.0
parseUnsafeBS :: (HasCallStack, Parse a) => BS.ByteString -> a
parseUnsafeBS :: forall a. (HasCallStack, Parse a) => ByteString -> a
parseUnsafeBS = ByteString -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeBS #-}

-- | Parse from a lazy 'BSL.ByteString' or raise an exception
--
-- @since 0.1.0.0
parseUnsafeBSL :: (HasCallStack, Parse a) => BSL.ByteString -> a
parseUnsafeBSL :: forall a. (HasCallStack, Parse a) => ByteString -> a
parseUnsafeBSL = ByteString -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeBSL #-}

-- | Parse from a @ByteString@ 'BSB.Builder' or raise an exception
--
-- @since 1.1.0.0
parseUnsafeBSB :: (HasCallStack, Parse a) => BSB.Builder -> a
parseUnsafeBSB :: forall a. (HasCallStack, Parse a) => Builder -> a
parseUnsafeBSB = Builder -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeBSB #-}

-- | Parse from a 'SBS.ShortByteString' or raise an exception
--
-- @since 1.1.0.0
parseUnsafeSBS :: (HasCallStack, Parse a) => SBS.ShortByteString -> a
parseUnsafeSBS :: forall a. (HasCallStack, Parse a) => ShortByteString -> a
parseUnsafeSBS = ShortByteString -> a
forall t a. (HasCallStack, Parse a, Textual t) => t -> a
parseUnsafe
{-# INLINE parseUnsafeSBS #-}

------------------------------------------------------------------------------
-- $ReadSInstances

-- | Implement 'ReadS' using a 'Parse' instance
--
-- This implementation expects all of the input to be consumed.
--
-- @since 0.3.0.0
readsWithParse
  :: Parse a
  => ReadS a
readsWithParse :: forall a. Parse a => ReadS a
readsWithParse String
s = case String -> Maybe a
forall t a. (Parse a, Textual t) => t -> Maybe a
parseMaybe String
s of
    Just a
v  -> [(a
v, String
"")]
    Maybe a
Nothing -> []
{-# INLINEABLE readsWithParse #-}

-- | Implement 'ReadS' using 'parseEnum'
--
-- This implementation expects all of the input to be consumed.
--
-- @since 0.1.0.0
readsEnum
  :: (Bounded a, Enum a, Render a)
  => Bool  -- ^ case-insensitive when 'True'
  -> Bool  -- ^ accept unique prefixes when 'True'
  -> ReadS a
readsEnum :: forall a. (Bounded a, Enum a, Render a) => Bool -> Bool -> ReadS a
readsEnum Bool
allowCI Bool
allowPrefix String
s =
    case Bool -> Bool -> () -> () -> String -> Either () a
forall t e a.
(Bounded a, Enum a, Render a, Textual t) =>
Bool -> Bool -> e -> e -> t -> Either e a
parseEnum Bool
allowCI Bool
allowPrefix () () String
s of
      Right a
v -> [(a
v, String
"")]
      Left{}  -> []
{-# INLINEABLE readsEnum #-}

------------------------------------------------------------------------------
-- $ConstantValidation
--
-- The follow functions provide a number of ways to use a 'Parse' instance to
-- validate constants at compile-time.
--
-- If you can use Template Haskell typed expressions in your project, use
-- 'valid', 'mkValid', or 'validOf'.  Use 'valid' to define constants for
-- types that have a 'THS.Lift' instance.  For types that do not have a
-- 'THS.Lift' instance, use 'mkValid' to define a validation function for that
-- type using a 'Proxy', or use 'validOf' to pass the 'Proxy' when defining
-- constants.
--
-- Typed expressions were not supported in @haskell-src-exts <1.22.0@, which
-- causes problems with old versions of @hlint@.  If the issue affects you,
-- you may use 'mkUntypedValid', 'mkUntypedValidQQ', or 'untypedValidOf'
-- instead of the above functions.  Use 'mkUntypedValid' to define a
-- validation function for a type using a 'Proxy', or use 'untypedValidOf' to
-- pass the 'Proxy' when defining constants.  Alternatively, use
-- 'mkUntypedValidQQ' to define a validation quasi-quoter.
--
-- For more details, see the following article:
-- <https://www.extrema.is/articles/ttc-textual-type-classes/validated-constants>

-- | Validate a constant at compile-time using a 'Parse' instance
--
-- This function parses the 'String' at compile-time and fails compilation on
-- error.  When valid, the result is compiled in, so the result type must have
-- a 'THS.Lift' instance.  When this is inconvenient, use one of the
-- alternative functions in this library.
--
-- This function uses a Template Haskell typed expression.  Typed expressions
-- were not supported in @haskell-src-exts <1.22.0@, which causes problems
-- with old versions of @hlint@.  If the issue affects you, use
-- @hlint -i "Parse error"@ to ignore parse errors or use one of the
-- alternative functions in this library.
--
-- Note that the typed Template Haskell API changed in GHC 9.  The type
-- displayed in this documentation is determined by the version of GHC used to
-- build the documentation.
--
-- The type of this function in GHC 9 or later is as follows:
--
-- @
-- valid
--   :: (MonadFail m, THS.Quote m, Parse a, THS.Lift a)
--   => String
--   -> THS.Code m a
-- @
--
-- The type of this function in previous versions of GHC is as follows:
--
-- @
-- valid
--   :: (Parse a, THS.Lift a)
--   => String
--   -> TH.Q (TH.TExp a)
-- @
--
-- This function is used the same way in all GHC versions.  See the @valid@
-- and @invalid@ example programs in the @ttc-examples@ directory of the
-- source repository.  The following is example usage from the @valid@
-- example:
--
-- @
-- sample :: Username
-- sample = $$(TTC.valid "tcard")
-- @
--
-- @since 0.1.0.0
#if __GLASGOW_HASKELL__ >= 900
valid
  :: (MonadFail m, THS.Quote m, Parse a, THS.Lift a)
  => String
  -> THS.Code m a
valid :: forall (m :: * -> *) a.
(MonadFail m, Quote m, Parse a, Lift a) =>
String -> Code m a
valid String
s = case String -> Either String a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse String
s of
    Right a
x -> [|| a
x ||]
    Left String
err -> m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
THS.Code (m (TExp a) -> Code m a)
-> (String -> m (TExp a)) -> String -> Code m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (TExp a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Code m a) -> String -> Code m a
forall a b. (a -> b) -> a -> b
$ String
"Invalid constant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
#else
valid
  :: (Parse a, THS.Lift a)
  => String
  -> TH.Q (TH.TExp a)
valid s = case parse s of
    Right x -> [|| x ||]
    Left err -> fail $ "Invalid constant: " ++ err
#endif

-- | This instance enables use of 'valid' without having to type @valid@.  The
-- [OverloadedStrings](https://ghc.gitlab.haskell.org/ghc/doc/users_guide/exts/overloaded_strings.html)
-- extension must be enabled in the module where this functionality is used.
-- Note that this reduces the number of characters in the code, but it can
-- also make the code more difficult to understand by somebody who is not
-- already familiar with it.  Typing @valid@ gives people a way to investigate
-- and understand what is going on.
--
-- Note that the typed Template Haskell API changed in GHC 9.  The type
-- displayed in this documentation is determined by the version of GHC used to
-- build the documentation.
--
-- The type of this instance in GHC 9 or later is as follows:
--
-- @
-- (MonadFail m, THS.Quote m, Parse a, THS.Lift a) => IsString (THS.Code m a)
-- @
--
-- The type of this instance in previous versions of GHC is as follows:
--
-- @
-- (Parse a, THS.Lift a) => IsString (TH.Q (TH.TExp a))
-- @
--
-- This functionality can be used as follows in all supported versions of GHC.
-- The following is example usage from the @valid@ example:
--
-- @
-- sample2 :: Username
-- sample2 = $$("alice")
-- @
--
-- The parenthesis are not required from GHC 9.  The following is example
-- usage from the @valid@ example:
--
-- @
-- sample2 :: Username
-- sample2 = $$"alice"
-- @
--
-- @since 1.3.0.0
#if __GLASGOW_HASKELL__ >= 900
instance (MonadFail m, THS.Quote m, Parse a, THS.Lift a)
    => IsString (THS.Code m a) where
  fromString :: String -> Code m a
fromString = String -> Code m a
forall (m :: * -> *) a.
(MonadFail m, Quote m, Parse a, Lift a) =>
String -> Code m a
valid
#else
instance (Parse a, THS.Lift a) => IsString (TH.Q (TH.TExp a)) where
  fromString = valid
#endif

-- | Validate a constant at compile-time using a 'Parse' instance
--
-- This function requires a 'Proxy' of the result type.  Use 'mkValid' to
-- avoid having to pass a 'Proxy' during constant definition.
--
-- This function parses the 'String' at compile-time and fails compilation on
-- error.  When valid, the 'String' is compiled in, to be parsed again at
-- run-time.  Since the result is not compiled in, no 'THS.Lift' instance is
-- required.
--
-- This function uses a Template Haskell typed expression.  Typed expressions
-- were not supported in @haskell-src-exts <1.22.0@, which causes problems
-- with old versions of @hlint@.  If the issue affects you, use
-- @hlint -i "Parse error"@ to ignore parse errors or use 'untypedValidOf'
-- instead.
--
-- Note that the typed Template Haskell API changed in GHC 9.  The type
-- displayed in this documentation is determined by the version of GHC used to
-- build the documentation.
--
-- The type of this function in GHC 9 or later is as follows:
--
-- @
-- validOf
--   :: (MonadFail m, THS.Quote m, Parse a)
--   => Proxy a
--   -> String
--   -> THS.Code m a
-- @
--
-- The type of this function in previous versions of GHC is as follows:
--
-- @
-- validOf
--   :: Parse a
--   => Proxy a
--   -> String
--   -> TH.Q (TH.TExp a)
-- @
--
-- This function is used the same way in all GHC versions.  See the @validof@
-- example program in the @ttc-examples@ directory of the source repository.
-- The following is example usage from the @validof@ example:
--
-- @
-- sample :: Username
-- sample = $$(TTC.validOf (Proxy :: Proxy Username) "tcard")
-- @
--
-- @since 0.1.0.0
#if __GLASGOW_HASKELL__ >= 900
validOf
  :: (MonadFail m, THS.Quote m, Parse a)
  => Proxy a
  -> String
  -> THS.Code m a
validOf :: forall (m :: * -> *) a.
(MonadFail m, Quote m, Parse a) =>
Proxy a -> String -> Code m a
validOf Proxy a
proxy String
s = case (a -> Proxy a -> a
forall a (proxy :: * -> *). a -> proxy a -> a
`asProxyTypeOf` Proxy a
proxy) (a -> a) -> Either String a -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse String
s of
    Right{} -> [|| String -> a
forall a. (HasCallStack, Parse a) => String -> a
parseUnsafeS String
s ||]
    Left String
err -> m (TExp a) -> Code m a
forall (m :: * -> *) a. m (TExp a) -> Code m a
THS.Code (m (TExp a) -> Code m a)
-> (String -> m (TExp a)) -> String -> Code m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> m (TExp a)
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Code m a) -> String -> Code m a
forall a b. (a -> b) -> a -> b
$ String
"Invalid constant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err
#else
validOf
  :: Parse a
  => Proxy a
  -> String
  -> TH.Q (TH.TExp a)
validOf proxy s = case (`asProxyTypeOf` proxy) <$> parse s of
    Right{} -> [|| parseUnsafeS s ||]
    Left err -> fail $ "Invalid constant: " ++ err
#endif

-- | Make a @valid@ function using 'validOf' for the given type
--
-- Create a @valid@ function for a type in order to avoid having to write a
-- 'Proxy' when defining constants.
--
-- This function uses a Template Haskell typed expression.  Typed expressions
-- were not supported in @haskell-src-exts <1.22.0@, which causes problems
-- with old versions of @hlint@.  If the issue affects you, use
-- @hlint -i "Parse error"@ to ignore parse errors or use 'mkUntypedValid'
-- instead.
--
-- Note that the typed Template Haskell API changed in GHC 9.  The type
-- displayed in this documentation is determined by the version of GHC used to
-- build the documentation.
--
-- The type of the created @valid@ function in GHC 9 or later is as follows:
--
-- @
-- \$funName
--   :: forall m. (MonadFail m, THS.Quote m)
--   => String
--   -> THS.Code m $resultType
-- @
--
-- The type of the created @valid@ function in previous versions of GHC is as
-- follows:
--
-- @
-- \$funName
--   :: String
--   -> TH.Q (TH.TExp $resultType)
-- @
--
-- This function is used the same way in all GHC versions.  See the @mkvalid@
-- example program in the @ttc-examples@ directory of the source repository.
-- The following is example usage from the @mkvalid@ example:
--
-- @
-- \$(TTC.mkValid "valid" ''Username)
-- @
--
-- The created @valid@ function can then be used as follows:
--
-- @
-- sample :: Username
-- sample = $$(Username.valid "tcard")
-- @
--
-- @since 0.1.0.0
mkValid
  :: String
  -> TH.Name
  -> TH.DecsQ
mkValid :: String -> Name -> DecsQ
mkValid String
funName Name
typeName = do
    let funName' :: Name
funName' = String -> Name
TH.mkName String
funName
        resultType :: Q Type
resultType = Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
TH.ConT Name
typeName
#if __GLASGOW_HASKELL__ >= 900
    Type
funType <-
      [t|
        forall m . (MonadFail m, THS.Quote m) =>
          String -> THS.Code m $Q Type
resultType
        |]
#else
    funType <- [t| String -> TH.Q (TH.TExp $resultType) |]
#endif
    Exp
body <- [| validOf (Proxy :: Proxy $Q Type
resultType) |]
    [Dec] -> DecsQ
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return
      [ Name -> Type -> Dec
TH.SigD Name
funName' Type
funType
      , Name -> [Clause] -> Dec
TH.FunD Name
funName' [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [] (Exp -> Body
TH.NormalB Exp
body) []]
      ]

-- | Validate a constant at compile-time using a 'Parse' instance
--
-- This function requires a 'Proxy' of the result type.  Use 'mkUntypedValid'
-- to avoid having to pass a 'Proxy' during constant definition.
--
-- This function parses the 'String' at compile-time and fails compilation on
-- error.  When valid, the 'String' is compiled in, to be parsed again at
-- run-time.  Since the result is not compiled in, no 'THS.Lift' instance is
-- required.
--
-- See the @uvalidof@ example program in the @ttc-examples@ directory of the
-- source repository.  The following is example usage from the @uvalidof@
-- example:
--
-- @
-- sample :: Username
-- sample = $(TTC.untypedValidOf (Proxy :: Proxy Username) "tcard")
-- @
--
-- @since 0.2.0.0
untypedValidOf
  :: Parse a
  => Proxy a
  -> String
  -> TH.ExpQ
untypedValidOf :: forall a. Parse a => Proxy a -> String -> Q Exp
untypedValidOf Proxy a
proxy String
s = case (a -> Proxy a -> a
forall a (proxy :: * -> *). a -> proxy a -> a
`asProxyTypeOf` Proxy a
proxy) (a -> a) -> Either String a -> Either String a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Either String a
forall a t e. (Parse a, Textual t, Textual e) => t -> Either e a
forall t e. (Textual t, Textual e) => t -> Either e a
parse String
s of
    Right{} -> [| parseUnsafeS s |]
    Left String
err -> String -> Q Exp
forall a. String -> Q a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp) -> String -> Q Exp
forall a b. (a -> b) -> a -> b
$ String
"Invalid constant: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
err

-- | Make a @valid@ function using 'untypedValidOf' for the given type
--
-- Create a @valid@ function for a type in order to avoid having to write a
-- 'Proxy' when defining constants.
--
-- See the @mkuvalid@ example program in the @ttc-examples@ directory of the
-- source repository.  The following is example usage from the @mkuvalid@
-- example:
--
-- @
-- \$(TTC.mkUntypedValid "valid" ''Username)
-- @
--
-- The created @valid@ function can then be used as follows:
--
-- @
-- sample :: Username
-- sample = $(Username.valid "tcard")
-- @
--
-- @since 0.2.0.0
mkUntypedValid
  :: String
  -> TH.Name
  -> TH.DecsQ
mkUntypedValid :: String -> Name -> DecsQ
mkUntypedValid String
funName Name
typeName = do
    let funName' :: Name
funName' = String -> Name
TH.mkName String
funName
        resultType :: Q Type
resultType = Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
TH.ConT Name
typeName
    Type
funType <- [t| String -> TH.ExpQ |]
    Exp
body <- [| untypedValidOf (Proxy :: Proxy $Q Type
resultType) |]
    [Dec] -> DecsQ
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return
      [ Name -> Type -> Dec
TH.SigD Name
funName' Type
funType
      , Name -> [Clause] -> Dec
TH.FunD Name
funName' [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [] (Exp -> Body
TH.NormalB Exp
body) []]
      ]

-- | Make a @valid@ quasi-quoter using 'untypedValidOf' for the given type
--
-- See the @mkuvalidqq@ example program in the @ttc-examples@ directory of the
-- source repository.  The following is example usage from the @mkuvalidqq@
-- example:
--
-- @
-- \$(TTC.mkUntypedValidQQ "valid" ''Username)
-- @
--
-- The created @valid@ function can then be used as follows:
--
-- @
-- sample :: Username
-- sample = [Username.valid|tcard|]
-- @
--
-- @since 0.2.0.0
mkUntypedValidQQ
  :: String
  -> TH.Name
  -> TH.DecsQ
mkUntypedValidQQ :: String -> Name -> DecsQ
mkUntypedValidQQ String
funName Name
typeName = do
    let funName' :: Name
funName' = String -> Name
TH.mkName String
funName
        resultType :: Q Type
resultType = Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
TH.ConT Name
typeName
    Exp
expE <- [| untypedValidOf (Proxy :: Proxy $Q Type
resultType) |]
    Exp
expP <- [| error "pattern not supported" |]
    Exp
expT <- [| error "type not supported" |]
    Exp
expD <- [| error "declaration not supported" |]
    let body :: Body
body = Exp -> Body
TH.NormalB (Exp -> Body) -> Exp -> Body
forall a b. (a -> b) -> a -> b
$ Name -> [FieldExp] -> Exp
TH.RecConE 'Q.QuasiQuoter
          [ ('Q.quoteExp, Exp
expE)
          , ('Q.quotePat, Exp
expP)
          , ('Q.quoteType, Exp
expT)
          , ('Q.quoteDec, Exp
expD)
          ]
    [Dec] -> DecsQ
forall a. a -> Q a
forall (m :: * -> *) a. Monad m => a -> m a
return
      [ Name -> Type -> Dec
TH.SigD Name
funName' (Type -> Dec) -> Type -> Dec
forall a b. (a -> b) -> a -> b
$ Name -> Type
TH.ConT ''Q.QuasiQuoter
      , Name -> [Clause] -> Dec
TH.FunD Name
funName' [[Pat] -> Body -> [Dec] -> Clause
TH.Clause [] Body
body []]
      ]

------------------------------------------------------------------------------
-- $DefaultInstances
--
-- These Template Haskell functions provide an easy way to load default
-- 'Render' and 'Parse' instances for common types.  See the documentation for
-- 'Render' and 'Parse' for details about default instances.  Remember that
-- loading such default instances should be avoided in libraries.

-- | Load the default 'Render' instance for a type
--
-- Example:
--
-- @
-- TTC.defaultRenderInstance ''Int
-- @
--
-- @since 1.5.0.0
defaultRenderInstance :: TH.Name -> TH.DecsQ
defaultRenderInstance :: Name -> DecsQ
defaultRenderInstance Name
typeName =
    let a :: Q Type
a = Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
TH.ConT Name
typeName
    in  [d| instance Render $Q Type
a |]

-- | Load the default 'Render' instances for any number of types
--
-- Example:
--
-- @
-- TTC.defaultRenderInstances [''Int, ''Int8, ''Int16, ''Int32, ''Int64]
-- @
--
-- @since 1.5.0.0
defaultRenderInstances :: [TH.Name] -> TH.DecsQ
defaultRenderInstances :: [Name] -> DecsQ
defaultRenderInstances = ([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> DecsQ) -> ([Name] -> Q [[Dec]]) -> [Name] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> DecsQ) -> [Name] -> Q [[Dec]]
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) -> [a] -> m [b]
mapM Name -> DecsQ
defaultRenderInstance

-- | Load the default 'Parse' instance for a type
--
-- Example:
--
-- @
-- TTC.defaultParseInstance ''Int
-- @
--
-- @since 1.5.0.0
defaultParseInstance :: TH.Name -> TH.DecsQ
defaultParseInstance :: Name -> DecsQ
defaultParseInstance Name
typeName =
    let a :: Q Type
a = Type -> Q Type
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Type -> Q Type) -> Type -> Q Type
forall a b. (a -> b) -> a -> b
$ Name -> Type
TH.ConT Name
typeName
    in  [d| instance Parse $Q Type
a |]

-- | Load the default 'Parse' instances for any number of types
--
-- Example:
--
-- @
-- TTC.defaultParseInstances [''Int, ''Int8, ''Int16, ''Int32, ''Int64]
-- @
--
-- @since 1.5.0.0
defaultParseInstances :: [TH.Name] -> TH.DecsQ
defaultParseInstances :: [Name] -> DecsQ
defaultParseInstances = ([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> DecsQ) -> ([Name] -> Q [[Dec]]) -> [Name] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> DecsQ) -> [Name] -> Q [[Dec]]
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) -> [a] -> m [b]
mapM Name -> DecsQ
defaultParseInstance

-- | Load the default 'Render' and 'Parse' instance for a type
--
-- Example:
--
-- @
-- TTC.defaultRenderAndParseInstance ''Int
-- @
--
-- @since 1.5.0.0
defaultRenderAndParseInstance :: TH.Name -> TH.DecsQ
defaultRenderAndParseInstance :: Name -> DecsQ
defaultRenderAndParseInstance Name
typeName = do
    -- NOTE This function is implemented this way for compatibility with old
    -- versions of GHC/base.
    [Dec]
renderDecs <- Name -> DecsQ
defaultRenderInstance Name
typeName
    [Dec]
parseDecs <- Name -> DecsQ
defaultParseInstance Name
typeName
    [Dec] -> DecsQ
forall a. a -> Q a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Dec] -> DecsQ) -> [Dec] -> DecsQ
forall a b. (a -> b) -> a -> b
$ [Dec]
renderDecs [Dec] -> [Dec] -> [Dec]
forall a. [a] -> [a] -> [a]
++ [Dec]
parseDecs

-- | Load the default 'Render' and 'Parse' instances for any number of types
--
-- Example:
--
-- @
-- TTC.defaultRenderAndParseInstances
--   [''Int, ''Int8, ''Int16, ''Int32, ''Int64]
-- @
--
-- @since 1.5.0.0
defaultRenderAndParseInstances :: [TH.Name] -> TH.DecsQ
defaultRenderAndParseInstances :: [Name] -> DecsQ
defaultRenderAndParseInstances =
    ([[Dec]] -> [Dec]) -> Q [[Dec]] -> DecsQ
forall a b. (a -> b) -> Q a -> Q b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Dec]] -> [Dec]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (Q [[Dec]] -> DecsQ) -> ([Name] -> Q [[Dec]]) -> [Name] -> DecsQ
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Name -> DecsQ) -> [Name] -> Q [[Dec]]
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) -> [a] -> m [b]
mapM Name -> DecsQ
defaultRenderAndParseInstance