module Data.TTC.Wrapper
(
WrapperS(..)
, WrapperT(..)
, WrapperTL(..)
, WrapperTLB(..)
, WrapperST(..)
, WrapperBS(..)
, WrapperBSL(..)
, WrapperBSB(..)
, WrapperSBS(..)
) where
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 Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TLB
import qualified Data.Text.Short as ST
import qualified Data.TTC as TTC
newtype WrapperS = WrapperS { WrapperS -> String
unWrapperS :: String }
instance TTC.Parse WrapperS where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperS
parse = (String -> Either e WrapperS) -> t -> Either e WrapperS
forall t a. Textual t => (String -> a) -> t -> a
TTC.asS ((String -> Either e WrapperS) -> t -> Either e WrapperS)
-> (String -> Either e WrapperS) -> t -> Either e WrapperS
forall a b. (a -> b) -> a -> b
$ WrapperS -> Either e WrapperS
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperS -> Either e WrapperS)
-> (String -> WrapperS) -> String -> Either e WrapperS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> WrapperS
WrapperS
instance TTC.Render WrapperS where
render :: forall t. Textual t => WrapperS -> t
render = String -> t
forall t. Textual t => String -> t
TTC.fromS (String -> t) -> (WrapperS -> String) -> WrapperS -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperS -> String
unWrapperS
newtype WrapperT = WrapperT { WrapperT -> Text
unWrapperT :: T.Text }
instance TTC.Parse WrapperT where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperT
parse = (Text -> Either e WrapperT) -> t -> Either e WrapperT
forall t a. Textual t => (Text -> a) -> t -> a
TTC.asT ((Text -> Either e WrapperT) -> t -> Either e WrapperT)
-> (Text -> Either e WrapperT) -> t -> Either e WrapperT
forall a b. (a -> b) -> a -> b
$ WrapperT -> Either e WrapperT
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperT -> Either e WrapperT)
-> (Text -> WrapperT) -> Text -> Either e WrapperT
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WrapperT
WrapperT
instance TTC.Render WrapperT where
render :: forall t. Textual t => WrapperT -> t
render = Text -> t
forall t. Textual t => Text -> t
TTC.fromT (Text -> t) -> (WrapperT -> Text) -> WrapperT -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperT -> Text
unWrapperT
newtype WrapperTL = WrapperTL { WrapperTL -> Text
unWrapperTL :: TL.Text }
instance TTC.Parse WrapperTL where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperTL
parse = (Text -> Either e WrapperTL) -> t -> Either e WrapperTL
forall t a. Textual t => (Text -> a) -> t -> a
TTC.asTL ((Text -> Either e WrapperTL) -> t -> Either e WrapperTL)
-> (Text -> Either e WrapperTL) -> t -> Either e WrapperTL
forall a b. (a -> b) -> a -> b
$ WrapperTL -> Either e WrapperTL
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperTL -> Either e WrapperTL)
-> (Text -> WrapperTL) -> Text -> Either e WrapperTL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> WrapperTL
WrapperTL
instance TTC.Render WrapperTL where
render :: forall t. Textual t => WrapperTL -> t
render = Text -> t
forall t. Textual t => Text -> t
TTC.fromTL (Text -> t) -> (WrapperTL -> Text) -> WrapperTL -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperTL -> Text
unWrapperTL
newtype WrapperTLB = WrapperTLB { WrapperTLB -> Builder
unWrapperTLB :: TLB.Builder }
instance TTC.Parse WrapperTLB where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperTLB
parse = (Builder -> Either e WrapperTLB) -> t -> Either e WrapperTLB
forall t a. Textual t => (Builder -> a) -> t -> a
TTC.asTLB ((Builder -> Either e WrapperTLB) -> t -> Either e WrapperTLB)
-> (Builder -> Either e WrapperTLB) -> t -> Either e WrapperTLB
forall a b. (a -> b) -> a -> b
$ WrapperTLB -> Either e WrapperTLB
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperTLB -> Either e WrapperTLB)
-> (Builder -> WrapperTLB) -> Builder -> Either e WrapperTLB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WrapperTLB
WrapperTLB
instance TTC.Render WrapperTLB where
render :: forall t. Textual t => WrapperTLB -> t
render = Builder -> t
forall t. Textual t => Builder -> t
TTC.fromTLB (Builder -> t) -> (WrapperTLB -> Builder) -> WrapperTLB -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperTLB -> Builder
unWrapperTLB
newtype WrapperST = WrapperST { WrapperST -> ShortText
unWrapperST :: ST.ShortText }
instance TTC.Parse WrapperST where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperST
parse = (ShortText -> Either e WrapperST) -> t -> Either e WrapperST
forall t a. Textual t => (ShortText -> a) -> t -> a
TTC.asST ((ShortText -> Either e WrapperST) -> t -> Either e WrapperST)
-> (ShortText -> Either e WrapperST) -> t -> Either e WrapperST
forall a b. (a -> b) -> a -> b
$ WrapperST -> Either e WrapperST
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperST -> Either e WrapperST)
-> (ShortText -> WrapperST) -> ShortText -> Either e WrapperST
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> WrapperST
WrapperST
instance TTC.Render WrapperST where
render :: forall t. Textual t => WrapperST -> t
render = ShortText -> t
forall t. Textual t => ShortText -> t
TTC.fromST (ShortText -> t) -> (WrapperST -> ShortText) -> WrapperST -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperST -> ShortText
unWrapperST
newtype WrapperBS = WrapperBS { WrapperBS -> ByteString
unWrapperBS :: BS.ByteString }
instance TTC.Parse WrapperBS where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperBS
parse = (ByteString -> Either e WrapperBS) -> t -> Either e WrapperBS
forall t a. Textual t => (ByteString -> a) -> t -> a
TTC.asBS ((ByteString -> Either e WrapperBS) -> t -> Either e WrapperBS)
-> (ByteString -> Either e WrapperBS) -> t -> Either e WrapperBS
forall a b. (a -> b) -> a -> b
$ WrapperBS -> Either e WrapperBS
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperBS -> Either e WrapperBS)
-> (ByteString -> WrapperBS) -> ByteString -> Either e WrapperBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> WrapperBS
WrapperBS
instance TTC.Render WrapperBS where
render :: forall t. Textual t => WrapperBS -> t
render = ByteString -> t
forall t. Textual t => ByteString -> t
TTC.fromBS (ByteString -> t) -> (WrapperBS -> ByteString) -> WrapperBS -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperBS -> ByteString
unWrapperBS
newtype WrapperBSL = WrapperBSL { WrapperBSL -> ByteString
unWrapperBSL :: BSL.ByteString }
instance TTC.Parse WrapperBSL where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperBSL
parse = (ByteString -> Either e WrapperBSL) -> t -> Either e WrapperBSL
forall t a. Textual t => (ByteString -> a) -> t -> a
TTC.asBSL ((ByteString -> Either e WrapperBSL) -> t -> Either e WrapperBSL)
-> (ByteString -> Either e WrapperBSL) -> t -> Either e WrapperBSL
forall a b. (a -> b) -> a -> b
$ WrapperBSL -> Either e WrapperBSL
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperBSL -> Either e WrapperBSL)
-> (ByteString -> WrapperBSL) -> ByteString -> Either e WrapperBSL
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> WrapperBSL
WrapperBSL
instance TTC.Render WrapperBSL where
render :: forall t. Textual t => WrapperBSL -> t
render = ByteString -> t
forall t. Textual t => ByteString -> t
TTC.fromBSL (ByteString -> t) -> (WrapperBSL -> ByteString) -> WrapperBSL -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperBSL -> ByteString
unWrapperBSL
newtype WrapperBSB = WrapperBSB { WrapperBSB -> Builder
unWrapperBSB :: BSB.Builder }
instance TTC.Parse WrapperBSB where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperBSB
parse = (Builder -> Either e WrapperBSB) -> t -> Either e WrapperBSB
forall t a. Textual t => (Builder -> a) -> t -> a
TTC.asBSB ((Builder -> Either e WrapperBSB) -> t -> Either e WrapperBSB)
-> (Builder -> Either e WrapperBSB) -> t -> Either e WrapperBSB
forall a b. (a -> b) -> a -> b
$ WrapperBSB -> Either e WrapperBSB
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperBSB -> Either e WrapperBSB)
-> (Builder -> WrapperBSB) -> Builder -> Either e WrapperBSB
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> WrapperBSB
WrapperBSB
instance TTC.Render WrapperBSB where
render :: forall t. Textual t => WrapperBSB -> t
render = Builder -> t
forall t. Textual t => Builder -> t
TTC.fromBSB (Builder -> t) -> (WrapperBSB -> Builder) -> WrapperBSB -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperBSB -> Builder
unWrapperBSB
newtype WrapperSBS = WrapperSBS { WrapperSBS -> ShortByteString
unWrapperSBS :: SBS.ShortByteString }
instance TTC.Parse WrapperSBS where
parse :: forall t e. (Textual t, Textual e) => t -> Either e WrapperSBS
parse = (ShortByteString -> Either e WrapperSBS)
-> t -> Either e WrapperSBS
forall t a. Textual t => (ShortByteString -> a) -> t -> a
TTC.asSBS ((ShortByteString -> Either e WrapperSBS)
-> t -> Either e WrapperSBS)
-> (ShortByteString -> Either e WrapperSBS)
-> t
-> Either e WrapperSBS
forall a b. (a -> b) -> a -> b
$ WrapperSBS -> Either e WrapperSBS
forall a. a -> Either e a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (WrapperSBS -> Either e WrapperSBS)
-> (ShortByteString -> WrapperSBS)
-> ShortByteString
-> Either e WrapperSBS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortByteString -> WrapperSBS
WrapperSBS
instance TTC.Render WrapperSBS where
render :: forall t. Textual t => WrapperSBS -> t
render = ShortByteString -> t
forall t. Textual t => ShortByteString -> t
TTC.fromSBS (ShortByteString -> t)
-> (WrapperSBS -> ShortByteString) -> WrapperSBS -> t
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WrapperSBS -> ShortByteString
unWrapperSBS