{-# LANGUAGE CPP #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE ExplicitForAll #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TemplateHaskell #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Data.TTC
(
Textual
, convert
, toS
, toT
, toTL
, toTLB
, toST
, toBS
, toBSL
, toBSB
, toSBS
, fromS
, fromT
, fromTL
, fromTLB
, fromST
, fromBS
, fromBSL
, fromBSB
, fromSBS
, asS
, asT
, asTL
, asTLB
, asST
, asBS
, asBSL
, asBSB
, asSBS
, Render(..)
, RenderDefault(..)
, renderWithShow
, renderS
, renderT
, renderTL
, renderTLB
, renderST
, renderBS
, renderBSL
, renderBSB
, renderSBS
, Parse(..)
, ParseDefault(..)
, withError
, withErrorS
, withErrorT
, withErrorTL
, withErrorTLB
, withErrorST
, withErrorBS
, withErrorBSL
, withErrorBSB
, withErrorSBS
, prefixError
, prefixErrorS
, prefixErrorT
, prefixErrorTL
, prefixErrorTLB
, prefixErrorST
, prefixErrorBS
, prefixErrorBSL
, prefixErrorBSB
, prefixErrorSBS
, parseWithRead
, parseWithRead'
, maybeParseWithRead
, parseEnum
, parseEnum'
, parseS
, parseT
, parseTL
, parseTLB
, parseST
, parseBS
, parseBSL
, parseBSB
, parseSBS
, parseMaybe
, parseMaybeS
, parseMaybeT
, parseMaybeTL
, parseMaybeTLB
, parseMaybeST
, parseMaybeBS
, parseMaybeBSL
, parseMaybeBSB
, parseMaybeSBS
, parseOrFail
, parseOrFailS
, parseOrFailT
, parseOrFailTL
, parseOrFailTLB
, parseOrFailST
, parseOrFailBS
, parseOrFailBSL
, parseOrFailBSB
, parseOrFailSBS
, parseUnsafe
, parseUnsafeS
, parseUnsafeT
, parseUnsafeTL
, parseUnsafeTLB
, parseUnsafeST
, parseUnsafeBS
, parseUnsafeBSL
, parseUnsafeBSB
, parseUnsafeSBS
, readsWithParse
, readsEnum
, valid
, validOf
, mkValid
, untypedValidOf
, mkUntypedValid
, mkUntypedValidQQ
, defaultRenderInstance
, defaultRenderInstances
, defaultParseInstance
, defaultParseInstances
, defaultRenderAndParseInstance
, defaultRenderAndParseInstances
) where
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)
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
import qualified Language.Haskell.TH as TH
import qualified Language.Haskell.TH.Quote as Q
import qualified Language.Haskell.TH.Syntax as THS
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
import qualified Data.Text.Short as ST
class Textual t where
toS :: t -> String
toT :: t -> T.Text
toTL :: t -> TL.Text
toTLB :: t -> TLB.Builder
toST :: t -> ST.ShortText
toBS :: t -> BS.ByteString
toBSL :: t -> BSL.ByteString
toBSB :: t -> BSB.Builder
toSBS :: t -> SBS.ShortByteString
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 :: 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
class Render a where
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
class RenderDefault a where
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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
class Parse a where
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
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' #-}
class ParseDefault a where
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
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
parseWithRead
:: forall t e a. (Read a, Textual t)
=> e
-> t
-> Either e a
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 #-}
parseWithRead'
:: forall t e a. (Read a, Textual t, Textual e)
=> String
-> t
-> Either e a
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' #-}
maybeParseWithRead
:: forall t a. (Read a, Textual t)
=> t
-> Maybe a
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
parseEnum
:: forall t e a. (Bounded a, Enum a, Render a, Textual t)
=> Bool
-> Bool
-> e
-> e
-> t
-> Either e a
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
(==)
parseEnum'
:: forall t e a. (Bounded a, Enum a, Render a, Textual t, Textual e)
=> String
-> Bool
-> Bool
-> t
-> Either e a
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' #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 :: 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 :: 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 :: 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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
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 #-}
readsEnum
:: (Bounded a, Enum a, Render a)
=> Bool
-> Bool
-> 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 #-}
#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
#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
#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
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) []]
]
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
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) []]
]
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 []]
]
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 |]
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
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 |]
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
defaultRenderAndParseInstance :: TH.Name -> TH.DecsQ
defaultRenderAndParseInstance :: Name -> DecsQ
defaultRenderAndParseInstance Name
typeName = do
[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
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