{-# LANGUAGE CPP                        #-}
{-# LANGUAGE DataKinds                  #-}
{-# LANGUAGE DeriveDataTypeable         #-}
{-# LANGUAGE DeriveFoldable             #-}
{-# LANGUAGE DeriveFunctor              #-}
{-# LANGUAGE DeriveGeneric              #-}
{-# LANGUAGE DeriveTraversable          #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures             #-}
{-# LANGUAGE PolyKinds                  #-}
{-# LANGUAGE ScopedTypeVariables        #-}
{-# LANGUAGE StandaloneDeriving         #-}
{-# LANGUAGE TemplateHaskell            #-}
{-# LANGUAGE TypeFamilies               #-}

#if __GLASGOW_HASKELL__ >= 800
{-# LANGUAGE DeriveLift                 #-}
#endif

{-# OPTIONS_GHC -fno-warn-name-shadowing #-}

{-|
Module:      TextShow.FromStringTextShow
Copyright:   (C) 2014-2017 Ryan Scott
License:     BSD-style (see the file LICENSE)
Maintainer:  Ryan Scott
Stability:   Provisional
Portability: GHC

The 'FromStringShow' and 'FromTextShow' data types.
-}
module TextShow.FromStringTextShow (
      FromStringShow(..)
    , FromTextShow(..)
    , FromStringShow1(..)
    , FromTextShow1(..)
    , FromStringShow2(..)
    , FromTextShow2(..)
    ) where

#include "generic.h"

import           Data.Bifunctor.TH (deriveBifunctor, deriveBifoldable,
                                    deriveBitraversable)
import           Data.Coerce (coerce)
import           Data.Data (Data, Typeable)
import           Data.Functor.Classes (Show1(..), showsPrec1)

#if !defined(__LANGUAGE_DERIVE_GENERIC1__)
import qualified Generics.Deriving.TH as Generics
#endif

import           GHC.Generics (Generic, Generic1)

import           Language.Haskell.TH.Lift

import           Prelude ()
import           Prelude.Compat

import           Text.ParserCombinators.ReadPrec (ReadPrec)
import           Text.Read (Read(..))

import           TextShow.Classes (TextShow(..), TextShow1(..), TextShow2(..),
                                   showbPrec1, showbPrec2,
                                   showbPrecToShowsPrec, showsPrecToShowbPrec,
                                   showbToShows, showsToShowb)

#if defined(NEW_FUNCTOR_CLASSES)
import           Data.Functor.Classes (Show2(..), showsPrec2)
#else
import           Text.Show (showListWith)
#endif

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

-- | An adapter newtype, suitable for @DerivingVia@.
-- The 'TextShow' instance for 'FromStringShow' is based on its @String@
-- 'Show' instance. That is,
--
-- @
-- showbPrec p ('FromStringShow' x) = 'showsToShowb' 'showsPrec' p x
-- @
--
-- /Since: 2/
newtype FromStringShow a = FromStringShow { forall a. FromStringShow a -> a
fromStringShow :: a }
  deriving ( FromStringShow a -> DataType
FromStringShow a -> Constr
forall {a}. Data a => Typeable (FromStringShow a)
forall a. Data a => FromStringShow a -> DataType
forall a. Data a => FromStringShow a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b)
-> FromStringShow a -> FromStringShow a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FromStringShow a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> FromStringShow a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromStringShow a -> c (FromStringShow a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromStringShow a -> c (FromStringShow a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> FromStringShow a -> m (FromStringShow a)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromStringShow a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FromStringShow a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FromStringShow a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> FromStringShow a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow a -> r
gmapT :: (forall b. Data b => b -> b)
-> FromStringShow a -> FromStringShow a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b)
-> FromStringShow a -> FromStringShow a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow a))
dataTypeOf :: FromStringShow a -> DataType
$cdataTypeOf :: forall a. Data a => FromStringShow a -> DataType
toConstr :: FromStringShow a -> Constr
$ctoConstr :: forall a. Data a => FromStringShow a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromStringShow a -> c (FromStringShow a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromStringShow a -> c (FromStringShow a)
Data
           , FromStringShow a -> FromStringShow a -> Bool
forall a. Eq a => FromStringShow a -> FromStringShow a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromStringShow a -> FromStringShow a -> Bool
$c/= :: forall a. Eq a => FromStringShow a -> FromStringShow a -> Bool
== :: FromStringShow a -> FromStringShow a -> Bool
$c== :: forall a. Eq a => FromStringShow a -> FromStringShow a -> Bool
Eq
           , forall a. Eq a => a -> FromStringShow a -> Bool
forall a. Num a => FromStringShow a -> a
forall a. Ord a => FromStringShow a -> a
forall m. Monoid m => FromStringShow m -> m
forall a. FromStringShow a -> Bool
forall a. FromStringShow a -> Int
forall a. FromStringShow a -> [a]
forall a. (a -> a -> a) -> FromStringShow a -> a
forall m a. Monoid m => (a -> m) -> FromStringShow a -> m
forall b a. (b -> a -> b) -> b -> FromStringShow a -> b
forall a b. (a -> b -> b) -> b -> FromStringShow a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FromStringShow a -> a
$cproduct :: forall a. Num a => FromStringShow a -> a
sum :: forall a. Num a => FromStringShow a -> a
$csum :: forall a. Num a => FromStringShow a -> a
minimum :: forall a. Ord a => FromStringShow a -> a
$cminimum :: forall a. Ord a => FromStringShow a -> a
maximum :: forall a. Ord a => FromStringShow a -> a
$cmaximum :: forall a. Ord a => FromStringShow a -> a
elem :: forall a. Eq a => a -> FromStringShow a -> Bool
$celem :: forall a. Eq a => a -> FromStringShow a -> Bool
length :: forall a. FromStringShow a -> Int
$clength :: forall a. FromStringShow a -> Int
null :: forall a. FromStringShow a -> Bool
$cnull :: forall a. FromStringShow a -> Bool
toList :: forall a. FromStringShow a -> [a]
$ctoList :: forall a. FromStringShow a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FromStringShow a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FromStringShow a -> a
foldr1 :: forall a. (a -> a -> a) -> FromStringShow a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FromStringShow a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FromStringShow a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FromStringShow a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromStringShow a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FromStringShow a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromStringShow a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FromStringShow a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromStringShow a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FromStringShow a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FromStringShow a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FromStringShow a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromStringShow a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FromStringShow a -> m
fold :: forall m. Monoid m => FromStringShow m -> m
$cfold :: forall m. Monoid m => FromStringShow m -> m
Foldable
           , forall a b. a -> FromStringShow b -> FromStringShow a
forall a b. (a -> b) -> FromStringShow a -> FromStringShow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FromStringShow b -> FromStringShow a
$c<$ :: forall a b. a -> FromStringShow b -> FromStringShow a
fmap :: forall a b. (a -> b) -> FromStringShow a -> FromStringShow b
$cfmap :: forall a b. (a -> b) -> FromStringShow a -> FromStringShow b
Functor
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FromStringShow a) x -> FromStringShow a
forall a x. FromStringShow a -> Rep (FromStringShow a) x
$cto :: forall a x. Rep (FromStringShow a) x -> FromStringShow a
$cfrom :: forall a x. FromStringShow a -> Rep (FromStringShow a) x
Generic
           , forall a. Rep1 FromStringShow a -> FromStringShow a
forall a. FromStringShow a -> Rep1 FromStringShow a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 FromStringShow a -> FromStringShow a
$cfrom1 :: forall a. FromStringShow a -> Rep1 FromStringShow a
Generic1
#if __GLASGOW_HASKELL__ >= 800
           , forall a (m :: * -> *).
(Lift a, Quote m) =>
FromStringShow a -> m Exp
forall a (m :: * -> *).
(Lift a, Quote m) =>
FromStringShow a -> Code m (FromStringShow a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FromStringShow a -> m Exp
forall (m :: * -> *).
Quote m =>
FromStringShow a -> Code m (FromStringShow a)
liftTyped :: forall (m :: * -> *).
Quote m =>
FromStringShow a -> Code m (FromStringShow a)
$cliftTyped :: forall a (m :: * -> *).
(Lift a, Quote m) =>
FromStringShow a -> Code m (FromStringShow a)
lift :: forall (m :: * -> *). Quote m => FromStringShow a -> m Exp
$clift :: forall a (m :: * -> *).
(Lift a, Quote m) =>
FromStringShow a -> m Exp
Lift
#endif
           , FromStringShow a -> FromStringShow a -> Bool
FromStringShow a -> FromStringShow a -> Ordering
FromStringShow a -> FromStringShow a -> FromStringShow a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (FromStringShow a)
forall a. Ord a => FromStringShow a -> FromStringShow a -> Bool
forall a. Ord a => FromStringShow a -> FromStringShow a -> Ordering
forall a.
Ord a =>
FromStringShow a -> FromStringShow a -> FromStringShow a
min :: FromStringShow a -> FromStringShow a -> FromStringShow a
$cmin :: forall a.
Ord a =>
FromStringShow a -> FromStringShow a -> FromStringShow a
max :: FromStringShow a -> FromStringShow a -> FromStringShow a
$cmax :: forall a.
Ord a =>
FromStringShow a -> FromStringShow a -> FromStringShow a
>= :: FromStringShow a -> FromStringShow a -> Bool
$c>= :: forall a. Ord a => FromStringShow a -> FromStringShow a -> Bool
> :: FromStringShow a -> FromStringShow a -> Bool
$c> :: forall a. Ord a => FromStringShow a -> FromStringShow a -> Bool
<= :: FromStringShow a -> FromStringShow a -> Bool
$c<= :: forall a. Ord a => FromStringShow a -> FromStringShow a -> Bool
< :: FromStringShow a -> FromStringShow a -> Bool
$c< :: forall a. Ord a => FromStringShow a -> FromStringShow a -> Bool
compare :: FromStringShow a -> FromStringShow a -> Ordering
$ccompare :: forall a. Ord a => FromStringShow a -> FromStringShow a -> Ordering
Ord
           , Functor FromStringShow
Foldable FromStringShow
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FromStringShow (m a) -> m (FromStringShow a)
forall (f :: * -> *) a.
Applicative f =>
FromStringShow (f a) -> f (FromStringShow a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromStringShow a -> m (FromStringShow b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow a -> f (FromStringShow b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FromStringShow (m a) -> m (FromStringShow a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FromStringShow (m a) -> m (FromStringShow a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromStringShow a -> m (FromStringShow b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromStringShow a -> m (FromStringShow b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromStringShow (f a) -> f (FromStringShow a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromStringShow (f a) -> f (FromStringShow a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow a -> f (FromStringShow b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow a -> f (FromStringShow b)
Traversable
           , Typeable
           )

instance Read a => Read (FromStringShow a) where
    readPrec :: ReadPrec (FromStringShow a)
readPrec     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec a
readPrec     :: ReadPrec a)
    readsPrec :: Int -> ReadS (FromStringShow a)
readsPrec    = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS a)
    readList :: ReadS [FromStringShow a]
readList     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadS [a]
readList     :: ReadS [a])
    readListPrec :: ReadPrec [FromStringShow a]
readListPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [a])

instance Show a => TextShow (FromStringShow a) where
    showbPrec :: Int -> FromStringShow a -> Builder
showbPrec Int
p = forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec forall a. Show a => Int -> a -> ShowS
showsPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromStringShow a -> a
fromStringShow
    showb :: FromStringShow a -> Builder
showb = forall a. (a -> ShowS) -> a -> Builder
showsToShowb forall a. Show a => a -> ShowS
shows forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromStringShow a -> a
fromStringShow
    showbList :: [FromStringShow a] -> Builder
showbList [FromStringShow a]
l = forall a. (a -> ShowS) -> a -> Builder
showsToShowb forall a. Show a => [a] -> ShowS
showList (coerce :: forall a b. Coercible a b => a -> b
coerce [FromStringShow a]
l :: [a])

instance Show a => Show (FromStringShow a) where
    showsPrec :: Int -> FromStringShow a -> ShowS
showsPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Show a => Int -> a -> ShowS
showsPrec :: Int -> a -> ShowS)
    show :: FromStringShow a -> String
show      = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Show a => a -> String
show      :: a -> String)
    showList :: [FromStringShow a] -> ShowS
showList  = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Show a => [a] -> ShowS
showList  :: [a] -> ShowS)

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

-- | An adapter newtype, suitable for @DerivingVia@.
-- The @String@ 'Show' instance for 'FromTextShow' is based on its
-- 'TextShow' instance. That is,
--
-- @
-- showsPrec p ('FromTextShow' x) = 'showbToShows' 'showbPrec' p x
-- @
--
-- /Since: 2/
newtype FromTextShow a = FromTextShow { forall a. FromTextShow a -> a
fromTextShow :: a }
  deriving ( FromTextShow a -> DataType
FromTextShow a -> Constr
forall {a}. Data a => Typeable (FromTextShow a)
forall a. Data a => FromTextShow a -> DataType
forall a. Data a => FromTextShow a -> Constr
forall a.
Data a =>
(forall b. Data b => b -> b) -> FromTextShow a -> FromTextShow a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FromTextShow a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> FromTextShow a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromTextShow a -> c (FromTextShow a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow a))
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromTextShow a -> c (FromTextShow a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow a))
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> FromTextShow a -> m (FromTextShow a)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromTextShow a -> u
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> FromTextShow a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FromTextShow a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> FromTextShow a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow a -> r
gmapT :: (forall b. Data b => b -> b) -> FromTextShow a -> FromTextShow a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> FromTextShow a -> FromTextShow a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow a))
dataTypeOf :: FromTextShow a -> DataType
$cdataTypeOf :: forall a. Data a => FromTextShow a -> DataType
toConstr :: FromTextShow a -> Constr
$ctoConstr :: forall a. Data a => FromTextShow a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromTextShow a -> c (FromTextShow a)
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FromTextShow a -> c (FromTextShow a)
Data
           , FromTextShow a -> FromTextShow a -> Bool
forall a. Eq a => FromTextShow a -> FromTextShow a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FromTextShow a -> FromTextShow a -> Bool
$c/= :: forall a. Eq a => FromTextShow a -> FromTextShow a -> Bool
== :: FromTextShow a -> FromTextShow a -> Bool
$c== :: forall a. Eq a => FromTextShow a -> FromTextShow a -> Bool
Eq
           , forall a. Eq a => a -> FromTextShow a -> Bool
forall a. Num a => FromTextShow a -> a
forall a. Ord a => FromTextShow a -> a
forall m. Monoid m => FromTextShow m -> m
forall a. FromTextShow a -> Bool
forall a. FromTextShow a -> Int
forall a. FromTextShow a -> [a]
forall a. (a -> a -> a) -> FromTextShow a -> a
forall m a. Monoid m => (a -> m) -> FromTextShow a -> m
forall b a. (b -> a -> b) -> b -> FromTextShow a -> b
forall a b. (a -> b -> b) -> b -> FromTextShow a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FromTextShow a -> a
$cproduct :: forall a. Num a => FromTextShow a -> a
sum :: forall a. Num a => FromTextShow a -> a
$csum :: forall a. Num a => FromTextShow a -> a
minimum :: forall a. Ord a => FromTextShow a -> a
$cminimum :: forall a. Ord a => FromTextShow a -> a
maximum :: forall a. Ord a => FromTextShow a -> a
$cmaximum :: forall a. Ord a => FromTextShow a -> a
elem :: forall a. Eq a => a -> FromTextShow a -> Bool
$celem :: forall a. Eq a => a -> FromTextShow a -> Bool
length :: forall a. FromTextShow a -> Int
$clength :: forall a. FromTextShow a -> Int
null :: forall a. FromTextShow a -> Bool
$cnull :: forall a. FromTextShow a -> Bool
toList :: forall a. FromTextShow a -> [a]
$ctoList :: forall a. FromTextShow a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FromTextShow a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> FromTextShow a -> a
foldr1 :: forall a. (a -> a -> a) -> FromTextShow a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> FromTextShow a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FromTextShow a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> FromTextShow a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromTextShow a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> FromTextShow a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromTextShow a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> FromTextShow a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromTextShow a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> FromTextShow a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FromTextShow a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> FromTextShow a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromTextShow a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> FromTextShow a -> m
fold :: forall m. Monoid m => FromTextShow m -> m
$cfold :: forall m. Monoid m => FromTextShow m -> m
Foldable
           , forall a b. a -> FromTextShow b -> FromTextShow a
forall a b. (a -> b) -> FromTextShow a -> FromTextShow b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FromTextShow b -> FromTextShow a
$c<$ :: forall a b. a -> FromTextShow b -> FromTextShow a
fmap :: forall a b. (a -> b) -> FromTextShow a -> FromTextShow b
$cfmap :: forall a b. (a -> b) -> FromTextShow a -> FromTextShow b
Functor
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (FromTextShow a) x -> FromTextShow a
forall a x. FromTextShow a -> Rep (FromTextShow a) x
$cto :: forall a x. Rep (FromTextShow a) x -> FromTextShow a
$cfrom :: forall a x. FromTextShow a -> Rep (FromTextShow a) x
Generic
           , forall a. Rep1 FromTextShow a -> FromTextShow a
forall a. FromTextShow a -> Rep1 FromTextShow a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 FromTextShow a -> FromTextShow a
$cfrom1 :: forall a. FromTextShow a -> Rep1 FromTextShow a
Generic1
#if __GLASGOW_HASKELL__ >= 800
           , forall a (m :: * -> *).
(Lift a, Quote m) =>
FromTextShow a -> m Exp
forall a (m :: * -> *).
(Lift a, Quote m) =>
FromTextShow a -> Code m (FromTextShow a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FromTextShow a -> m Exp
forall (m :: * -> *).
Quote m =>
FromTextShow a -> Code m (FromTextShow a)
liftTyped :: forall (m :: * -> *).
Quote m =>
FromTextShow a -> Code m (FromTextShow a)
$cliftTyped :: forall a (m :: * -> *).
(Lift a, Quote m) =>
FromTextShow a -> Code m (FromTextShow a)
lift :: forall (m :: * -> *). Quote m => FromTextShow a -> m Exp
$clift :: forall a (m :: * -> *).
(Lift a, Quote m) =>
FromTextShow a -> m Exp
Lift
#endif
           , FromTextShow a -> FromTextShow a -> Bool
FromTextShow a -> FromTextShow a -> Ordering
FromTextShow a -> FromTextShow a -> FromTextShow a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {a}. Ord a => Eq (FromTextShow a)
forall a. Ord a => FromTextShow a -> FromTextShow a -> Bool
forall a. Ord a => FromTextShow a -> FromTextShow a -> Ordering
forall a.
Ord a =>
FromTextShow a -> FromTextShow a -> FromTextShow a
min :: FromTextShow a -> FromTextShow a -> FromTextShow a
$cmin :: forall a.
Ord a =>
FromTextShow a -> FromTextShow a -> FromTextShow a
max :: FromTextShow a -> FromTextShow a -> FromTextShow a
$cmax :: forall a.
Ord a =>
FromTextShow a -> FromTextShow a -> FromTextShow a
>= :: FromTextShow a -> FromTextShow a -> Bool
$c>= :: forall a. Ord a => FromTextShow a -> FromTextShow a -> Bool
> :: FromTextShow a -> FromTextShow a -> Bool
$c> :: forall a. Ord a => FromTextShow a -> FromTextShow a -> Bool
<= :: FromTextShow a -> FromTextShow a -> Bool
$c<= :: forall a. Ord a => FromTextShow a -> FromTextShow a -> Bool
< :: FromTextShow a -> FromTextShow a -> Bool
$c< :: forall a. Ord a => FromTextShow a -> FromTextShow a -> Bool
compare :: FromTextShow a -> FromTextShow a -> Ordering
$ccompare :: forall a. Ord a => FromTextShow a -> FromTextShow a -> Ordering
Ord
           , Int -> FromTextShow a -> Builder
Int -> FromTextShow a -> Text
Int -> FromTextShow a -> Text
[FromTextShow a] -> Builder
[FromTextShow a] -> Text
[FromTextShow a] -> Text
FromTextShow a -> Builder
FromTextShow a -> Text
FromTextShow a -> Text
forall a. TextShow a => Int -> FromTextShow a -> Builder
forall a. TextShow a => Int -> FromTextShow a -> Text
forall a. TextShow a => Int -> FromTextShow a -> Text
forall a. TextShow a => [FromTextShow a] -> Builder
forall a. TextShow a => [FromTextShow a] -> Text
forall a. TextShow a => [FromTextShow a] -> Text
forall a. TextShow a => FromTextShow a -> Builder
forall a. TextShow a => FromTextShow a -> Text
forall a. TextShow a => FromTextShow a -> Text
forall a.
(Int -> a -> Builder)
-> (a -> Builder)
-> ([a] -> Builder)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> (Int -> a -> Text)
-> (a -> Text)
-> ([a] -> Text)
-> TextShow a
showtlList :: [FromTextShow a] -> Text
$cshowtlList :: forall a. TextShow a => [FromTextShow a] -> Text
showtl :: FromTextShow a -> Text
$cshowtl :: forall a. TextShow a => FromTextShow a -> Text
showtlPrec :: Int -> FromTextShow a -> Text
$cshowtlPrec :: forall a. TextShow a => Int -> FromTextShow a -> Text
showtList :: [FromTextShow a] -> Text
$cshowtList :: forall a. TextShow a => [FromTextShow a] -> Text
showt :: FromTextShow a -> Text
$cshowt :: forall a. TextShow a => FromTextShow a -> Text
showtPrec :: Int -> FromTextShow a -> Text
$cshowtPrec :: forall a. TextShow a => Int -> FromTextShow a -> Text
showbList :: [FromTextShow a] -> Builder
$cshowbList :: forall a. TextShow a => [FromTextShow a] -> Builder
showb :: FromTextShow a -> Builder
$cshowb :: forall a. TextShow a => FromTextShow a -> Builder
showbPrec :: Int -> FromTextShow a -> Builder
$cshowbPrec :: forall a. TextShow a => Int -> FromTextShow a -> Builder
TextShow
           , Functor FromTextShow
Foldable FromTextShow
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
FromTextShow (m a) -> m (FromTextShow a)
forall (f :: * -> *) a.
Applicative f =>
FromTextShow (f a) -> f (FromTextShow a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromTextShow a -> m (FromTextShow b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow a -> f (FromTextShow b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FromTextShow (m a) -> m (FromTextShow a)
$csequence :: forall (m :: * -> *) a.
Monad m =>
FromTextShow (m a) -> m (FromTextShow a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromTextShow a -> m (FromTextShow b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromTextShow a -> m (FromTextShow b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromTextShow (f a) -> f (FromTextShow a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromTextShow (f a) -> f (FromTextShow a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow a -> f (FromTextShow b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow a -> f (FromTextShow b)
Traversable
           , Typeable
           )

instance Read a => Read (FromTextShow a) where
    readPrec :: ReadPrec (FromTextShow a)
readPrec     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec a
readPrec     :: ReadPrec a)
    readsPrec :: Int -> ReadS (FromTextShow a)
readsPrec    = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS a)
    readList :: ReadS [FromTextShow a]
readList     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadS [a]
readList     :: ReadS [a])
    readListPrec :: ReadPrec [FromTextShow a]
readListPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [a])

instance TextShow a => Show (FromTextShow a) where
    showsPrec :: Int -> FromTextShow a -> ShowS
showsPrec Int
p = forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec forall a. TextShow a => Int -> a -> Builder
showbPrec Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. FromTextShow a -> a
fromTextShow
    show :: FromTextShow a -> String
show (FromTextShow a
x) = forall a. (a -> Builder) -> a -> ShowS
showbToShows forall a. TextShow a => a -> Builder
showb a
x String
""
    showList :: [FromTextShow a] -> ShowS
showList [FromTextShow a]
l = forall a. (a -> Builder) -> a -> ShowS
showbToShows forall a. TextShow a => [a] -> Builder
showbList (coerce :: forall a b. Coercible a b => a -> b
coerce [FromTextShow a]
l :: [a])

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

-- | An adapter newtype, suitable for @DerivingVia@.
-- The 'TextShow1' instance for 'FromStringShow1' is based on its @String@
-- 'Show1' instance. That is,
--
-- @
-- 'liftShowbPrec' sp sl p ('FromStringShow1' x) =
--     'showsPrecToShowbPrec' ('liftShowsPrec' ('showbPrecToShowsPrec' sp)
--                                             ('showbToShows'         sl))
--                            p x
-- @
--
-- /Since: 3/
newtype FromStringShow1 f a = FromStringShow1 { forall {k} (f :: k -> *) (a :: k). FromStringShow1 f a -> f a
fromStringShow1 :: f a }
  deriving ( FromStringShow1 f a -> FromStringShow1 f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
/= :: FromStringShow1 f a -> FromStringShow1 f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
== :: FromStringShow1 f a -> FromStringShow1 f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
Eq
           , FromStringShow1 f a -> FromStringShow1 f a -> Bool
FromStringShow1 f a -> FromStringShow1 f a -> Ordering
FromStringShow1 f a -> FromStringShow1 f a -> FromStringShow1 f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {f :: k -> *} {a :: k}.
Ord (f a) =>
Eq (FromStringShow1 f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> FromStringShow1 f a
min :: FromStringShow1 f a -> FromStringShow1 f a -> FromStringShow1 f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> FromStringShow1 f a
max :: FromStringShow1 f a -> FromStringShow1 f a -> FromStringShow1 f a
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> FromStringShow1 f a
>= :: FromStringShow1 f a -> FromStringShow1 f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
> :: FromStringShow1 f a -> FromStringShow1 f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
<= :: FromStringShow1 f a -> FromStringShow1 f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
< :: FromStringShow1 f a -> FromStringShow1 f a -> Bool
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Bool
compare :: FromStringShow1 f a -> FromStringShow1 f a -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromStringShow1 f a -> FromStringShow1 f a -> Ordering
Ord
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) (a :: k) x.
Rep (FromStringShow1 f a) x -> FromStringShow1 f a
forall k (f :: k -> *) (a :: k) x.
FromStringShow1 f a -> Rep (FromStringShow1 f a) x
$cto :: forall k (f :: k -> *) (a :: k) x.
Rep (FromStringShow1 f a) x -> FromStringShow1 f a
$cfrom :: forall k (f :: k -> *) (a :: k) x.
FromStringShow1 f a -> Rep (FromStringShow1 f a) x
Generic
#if defined(__LANGUAGE_DERIVE_GENERIC1__)
           , forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall k (f :: k -> *) (a :: k).
Rep1 (FromStringShow1 f) a -> FromStringShow1 f a
forall k (f :: k -> *) (a :: k).
FromStringShow1 f a -> Rep1 (FromStringShow1 f) a
$cto1 :: forall k (f :: k -> *) (a :: k).
Rep1 (FromStringShow1 f) a -> FromStringShow1 f a
$cfrom1 :: forall k (f :: k -> *) (a :: k).
FromStringShow1 f a -> Rep1 (FromStringShow1 f) a
Generic1
#endif
#if __GLASGOW_HASKELL__ >= 800
           , FromStringShow1 f a -> DataType
FromStringShow1 f a -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {k} {f :: k -> *} {a :: k}.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
Typeable (FromStringShow1 f a)
forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromStringShow1 f a -> DataType
forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromStringShow1 f a -> Constr
forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b. Data b => b -> b)
-> FromStringShow1 f a -> FromStringShow1 f a
forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
Int -> (forall d. Data d => d -> u) -> FromStringShow1 f a -> u
forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d. Data d => d -> u) -> FromStringShow1 f a -> [u]
forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow1 f a -> r
forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow1 f a -> r
forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Monad m) =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow1 f a)
forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow1 f a
-> c (FromStringShow1 f a)
forall k (f :: k -> *) (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow1 f a))
forall k (f :: k -> *) (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow1 f a))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow1 f a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow1 f a
-> c (FromStringShow1 f a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
$cgmapMo :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
$cgmapMp :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
$cgmapM :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Monad m) =>
(forall d. Data d => d -> m d)
-> FromStringShow1 f a -> m (FromStringShow1 f a)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromStringShow1 f a -> u
$cgmapQi :: forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
Int -> (forall d. Data d => d -> u) -> FromStringShow1 f a -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FromStringShow1 f a -> [u]
$cgmapQ :: forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d. Data d => d -> u) -> FromStringShow1 f a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow1 f a -> r
$cgmapQr :: forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow1 f a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow1 f a -> r
$cgmapQl :: forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow1 f a -> r
gmapT :: (forall b. Data b => b -> b)
-> FromStringShow1 f a -> FromStringShow1 f a
$cgmapT :: forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b. Data b => b -> b)
-> FromStringShow1 f a -> FromStringShow1 f a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow1 f a))
$cdataCast2 :: forall k (f :: k -> *) (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow1 f a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow1 f a))
$cdataCast1 :: forall k (f :: k -> *) (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow1 f a))
dataTypeOf :: FromStringShow1 f a -> DataType
$cdataTypeOf :: forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromStringShow1 f a -> DataType
toConstr :: FromStringShow1 f a -> Constr
$ctoConstr :: forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromStringShow1 f a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow1 f a)
$cgunfold :: forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow1 f a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow1 f a
-> c (FromStringShow1 f a)
$cgfoldl :: forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow1 f a
-> c (FromStringShow1 f a)
Data
           , forall a. Eq a => a -> FromStringShow1 f a -> Bool
forall a. Num a => FromStringShow1 f a -> a
forall a. Ord a => FromStringShow1 f a -> a
forall m. Monoid m => FromStringShow1 f m -> m
forall a. FromStringShow1 f a -> Bool
forall a. FromStringShow1 f a -> Int
forall a. FromStringShow1 f a -> [a]
forall a. (a -> a -> a) -> FromStringShow1 f a -> a
forall m a. Monoid m => (a -> m) -> FromStringShow1 f a -> m
forall b a. (b -> a -> b) -> b -> FromStringShow1 f a -> b
forall a b. (a -> b -> b) -> b -> FromStringShow1 f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromStringShow1 f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromStringShow1 f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromStringShow1 f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromStringShow1 f m -> m
forall (f :: * -> *) a. Foldable f => FromStringShow1 f a -> Bool
forall (f :: * -> *) a. Foldable f => FromStringShow1 f a -> Int
forall (f :: * -> *) a. Foldable f => FromStringShow1 f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromStringShow1 f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromStringShow1 f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromStringShow1 f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromStringShow1 f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FromStringShow1 f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromStringShow1 f a -> a
sum :: forall a. Num a => FromStringShow1 f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromStringShow1 f a -> a
minimum :: forall a. Ord a => FromStringShow1 f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromStringShow1 f a -> a
maximum :: forall a. Ord a => FromStringShow1 f a -> a
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromStringShow1 f a -> a
elem :: forall a. Eq a => a -> FromStringShow1 f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromStringShow1 f a -> Bool
length :: forall a. FromStringShow1 f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => FromStringShow1 f a -> Int
null :: forall a. FromStringShow1 f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => FromStringShow1 f a -> Bool
toList :: forall a. FromStringShow1 f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => FromStringShow1 f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FromStringShow1 f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromStringShow1 f a -> a
foldr1 :: forall a. (a -> a -> a) -> FromStringShow1 f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromStringShow1 f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FromStringShow1 f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromStringShow1 f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromStringShow1 f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromStringShow1 f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromStringShow1 f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromStringShow1 f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromStringShow1 f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromStringShow1 f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FromStringShow1 f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromStringShow1 f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromStringShow1 f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromStringShow1 f a -> m
fold :: forall m. Monoid m => FromStringShow1 f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromStringShow1 f m -> m
Foldable
           , forall a b. a -> FromStringShow1 f b -> FromStringShow1 f a
forall a b. (a -> b) -> FromStringShow1 f a -> FromStringShow1 f b
forall (f :: * -> *) a b.
Functor f =>
a -> FromStringShow1 f b -> FromStringShow1 f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> FromStringShow1 f a -> FromStringShow1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FromStringShow1 f b -> FromStringShow1 f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> FromStringShow1 f b -> FromStringShow1 f a
fmap :: forall a b. (a -> b) -> FromStringShow1 f a -> FromStringShow1 f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> FromStringShow1 f a -> FromStringShow1 f b
Functor
           , forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromStringShow1 f a -> m Exp
forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromStringShow1 f a -> Code m (FromStringShow1 f a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FromStringShow1 f a -> m Exp
forall (m :: * -> *).
Quote m =>
FromStringShow1 f a -> Code m (FromStringShow1 f a)
liftTyped :: forall (m :: * -> *).
Quote m =>
FromStringShow1 f a -> Code m (FromStringShow1 f a)
$cliftTyped :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromStringShow1 f a -> Code m (FromStringShow1 f a)
lift :: forall (m :: * -> *). Quote m => FromStringShow1 f a -> m Exp
$clift :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromStringShow1 f a -> m Exp
Lift
           , forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromStringShow1 f a -> ShowS
forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromStringShow1 f a] -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromStringShow1 f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromStringShow1 f a] -> ShowS
forall (f :: * -> *).
(forall a.
 (Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS)
-> (forall a.
    (Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS)
-> Show1 f
liftShowList :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromStringShow1 f a] -> ShowS
$cliftShowList :: forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromStringShow1 f a] -> ShowS
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromStringShow1 f a -> ShowS
$cliftShowsPrec :: forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromStringShow1 f a -> ShowS
Show1 -- TODO: Manually implement this when you
                   -- can derive Show1 (someday)
           , forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {f :: * -> *}. Traversable f => Functor (FromStringShow1 f)
forall {f :: * -> *}. Traversable f => Foldable (FromStringShow1 f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
FromStringShow1 f (m a) -> m (FromStringShow1 f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
FromStringShow1 f (f a) -> f (FromStringShow1 f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> FromStringShow1 f a -> m (FromStringShow1 f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> FromStringShow1 f a -> f (FromStringShow1 f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow1 f a -> f (FromStringShow1 f b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FromStringShow1 f (m a) -> m (FromStringShow1 f a)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
FromStringShow1 f (m a) -> m (FromStringShow1 f a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromStringShow1 f a -> m (FromStringShow1 f b)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> FromStringShow1 f a -> m (FromStringShow1 f b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromStringShow1 f (f a) -> f (FromStringShow1 f a)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
FromStringShow1 f (f a) -> f (FromStringShow1 f a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow1 f a -> f (FromStringShow1 f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> FromStringShow1 f a -> f (FromStringShow1 f b)
Traversable
#endif
           )

#if __GLASGOW_HASKELL__ < 800
-- TODO: Manually implement this when you can derive Show1 (someday)
deriving instance Show1       f => Show1       (FromStringShow1 f)
deriving instance Functor     f => Functor     (FromStringShow1 f)
deriving instance Foldable    f => Foldable    (FromStringShow1 f)
deriving instance Traversable f => Traversable (FromStringShow1 f)
deriving instance Typeable FromStringShow1
deriving instance ( Data (f a), Typeable f, Typeable a
                  ) => Data (FromStringShow1 f (a :: *))
#endif

instance Read (f a) => Read (FromStringShow1 f a) where
    readPrec :: ReadPrec (FromStringShow1 f a)
readPrec     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec a
readPrec     :: ReadPrec (f a))
    readsPrec :: Int -> ReadS (FromStringShow1 f a)
readsPrec    = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS (f a))
    readList :: ReadS [FromStringShow1 f a]
readList     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadS [a]
readList     :: ReadS [f a])
    readListPrec :: ReadPrec [FromStringShow1 f a]
readListPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [f a])

#if defined(NEW_FUNCTOR_CLASSES)
-- | Not available if using @transformers-0.4@
--
-- This instance is somewhat strange, as its instance context mixes a
-- 'Show1' constraint with a 'TextShow' constraint. This is done for
-- consistency with the 'Show' instance for 'FromTextShow1', which mixes
-- constraints in a similar way to satisfy superclass constraints. See the
-- Haddocks on the 'Show' instance for 'FromTextShow1' for more details.
instance (Show1 f, TextShow a) => TextShow (FromStringShow1 f a) where
    showbPrec :: Int -> FromStringShow1 f a -> Builder
showbPrec = forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1

-- | Not available if using @transformers-0.4@
instance Show1 f => TextShow1 (FromStringShow1 f) where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromStringShow1 f a -> Builder
liftShowbPrec Int -> a -> Builder
sp [a] -> Builder
sl Int
p =
        forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> a -> Builder
sp)
                                            (forall a. (a -> Builder) -> a -> ShowS
showbToShows         [a] -> Builder
sl))
                             Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). FromStringShow1 f a -> f a
fromStringShow1
    liftShowbList :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromStringShow1 f a] -> Builder
liftShowbList Int -> a -> Builder
sp [a] -> Builder
sl =
        forall a. (a -> ShowS) -> a -> Builder
showsToShowb (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList (forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> a -> Builder
sp)
                                   (forall a. (a -> Builder) -> a -> ShowS
showbToShows         [a] -> Builder
sl))
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [FromStringShow1 f a] -> [f a]
coerceList
      where
        coerceList :: [FromStringShow1 f a] -> [f a]
        coerceList :: forall a. [FromStringShow1 f a] -> [f a]
coerceList = coerce :: forall a b. Coercible a b => a -> b
coerce
#endif

instance (Show1 f, Show a) => Show (FromStringShow1 f a) where
    showsPrec :: Int -> FromStringShow1 f a -> ShowS
showsPrec = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
    showList :: [FromStringShow1 f a] -> ShowS
showList  = forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> [f a] -> ShowS
liftShowList forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

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

-- | An adapter newtype, suitable for @DerivingVia@.
-- The @String@ 'Show1' instance for 'FromTextShow1' is based on its
-- 'TextShow1' instance. That is,
--
-- @
-- 'liftShowsPrec' sp sl p ('FromTextShow1' x) =
--     'showbPrecToShowsPrec' ('liftShowbPrec' ('showsPrecToShowbPrec' sp)
--                                             ('showsToShowb'         sl))
--                            p x
-- @
--
-- /Since: 3/
newtype FromTextShow1 f a = FromTextShow1 { forall {k} (f :: k -> *) (a :: k). FromTextShow1 f a -> f a
fromTextShow1 :: f a }
  deriving ( FromTextShow1 f a -> FromTextShow1 f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
/= :: FromTextShow1 f a -> FromTextShow1 f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
== :: FromTextShow1 f a -> FromTextShow1 f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
Eq
           , FromTextShow1 f a -> FromTextShow1 f a -> Bool
FromTextShow1 f a -> FromTextShow1 f a -> Ordering
FromTextShow1 f a -> FromTextShow1 f a -> FromTextShow1 f a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {f :: k -> *} {a :: k}.
Ord (f a) =>
Eq (FromTextShow1 f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> FromTextShow1 f a
min :: FromTextShow1 f a -> FromTextShow1 f a -> FromTextShow1 f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> FromTextShow1 f a
max :: FromTextShow1 f a -> FromTextShow1 f a -> FromTextShow1 f a
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> FromTextShow1 f a
>= :: FromTextShow1 f a -> FromTextShow1 f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
> :: FromTextShow1 f a -> FromTextShow1 f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
<= :: FromTextShow1 f a -> FromTextShow1 f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
< :: FromTextShow1 f a -> FromTextShow1 f a -> Bool
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Bool
compare :: FromTextShow1 f a -> FromTextShow1 f a -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
FromTextShow1 f a -> FromTextShow1 f a -> Ordering
Ord
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) (a :: k) x.
Rep (FromTextShow1 f a) x -> FromTextShow1 f a
forall k (f :: k -> *) (a :: k) x.
FromTextShow1 f a -> Rep (FromTextShow1 f a) x
$cto :: forall k (f :: k -> *) (a :: k) x.
Rep (FromTextShow1 f a) x -> FromTextShow1 f a
$cfrom :: forall k (f :: k -> *) (a :: k) x.
FromTextShow1 f a -> Rep (FromTextShow1 f a) x
Generic
#if defined(__LANGUAGE_DERIVE_GENERIC1__)
           , forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall k (f :: k -> *) (a :: k).
Rep1 (FromTextShow1 f) a -> FromTextShow1 f a
forall k (f :: k -> *) (a :: k).
FromTextShow1 f a -> Rep1 (FromTextShow1 f) a
$cto1 :: forall k (f :: k -> *) (a :: k).
Rep1 (FromTextShow1 f) a -> FromTextShow1 f a
$cfrom1 :: forall k (f :: k -> *) (a :: k).
FromTextShow1 f a -> Rep1 (FromTextShow1 f) a
Generic1
#endif
#if __GLASGOW_HASKELL__ >= 800
           , FromTextShow1 f a -> DataType
FromTextShow1 f a -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {k} {f :: k -> *} {a :: k}.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
Typeable (FromTextShow1 f a)
forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromTextShow1 f a -> DataType
forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromTextShow1 f a -> Constr
forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b. Data b => b -> b)
-> FromTextShow1 f a -> FromTextShow1 f a
forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
Int -> (forall d. Data d => d -> u) -> FromTextShow1 f a -> u
forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d. Data d => d -> u) -> FromTextShow1 f a -> [u]
forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow1 f a -> r
forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow1 f a -> r
forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Monad m) =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow1 f a)
forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow1 f a
-> c (FromTextShow1 f a)
forall k (f :: k -> *) (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow1 f a))
forall k (f :: k -> *) (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow1 f a))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow1 f a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow1 f a
-> c (FromTextShow1 f a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
$cgmapMo :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
$cgmapMp :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
$cgmapM :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Monad m) =>
(forall d. Data d => d -> m d)
-> FromTextShow1 f a -> m (FromTextShow1 f a)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromTextShow1 f a -> u
$cgmapQi :: forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
Int -> (forall d. Data d => d -> u) -> FromTextShow1 f a -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FromTextShow1 f a -> [u]
$cgmapQ :: forall k (f :: k -> *) (a :: k) u.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d. Data d => d -> u) -> FromTextShow1 f a -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow1 f a -> r
$cgmapQr :: forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow1 f a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow1 f a -> r
$cgmapQl :: forall k (f :: k -> *) (a :: k) r r'.
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow1 f a -> r
gmapT :: (forall b. Data b => b -> b)
-> FromTextShow1 f a -> FromTextShow1 f a
$cgmapT :: forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b. Data b => b -> b)
-> FromTextShow1 f a -> FromTextShow1 f a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow1 f a))
$cdataCast2 :: forall k (f :: k -> *) (a :: k) (t :: * -> * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow1 f a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow1 f a))
$cdataCast1 :: forall k (f :: k -> *) (a :: k) (t :: * -> *) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow1 f a))
dataTypeOf :: FromTextShow1 f a -> DataType
$cdataTypeOf :: forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromTextShow1 f a -> DataType
toConstr :: FromTextShow1 f a -> Constr
$ctoConstr :: forall k (f :: k -> *) (a :: k).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
FromTextShow1 f a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow1 f a)
$cgunfold :: forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow1 f a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow1 f a
-> c (FromTextShow1 f a)
$cgfoldl :: forall k (f :: k -> *) (a :: k) (c :: * -> *).
(Typeable a, Typeable f, Typeable k, Data (f a)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow1 f a
-> c (FromTextShow1 f a)
Data
           , forall a. Eq a => a -> FromTextShow1 f a -> Bool
forall a. Num a => FromTextShow1 f a -> a
forall a. Ord a => FromTextShow1 f a -> a
forall m. Monoid m => FromTextShow1 f m -> m
forall a. FromTextShow1 f a -> Bool
forall a. FromTextShow1 f a -> Int
forall a. FromTextShow1 f a -> [a]
forall a. (a -> a -> a) -> FromTextShow1 f a -> a
forall m a. Monoid m => (a -> m) -> FromTextShow1 f a -> m
forall b a. (b -> a -> b) -> b -> FromTextShow1 f a -> b
forall a b. (a -> b -> b) -> b -> FromTextShow1 f a -> b
forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromTextShow1 f a -> Bool
forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromTextShow1 f a -> a
forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromTextShow1 f a -> a
forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromTextShow1 f m -> m
forall (f :: * -> *) a. Foldable f => FromTextShow1 f a -> Bool
forall (f :: * -> *) a. Foldable f => FromTextShow1 f a -> Int
forall (f :: * -> *) a. Foldable f => FromTextShow1 f a -> [a]
forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromTextShow1 f a -> a
forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromTextShow1 f a -> m
forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromTextShow1 f a -> b
forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromTextShow1 f a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FromTextShow1 f a -> a
$cproduct :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromTextShow1 f a -> a
sum :: forall a. Num a => FromTextShow1 f a -> a
$csum :: forall (f :: * -> *) a.
(Foldable f, Num a) =>
FromTextShow1 f a -> a
minimum :: forall a. Ord a => FromTextShow1 f a -> a
$cminimum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromTextShow1 f a -> a
maximum :: forall a. Ord a => FromTextShow1 f a -> a
$cmaximum :: forall (f :: * -> *) a.
(Foldable f, Ord a) =>
FromTextShow1 f a -> a
elem :: forall a. Eq a => a -> FromTextShow1 f a -> Bool
$celem :: forall (f :: * -> *) a.
(Foldable f, Eq a) =>
a -> FromTextShow1 f a -> Bool
length :: forall a. FromTextShow1 f a -> Int
$clength :: forall (f :: * -> *) a. Foldable f => FromTextShow1 f a -> Int
null :: forall a. FromTextShow1 f a -> Bool
$cnull :: forall (f :: * -> *) a. Foldable f => FromTextShow1 f a -> Bool
toList :: forall a. FromTextShow1 f a -> [a]
$ctoList :: forall (f :: * -> *) a. Foldable f => FromTextShow1 f a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FromTextShow1 f a -> a
$cfoldl1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromTextShow1 f a -> a
foldr1 :: forall a. (a -> a -> a) -> FromTextShow1 f a -> a
$cfoldr1 :: forall (f :: * -> *) a.
Foldable f =>
(a -> a -> a) -> FromTextShow1 f a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FromTextShow1 f a -> b
$cfoldl' :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromTextShow1 f a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromTextShow1 f a -> b
$cfoldl :: forall (f :: * -> *) b a.
Foldable f =>
(b -> a -> b) -> b -> FromTextShow1 f a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromTextShow1 f a -> b
$cfoldr' :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromTextShow1 f a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromTextShow1 f a -> b
$cfoldr :: forall (f :: * -> *) a b.
Foldable f =>
(a -> b -> b) -> b -> FromTextShow1 f a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FromTextShow1 f a -> m
$cfoldMap' :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromTextShow1 f a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromTextShow1 f a -> m
$cfoldMap :: forall (f :: * -> *) m a.
(Foldable f, Monoid m) =>
(a -> m) -> FromTextShow1 f a -> m
fold :: forall m. Monoid m => FromTextShow1 f m -> m
$cfold :: forall (f :: * -> *) m.
(Foldable f, Monoid m) =>
FromTextShow1 f m -> m
Foldable
           , forall a b. a -> FromTextShow1 f b -> FromTextShow1 f a
forall a b. (a -> b) -> FromTextShow1 f a -> FromTextShow1 f b
forall (f :: * -> *) a b.
Functor f =>
a -> FromTextShow1 f b -> FromTextShow1 f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> FromTextShow1 f a -> FromTextShow1 f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FromTextShow1 f b -> FromTextShow1 f a
$c<$ :: forall (f :: * -> *) a b.
Functor f =>
a -> FromTextShow1 f b -> FromTextShow1 f a
fmap :: forall a b. (a -> b) -> FromTextShow1 f a -> FromTextShow1 f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> FromTextShow1 f a -> FromTextShow1 f b
Functor
           , forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromTextShow1 f a -> m Exp
forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromTextShow1 f a -> Code m (FromTextShow1 f a)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FromTextShow1 f a -> m Exp
forall (m :: * -> *).
Quote m =>
FromTextShow1 f a -> Code m (FromTextShow1 f a)
liftTyped :: forall (m :: * -> *).
Quote m =>
FromTextShow1 f a -> Code m (FromTextShow1 f a)
$cliftTyped :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromTextShow1 f a -> Code m (FromTextShow1 f a)
lift :: forall (m :: * -> *). Quote m => FromTextShow1 f a -> m Exp
$clift :: forall k (f :: k -> *) (a :: k) (m :: * -> *).
(Lift (f a), Quote m) =>
FromTextShow1 f a -> m Exp
Lift
           , forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromTextShow1 f a -> Builder
forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromTextShow1 f a] -> Builder
forall {f :: * -> *} a.
(TextShow1 f, TextShow a) =>
TextShow (FromTextShow1 f a)
forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromTextShow1 f a -> Builder
forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromTextShow1 f a] -> Builder
forall (f :: * -> *).
(forall a. TextShow a => TextShow (f a))
-> (forall a.
    (Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder)
-> (forall a.
    (Int -> a -> Builder) -> ([a] -> Builder) -> [f a] -> Builder)
-> TextShow1 f
liftShowbList :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromTextShow1 f a] -> Builder
$cliftShowbList :: forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromTextShow1 f a] -> Builder
liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromTextShow1 f a -> Builder
$cliftShowbPrec :: forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromTextShow1 f a -> Builder
TextShow1
           , forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall {f :: * -> *}. Traversable f => Functor (FromTextShow1 f)
forall {f :: * -> *}. Traversable f => Foldable (FromTextShow1 f)
forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
FromTextShow1 f (m a) -> m (FromTextShow1 f a)
forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
FromTextShow1 f (f a) -> f (FromTextShow1 f a)
forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> FromTextShow1 f a -> m (FromTextShow1 f b)
forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> FromTextShow1 f a -> f (FromTextShow1 f b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow1 f a -> f (FromTextShow1 f b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FromTextShow1 f (m a) -> m (FromTextShow1 f a)
$csequence :: forall (f :: * -> *) (m :: * -> *) a.
(Traversable f, Monad m) =>
FromTextShow1 f (m a) -> m (FromTextShow1 f a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromTextShow1 f a -> m (FromTextShow1 f b)
$cmapM :: forall (f :: * -> *) (m :: * -> *) a b.
(Traversable f, Monad m) =>
(a -> m b) -> FromTextShow1 f a -> m (FromTextShow1 f b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromTextShow1 f (f a) -> f (FromTextShow1 f a)
$csequenceA :: forall (f :: * -> *) (f :: * -> *) a.
(Traversable f, Applicative f) =>
FromTextShow1 f (f a) -> f (FromTextShow1 f a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow1 f a -> f (FromTextShow1 f b)
$ctraverse :: forall (f :: * -> *) (f :: * -> *) a b.
(Traversable f, Applicative f) =>
(a -> f b) -> FromTextShow1 f a -> f (FromTextShow1 f b)
Traversable
#endif
           )

#if __GLASGOW_HASKELL__ < 800
deriving instance TextShow1   f => TextShow1   (FromTextShow1 f)
deriving instance Functor     f => Functor     (FromTextShow1 f)
deriving instance Foldable    f => Foldable    (FromTextShow1 f)
deriving instance Traversable f => Traversable (FromTextShow1 f)
deriving instance Typeable FromTextShow1
deriving instance ( Data (f a), Typeable f, Typeable a
                  ) => Data (FromTextShow1 f (a :: *))
#endif

instance Read (f a) => Read (FromTextShow1 f a) where
    readPrec :: ReadPrec (FromTextShow1 f a)
readPrec     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec a
readPrec     :: ReadPrec (f a))
    readsPrec :: Int -> ReadS (FromTextShow1 f a)
readsPrec    = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS (f a))
    readList :: ReadS [FromTextShow1 f a]
readList     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadS [a]
readList     :: ReadS [f a])
    readListPrec :: ReadPrec [FromTextShow1 f a]
readListPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [f a])

#if defined(NEW_FUNCTOR_CLASSES)
-- | Not available if using @transformers-0.4@
--
-- This instance is somewhat strange, as its instance context mixes a
-- 'TextShow1' constraint with a 'Show' constraint. The 'Show' constraint is
-- necessary to satisfy the quantified 'Show' superclass in 'Show1'. Really,
-- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC
-- has no way of knowing that the 'TextShow' constraint can be converted to a
-- 'Show' constraint when checking superclasses.
--
-- This is all to say: this instance is almost surely not what you want if you
-- are looking to derive a 'Show' instance only via 'TextShow'-related
-- classes. If you wish to do this, derive via 'FromTextShow' instead.
instance (TextShow1 f, Show a) => Show (FromTextShow1 f a) where
  showsPrec :: Int -> FromTextShow1 f a -> ShowS
showsPrec = forall (f :: * -> *) a. (Show1 f, Show a) => Int -> f a -> ShowS
showsPrec1
#endif

instance TextShow1 f => Show1 (FromTextShow1 f) where
#if defined(NEW_FUNCTOR_CLASSES)
    liftShowList :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromTextShow1 f a] -> ShowS
liftShowList Int -> a -> ShowS
sp [a] -> ShowS
sl =
        forall a. (a -> Builder) -> a -> ShowS
showbToShows (forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> [f a] -> Builder
liftShowbList (forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> a -> ShowS
sp)
                                    (forall a. (a -> ShowS) -> a -> Builder
showsToShowb         [a] -> ShowS
sl))
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [FromTextShow1 f a] -> [f a]
coerceList
      where
        coerceList :: [FromTextShow1 f a] -> [f a]
        coerceList :: forall a. [FromTextShow1 f a] -> [f a]
coerceList = coerce :: forall a b. Coercible a b => a -> b
coerce
    liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromTextShow1 f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl Int
p
#else
    showsPrec1 p
#endif
      = forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec (forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> Int -> f a -> Builder
liftShowbPrec (forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> a -> ShowS
sp)
                                            (forall a. (a -> ShowS) -> a -> Builder
showsToShowb         [a] -> ShowS
sl))
                             Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} (f :: k -> *) (a :: k). FromTextShow1 f a -> f a
fromTextShow1

instance (TextShow1 f, TextShow a) => TextShow (FromTextShow1 f a) where
    showbPrec :: Int -> FromTextShow1 f a -> Builder
showbPrec = forall (f :: * -> *) a.
(TextShow1 f, TextShow a) =>
Int -> f a -> Builder
showbPrec1
    showbList :: [FromTextShow1 f a] -> Builder
showbList = forall (f :: * -> *) a.
TextShow1 f =>
(Int -> a -> Builder) -> ([a] -> Builder) -> [f a] -> Builder
liftShowbList forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList

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

-- | An adapter newtype, suitable for @DerivingVia@.
-- The 'TextShow2' instance for 'FromStringShow2' is based on its @String@
-- 'Show2' instance. That is,
--
-- @
-- 'liftShowbPrec2' sp1 sl1 sp2 sl2 p ('FromStringShow2' x) =
--     'showsPrecToShowbPrec' ('liftShowsPrec2' ('showbPrecToShowsPrec' sp1)
--                                              ('showbToShows'         sl1)
--                                              ('showbPrecToShowsPrec' sp2)
--                                              ('showbToShows'         sl2))
--                            p x
-- @
--
-- /Since: 3/
newtype FromStringShow2 f a b = FromStringShow2 { forall {k} {k} (f :: k -> k -> *) (a :: k) (b :: k).
FromStringShow2 f a b -> f a b
fromStringShow2 :: f a b }
  deriving ( FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Eq (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
/= :: FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
$c/= :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Eq (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
== :: FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
$c== :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Eq (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
Eq
           , FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
FromStringShow2 f a b -> FromStringShow2 f a b -> Ordering
FromStringShow2 f a b
-> FromStringShow2 f a b -> FromStringShow2 f a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {k} {f :: k -> k -> *} {a :: k} {b :: k}.
Ord (f a b) =>
Eq (FromStringShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Ordering
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b
-> FromStringShow2 f a b -> FromStringShow2 f a b
min :: FromStringShow2 f a b
-> FromStringShow2 f a b -> FromStringShow2 f a b
$cmin :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b
-> FromStringShow2 f a b -> FromStringShow2 f a b
max :: FromStringShow2 f a b
-> FromStringShow2 f a b -> FromStringShow2 f a b
$cmax :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b
-> FromStringShow2 f a b -> FromStringShow2 f a b
>= :: FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
$c>= :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
> :: FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
$c> :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
<= :: FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
$c<= :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
< :: FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
$c< :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Bool
compare :: FromStringShow2 f a b -> FromStringShow2 f a b -> Ordering
$ccompare :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromStringShow2 f a b -> FromStringShow2 f a b -> Ordering
Ord
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
Rep (FromStringShow2 f a b) x -> FromStringShow2 f a b
forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
FromStringShow2 f a b -> Rep (FromStringShow2 f a b) x
$cto :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
Rep (FromStringShow2 f a b) x -> FromStringShow2 f a b
$cfrom :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
FromStringShow2 f a b -> Rep (FromStringShow2 f a b) x
Generic
#if defined(__LANGUAGE_DERIVE_GENERIC1__)
           , forall k k (f :: k -> k -> *) (a :: k) (a :: k).
Rep1 (FromStringShow2 f a) a -> FromStringShow2 f a a
forall k k (f :: k -> k -> *) (a :: k) (a :: k).
FromStringShow2 f a a -> Rep1 (FromStringShow2 f a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k k (f :: k -> k -> *) (a :: k) (a :: k).
Rep1 (FromStringShow2 f a) a -> FromStringShow2 f a a
$cfrom1 :: forall k k (f :: k -> k -> *) (a :: k) (a :: k).
FromStringShow2 f a a -> Rep1 (FromStringShow2 f a) a
Generic1
#endif
#if __GLASGOW_HASKELL__ >= 800
           , FromStringShow2 f a b -> DataType
FromStringShow2 f a b -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {k} {k} {f :: k -> k -> *} {a :: k} {b :: k}.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
Typeable (FromStringShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromStringShow2 f a b -> DataType
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromStringShow2 f a b -> Constr
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b. Data b => b -> b)
-> FromStringShow2 f a b -> FromStringShow2 f a b
forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
Int -> (forall d. Data d => d -> u) -> FromStringShow2 f a b -> u
forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d. Data d => d -> u) -> FromStringShow2 f a b -> [u]
forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow2 f a b -> r
forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow2 f a b -> r
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Monad m) =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow2 f a b
-> c (FromStringShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow2 f a b))
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow2 f a b))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow2 f a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow2 f a b
-> c (FromStringShow2 f a b)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
$cgmapMo :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
$cgmapMp :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
$cgmapM :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Monad m) =>
(forall d. Data d => d -> m d)
-> FromStringShow2 f a b -> m (FromStringShow2 f a b)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromStringShow2 f a b -> u
$cgmapQi :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
Int -> (forall d. Data d => d -> u) -> FromStringShow2 f a b -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FromStringShow2 f a b -> [u]
$cgmapQ :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d. Data d => d -> u) -> FromStringShow2 f a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow2 f a b -> r
$cgmapQr :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow2 f a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow2 f a b -> r
$cgmapQl :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromStringShow2 f a b -> r
gmapT :: (forall b. Data b => b -> b)
-> FromStringShow2 f a b -> FromStringShow2 f a b
$cgmapT :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b. Data b => b -> b)
-> FromStringShow2 f a b -> FromStringShow2 f a b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow2 f a b))
$cdataCast2 :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromStringShow2 f a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow2 f a b))
$cdataCast1 :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromStringShow2 f a b))
dataTypeOf :: FromStringShow2 f a b -> DataType
$cdataTypeOf :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromStringShow2 f a b -> DataType
toConstr :: FromStringShow2 f a b -> Constr
$ctoConstr :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromStringShow2 f a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow2 f a b)
$cgunfold :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromStringShow2 f a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow2 f a b
-> c (FromStringShow2 f a b)
$cgfoldl :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromStringShow2 f a b
-> c (FromStringShow2 f a b)
Data
           , forall a. Eq a => a -> FromStringShow2 f a a -> Bool
forall a. Num a => FromStringShow2 f a a -> a
forall a. Ord a => FromStringShow2 f a a -> a
forall m. Monoid m => FromStringShow2 f a m -> m
forall a. FromStringShow2 f a a -> Bool
forall a. FromStringShow2 f a a -> Int
forall a. FromStringShow2 f a a -> [a]
forall a. (a -> a -> a) -> FromStringShow2 f a a -> a
forall m a. Monoid m => (a -> m) -> FromStringShow2 f a a -> m
forall b a. (b -> a -> b) -> b -> FromStringShow2 f a a -> b
forall a b. (a -> b -> b) -> b -> FromStringShow2 f a a -> b
forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Eq a) =>
a -> FromStringShow2 f a a -> Bool
forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Num a) =>
FromStringShow2 f a a -> a
forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Ord a) =>
FromStringShow2 f a a -> a
forall k (f :: k -> * -> *) (a :: k) m.
(Foldable (f a), Monoid m) =>
FromStringShow2 f a m -> m
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromStringShow2 f a a -> Bool
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromStringShow2 f a a -> Int
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromStringShow2 f a a -> [a]
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
(a -> a -> a) -> FromStringShow2 f a a -> a
forall k (f :: k -> * -> *) (a :: k) m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> FromStringShow2 f a a -> m
forall k (f :: k -> * -> *) (a :: k) b a.
Foldable (f a) =>
(b -> a -> b) -> b -> FromStringShow2 f a a -> b
forall k (f :: k -> * -> *) (a :: k) a b.
Foldable (f a) =>
(a -> b -> b) -> b -> FromStringShow2 f a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FromStringShow2 f a a -> a
$cproduct :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Num a) =>
FromStringShow2 f a a -> a
sum :: forall a. Num a => FromStringShow2 f a a -> a
$csum :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Num a) =>
FromStringShow2 f a a -> a
minimum :: forall a. Ord a => FromStringShow2 f a a -> a
$cminimum :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Ord a) =>
FromStringShow2 f a a -> a
maximum :: forall a. Ord a => FromStringShow2 f a a -> a
$cmaximum :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Ord a) =>
FromStringShow2 f a a -> a
elem :: forall a. Eq a => a -> FromStringShow2 f a a -> Bool
$celem :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Eq a) =>
a -> FromStringShow2 f a a -> Bool
length :: forall a. FromStringShow2 f a a -> Int
$clength :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromStringShow2 f a a -> Int
null :: forall a. FromStringShow2 f a a -> Bool
$cnull :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromStringShow2 f a a -> Bool
toList :: forall a. FromStringShow2 f a a -> [a]
$ctoList :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromStringShow2 f a a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FromStringShow2 f a a -> a
$cfoldl1 :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
(a -> a -> a) -> FromStringShow2 f a a -> a
foldr1 :: forall a. (a -> a -> a) -> FromStringShow2 f a a -> a
$cfoldr1 :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
(a -> a -> a) -> FromStringShow2 f a a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FromStringShow2 f a a -> b
$cfoldl' :: forall k (f :: k -> * -> *) (a :: k) b a.
Foldable (f a) =>
(b -> a -> b) -> b -> FromStringShow2 f a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromStringShow2 f a a -> b
$cfoldl :: forall k (f :: k -> * -> *) (a :: k) b a.
Foldable (f a) =>
(b -> a -> b) -> b -> FromStringShow2 f a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromStringShow2 f a a -> b
$cfoldr' :: forall k (f :: k -> * -> *) (a :: k) a b.
Foldable (f a) =>
(a -> b -> b) -> b -> FromStringShow2 f a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromStringShow2 f a a -> b
$cfoldr :: forall k (f :: k -> * -> *) (a :: k) a b.
Foldable (f a) =>
(a -> b -> b) -> b -> FromStringShow2 f a a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FromStringShow2 f a a -> m
$cfoldMap' :: forall k (f :: k -> * -> *) (a :: k) m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> FromStringShow2 f a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromStringShow2 f a a -> m
$cfoldMap :: forall k (f :: k -> * -> *) (a :: k) m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> FromStringShow2 f a a -> m
fold :: forall m. Monoid m => FromStringShow2 f a m -> m
$cfold :: forall k (f :: k -> * -> *) (a :: k) m.
(Foldable (f a), Monoid m) =>
FromStringShow2 f a m -> m
Foldable
           , forall a b. a -> FromStringShow2 f a b -> FromStringShow2 f a a
forall a b.
(a -> b) -> FromStringShow2 f a a -> FromStringShow2 f a b
forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
a -> FromStringShow2 f a b -> FromStringShow2 f a a
forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
(a -> b) -> FromStringShow2 f a a -> FromStringShow2 f a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FromStringShow2 f a b -> FromStringShow2 f a a
$c<$ :: forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
a -> FromStringShow2 f a b -> FromStringShow2 f a a
fmap :: forall a b.
(a -> b) -> FromStringShow2 f a a -> FromStringShow2 f a b
$cfmap :: forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
(a -> b) -> FromStringShow2 f a a -> FromStringShow2 f a b
Functor
           , forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromStringShow2 f a b -> m Exp
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromStringShow2 f a b -> Code m (FromStringShow2 f a b)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FromStringShow2 f a b -> m Exp
forall (m :: * -> *).
Quote m =>
FromStringShow2 f a b -> Code m (FromStringShow2 f a b)
liftTyped :: forall (m :: * -> *).
Quote m =>
FromStringShow2 f a b -> Code m (FromStringShow2 f a b)
$cliftTyped :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromStringShow2 f a b -> Code m (FromStringShow2 f a b)
lift :: forall (m :: * -> *). Quote m => FromStringShow2 f a b -> m Exp
$clift :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromStringShow2 f a b -> m Exp
Lift
           , forall {k} {f :: k -> * -> *} {a :: k}.
Traversable (f a) =>
Functor (FromStringShow2 f a)
forall {k} {f :: k -> * -> *} {a :: k}.
Traversable (f a) =>
Foldable (FromStringShow2 f a)
forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a.
(Traversable (f a), Monad m) =>
FromStringShow2 f a (m a) -> m (FromStringShow2 f a a)
forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a.
(Traversable (f a), Applicative f) =>
FromStringShow2 f a (f a) -> f (FromStringShow2 f a a)
forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a b.
(Traversable (f a), Monad m) =>
(a -> m b) -> FromStringShow2 f a a -> m (FromStringShow2 f a b)
forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a b.
(Traversable (f a), Applicative f) =>
(a -> f b) -> FromStringShow2 f a a -> f (FromStringShow2 f a b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow2 f a a -> f (FromStringShow2 f a b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FromStringShow2 f a (m a) -> m (FromStringShow2 f a a)
$csequence :: forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a.
(Traversable (f a), Monad m) =>
FromStringShow2 f a (m a) -> m (FromStringShow2 f a a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromStringShow2 f a a -> m (FromStringShow2 f a b)
$cmapM :: forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a b.
(Traversable (f a), Monad m) =>
(a -> m b) -> FromStringShow2 f a a -> m (FromStringShow2 f a b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromStringShow2 f a (f a) -> f (FromStringShow2 f a a)
$csequenceA :: forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a.
(Traversable (f a), Applicative f) =>
FromStringShow2 f a (f a) -> f (FromStringShow2 f a a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromStringShow2 f a a -> f (FromStringShow2 f a b)
$ctraverse :: forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a b.
(Traversable (f a), Applicative f) =>
(a -> f b) -> FromStringShow2 f a a -> f (FromStringShow2 f a b)
Traversable
#endif
           )

#if __GLASGOW_HASKELL__ < 800
deriving instance Functor     (f a) => Functor     (FromStringShow2 f a)
deriving instance Foldable    (f a) => Foldable    (FromStringShow2 f a)
deriving instance Traversable (f a) => Traversable (FromStringShow2 f a)
deriving instance Typeable FromStringShow2
deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b
                  ) => Data (FromStringShow2 f (a :: *) (b :: *))
#endif

instance Read (f a b) => Read (FromStringShow2 f a b) where
    readPrec :: ReadPrec (FromStringShow2 f a b)
readPrec     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec a
readPrec     :: ReadPrec (f a b))
    readsPrec :: Int -> ReadS (FromStringShow2 f a b)
readsPrec    = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS (f a b))
    readList :: ReadS [FromStringShow2 f a b]
readList     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadS [a]
readList     :: ReadS [f a b])
    readListPrec :: ReadPrec [FromStringShow2 f a b]
readListPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [f a b])

#if defined(NEW_FUNCTOR_CLASSES)
-- TODO: Manually implement this when you can derive Show2 (someday)
-- | Not available if using @transformers-0.4@
deriving instance Show2 f => Show2 (FromStringShow2 f)

-- | Not available if using @transformers-0.4@
--
-- This instance is somewhat strange, as its instance context mixes a
-- 'Show2' constraint with 'TextShow' constraints. This is done for consistency
-- with the 'Show' instance for 'FromTextShow2', which mixes constraints in a
-- similar way to satisfy superclass constraints. See the Haddocks on the
-- 'Show' instance for 'FromTextShow2' for more details.
instance (Show2 f, TextShow a, TextShow b) => TextShow (FromStringShow2 f a b) where
    showbPrec :: Int -> FromStringShow2 f a b -> Builder
showbPrec = forall (f :: * -> * -> *) a b.
(TextShow2 f, TextShow a, TextShow b) =>
Int -> f a b -> Builder
showbPrec2

-- | Not available if using @transformers-0.4@
--
-- This instance is somewhat strange, as its instance context mixes a
-- 'Show2' constraint with a 'TextShow' constraint. This is done for
-- consistency with the 'Show1' instance for 'FromTextShow2', which mixes
-- constraints in a similar way to satisfy superclass constraints. See the
-- Haddocks on the 'Show1' instance for 'FromTextShow2' for more details.
instance (Show2 f, TextShow a) => TextShow1 (FromStringShow2 f a) where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromStringShow2 f a a -> Builder
liftShowbPrec = forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList
    liftShowbList :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromStringShow2 f a a] -> Builder
liftShowbList = forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [f a b]
-> Builder
liftShowbList2 forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList

-- | Not available if using @transformers-0.4@
instance Show2 f => TextShow2 (FromStringShow2 f) where
    liftShowbPrec2 :: forall a b.
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> FromStringShow2 f a b
-> Builder
liftShowbPrec2 Int -> a -> Builder
sp1 [a] -> Builder
sl1 Int -> b -> Builder
sp2 [b] -> Builder
sl2 Int
p =
        forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec (forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 (forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> a -> Builder
sp1)
                                             (forall a. (a -> Builder) -> a -> ShowS
showbToShows         [a] -> Builder
sl1)
                                             (forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> b -> Builder
sp2)
                                             (forall a. (a -> Builder) -> a -> ShowS
showbToShows         [b] -> Builder
sl2))
                             Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (f :: k -> k -> *) (a :: k) (b :: k).
FromStringShow2 f a b -> f a b
fromStringShow2
    liftShowbList2 :: forall a b.
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [FromStringShow2 f a b]
-> Builder
liftShowbList2 Int -> a -> Builder
sp1 [a] -> Builder
sl1 Int -> b -> Builder
sp2 [b] -> Builder
sl2 =
        forall a. (a -> ShowS) -> a -> Builder
showsToShowb (forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 (forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> a -> Builder
sp1)
                                    (forall a. (a -> Builder) -> a -> ShowS
showbToShows         [a] -> Builder
sl1)
                                    (forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec Int -> b -> Builder
sp2)
                                    (forall a. (a -> Builder) -> a -> ShowS
showbToShows         [b] -> Builder
sl2))
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [FromStringShow2 f a b] -> [f a b]
coerceList
      where
        coerceList :: [FromStringShow2 f a b] -> [f a b]
        coerceList :: forall a b. [FromStringShow2 f a b] -> [f a b]
coerceList = coerce :: forall a b. Coercible a b => a -> b
coerce

-- | Not available if using @transformers-0.4@
instance (Show2 f, Show a, Show b) => Show (FromStringShow2 f a b) where
    showsPrec :: Int -> FromStringShow2 f a b -> ShowS
showsPrec = forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2
    showList :: [FromStringShow2 f a b] -> ShowS
showList  = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

-- | Not available if using @transformers-0.4@
instance (Show2 f, Show a) => Show1 (FromStringShow2 f a) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromStringShow2 f a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
    liftShowList :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromStringShow2 f a a] -> ShowS
liftShowList  = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2  forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
#endif

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

-- | An adapter newtype, suitable for @DerivingVia@.
-- The @String@ 'Show2' instance for 'FromTextShow2' is based on its
-- 'TextShow2' instance. That is,
--
-- @
-- liftShowsPrec2 sp1 sl1 sp2 sl2 p ('FromTextShow2' x) =
--     'showbPrecToShowsPrec' ('liftShowbPrec2' ('showsPrecToShowbPrec' sp1)
--                                              ('showsToShowb'         sl1)
--                                              ('showsPrecToShowbPrec' sp2)
--                                              ('showsToShowb'         sl2))
--                            p x
-- @
--
-- /Since: 3/
newtype FromTextShow2 f a b = FromTextShow2 { forall {k} {k} (f :: k -> k -> *) (a :: k) (b :: k).
FromTextShow2 f a b -> f a b
fromTextShow2 :: f a b }
  deriving ( FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Eq (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
/= :: FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
$c/= :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Eq (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
== :: FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
$c== :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Eq (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
Eq
           , FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
FromTextShow2 f a b -> FromTextShow2 f a b -> Ordering
FromTextShow2 f a b -> FromTextShow2 f a b -> FromTextShow2 f a b
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall {k} {k} {f :: k -> k -> *} {a :: k} {b :: k}.
Ord (f a b) =>
Eq (FromTextShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Ordering
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> FromTextShow2 f a b
min :: FromTextShow2 f a b -> FromTextShow2 f a b -> FromTextShow2 f a b
$cmin :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> FromTextShow2 f a b
max :: FromTextShow2 f a b -> FromTextShow2 f a b -> FromTextShow2 f a b
$cmax :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> FromTextShow2 f a b
>= :: FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
$c>= :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
> :: FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
$c> :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
<= :: FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
$c<= :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
< :: FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
$c< :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Bool
compare :: FromTextShow2 f a b -> FromTextShow2 f a b -> Ordering
$ccompare :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
Ord (f a b) =>
FromTextShow2 f a b -> FromTextShow2 f a b -> Ordering
Ord
           , forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
Rep (FromTextShow2 f a b) x -> FromTextShow2 f a b
forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
FromTextShow2 f a b -> Rep (FromTextShow2 f a b) x
$cto :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
Rep (FromTextShow2 f a b) x -> FromTextShow2 f a b
$cfrom :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) x.
FromTextShow2 f a b -> Rep (FromTextShow2 f a b) x
Generic
#if defined(__LANGUAGE_DERIVE_GENERIC1__)
           , forall k k (f :: k -> k -> *) (a :: k) (a :: k).
Rep1 (FromTextShow2 f a) a -> FromTextShow2 f a a
forall k k (f :: k -> k -> *) (a :: k) (a :: k).
FromTextShow2 f a a -> Rep1 (FromTextShow2 f a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k k (f :: k -> k -> *) (a :: k) (a :: k).
Rep1 (FromTextShow2 f a) a -> FromTextShow2 f a a
$cfrom1 :: forall k k (f :: k -> k -> *) (a :: k) (a :: k).
FromTextShow2 f a a -> Rep1 (FromTextShow2 f a) a
Generic1
#endif
#if __GLASGOW_HASKELL__ >= 800
           , FromTextShow2 f a b -> DataType
FromTextShow2 f a b -> Constr
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall {k} {k} {f :: k -> k -> *} {a :: k} {b :: k}.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
Typeable (FromTextShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromTextShow2 f a b -> DataType
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromTextShow2 f a b -> Constr
forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b. Data b => b -> b)
-> FromTextShow2 f a b -> FromTextShow2 f a b
forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
Int -> (forall d. Data d => d -> u) -> FromTextShow2 f a b -> u
forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d. Data d => d -> u) -> FromTextShow2 f a b -> [u]
forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow2 f a b -> r
forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow2 f a b -> r
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Monad m) =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow2 f a b
-> c (FromTextShow2 f a b)
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow2 f a b))
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow2 f a b))
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow2 f a b)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow2 f a b
-> c (FromTextShow2 f a b)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
$cgmapMo :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
$cgmapMp :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), MonadPlus m) =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
$cgmapM :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Monad m) =>
(forall d. Data d => d -> m d)
-> FromTextShow2 f a b -> m (FromTextShow2 f a b)
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> FromTextShow2 f a b -> u
$cgmapQi :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
Int -> (forall d. Data d => d -> u) -> FromTextShow2 f a b -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> FromTextShow2 f a b -> [u]
$cgmapQ :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) u.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d. Data d => d -> u) -> FromTextShow2 f a b -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow2 f a b -> r
$cgmapQr :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow2 f a b -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow2 f a b -> r
$cgmapQl :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) r r'.
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FromTextShow2 f a b -> r
gmapT :: (forall b. Data b => b -> b)
-> FromTextShow2 f a b -> FromTextShow2 f a b
$cgmapT :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b. Data b => b -> b)
-> FromTextShow2 f a b -> FromTextShow2 f a b
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow2 f a b))
$cdataCast2 :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (FromTextShow2 f a b))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow2 f a b))
$cdataCast1 :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (t :: * -> *)
       (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b), Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (FromTextShow2 f a b))
dataTypeOf :: FromTextShow2 f a b -> DataType
$cdataTypeOf :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromTextShow2 f a b -> DataType
toConstr :: FromTextShow2 f a b -> Constr
$ctoConstr :: forall k k (f :: k -> k -> *) (a :: k) (b :: k).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
FromTextShow2 f a b -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow2 f a b)
$cgunfold :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (FromTextShow2 f a b)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow2 f a b
-> c (FromTextShow2 f a b)
$cgfoldl :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (c :: * -> *).
(Typeable a, Typeable b, Typeable f, Typeable k, Typeable k,
 Data (f a b)) =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> FromTextShow2 f a b
-> c (FromTextShow2 f a b)
Data
           , forall a. Eq a => a -> FromTextShow2 f a a -> Bool
forall a. Num a => FromTextShow2 f a a -> a
forall a. Ord a => FromTextShow2 f a a -> a
forall m. Monoid m => FromTextShow2 f a m -> m
forall a. FromTextShow2 f a a -> Bool
forall a. FromTextShow2 f a a -> Int
forall a. FromTextShow2 f a a -> [a]
forall a. (a -> a -> a) -> FromTextShow2 f a a -> a
forall m a. Monoid m => (a -> m) -> FromTextShow2 f a a -> m
forall b a. (b -> a -> b) -> b -> FromTextShow2 f a a -> b
forall a b. (a -> b -> b) -> b -> FromTextShow2 f a a -> b
forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Eq a) =>
a -> FromTextShow2 f a a -> Bool
forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Num a) =>
FromTextShow2 f a a -> a
forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Ord a) =>
FromTextShow2 f a a -> a
forall k (f :: k -> * -> *) (a :: k) m.
(Foldable (f a), Monoid m) =>
FromTextShow2 f a m -> m
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromTextShow2 f a a -> Bool
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromTextShow2 f a a -> Int
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromTextShow2 f a a -> [a]
forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
(a -> a -> a) -> FromTextShow2 f a a -> a
forall k (f :: k -> * -> *) (a :: k) m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> FromTextShow2 f a a -> m
forall k (f :: k -> * -> *) (a :: k) b a.
Foldable (f a) =>
(b -> a -> b) -> b -> FromTextShow2 f a a -> b
forall k (f :: k -> * -> *) (a :: k) a b.
Foldable (f a) =>
(a -> b -> b) -> b -> FromTextShow2 f a a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: forall a. Num a => FromTextShow2 f a a -> a
$cproduct :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Num a) =>
FromTextShow2 f a a -> a
sum :: forall a. Num a => FromTextShow2 f a a -> a
$csum :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Num a) =>
FromTextShow2 f a a -> a
minimum :: forall a. Ord a => FromTextShow2 f a a -> a
$cminimum :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Ord a) =>
FromTextShow2 f a a -> a
maximum :: forall a. Ord a => FromTextShow2 f a a -> a
$cmaximum :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Ord a) =>
FromTextShow2 f a a -> a
elem :: forall a. Eq a => a -> FromTextShow2 f a a -> Bool
$celem :: forall k (f :: k -> * -> *) (a :: k) a.
(Foldable (f a), Eq a) =>
a -> FromTextShow2 f a a -> Bool
length :: forall a. FromTextShow2 f a a -> Int
$clength :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromTextShow2 f a a -> Int
null :: forall a. FromTextShow2 f a a -> Bool
$cnull :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromTextShow2 f a a -> Bool
toList :: forall a. FromTextShow2 f a a -> [a]
$ctoList :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
FromTextShow2 f a a -> [a]
foldl1 :: forall a. (a -> a -> a) -> FromTextShow2 f a a -> a
$cfoldl1 :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
(a -> a -> a) -> FromTextShow2 f a a -> a
foldr1 :: forall a. (a -> a -> a) -> FromTextShow2 f a a -> a
$cfoldr1 :: forall k (f :: k -> * -> *) (a :: k) a.
Foldable (f a) =>
(a -> a -> a) -> FromTextShow2 f a a -> a
foldl' :: forall b a. (b -> a -> b) -> b -> FromTextShow2 f a a -> b
$cfoldl' :: forall k (f :: k -> * -> *) (a :: k) b a.
Foldable (f a) =>
(b -> a -> b) -> b -> FromTextShow2 f a a -> b
foldl :: forall b a. (b -> a -> b) -> b -> FromTextShow2 f a a -> b
$cfoldl :: forall k (f :: k -> * -> *) (a :: k) b a.
Foldable (f a) =>
(b -> a -> b) -> b -> FromTextShow2 f a a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> FromTextShow2 f a a -> b
$cfoldr' :: forall k (f :: k -> * -> *) (a :: k) a b.
Foldable (f a) =>
(a -> b -> b) -> b -> FromTextShow2 f a a -> b
foldr :: forall a b. (a -> b -> b) -> b -> FromTextShow2 f a a -> b
$cfoldr :: forall k (f :: k -> * -> *) (a :: k) a b.
Foldable (f a) =>
(a -> b -> b) -> b -> FromTextShow2 f a a -> b
foldMap' :: forall m a. Monoid m => (a -> m) -> FromTextShow2 f a a -> m
$cfoldMap' :: forall k (f :: k -> * -> *) (a :: k) m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> FromTextShow2 f a a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> FromTextShow2 f a a -> m
$cfoldMap :: forall k (f :: k -> * -> *) (a :: k) m a.
(Foldable (f a), Monoid m) =>
(a -> m) -> FromTextShow2 f a a -> m
fold :: forall m. Monoid m => FromTextShow2 f a m -> m
$cfold :: forall k (f :: k -> * -> *) (a :: k) m.
(Foldable (f a), Monoid m) =>
FromTextShow2 f a m -> m
Foldable
           , forall a b. a -> FromTextShow2 f a b -> FromTextShow2 f a a
forall a b. (a -> b) -> FromTextShow2 f a a -> FromTextShow2 f a b
forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
a -> FromTextShow2 f a b -> FromTextShow2 f a a
forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
(a -> b) -> FromTextShow2 f a a -> FromTextShow2 f a b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> FromTextShow2 f a b -> FromTextShow2 f a a
$c<$ :: forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
a -> FromTextShow2 f a b -> FromTextShow2 f a a
fmap :: forall a b. (a -> b) -> FromTextShow2 f a a -> FromTextShow2 f a b
$cfmap :: forall k (f :: k -> * -> *) (a :: k) a b.
Functor (f a) =>
(a -> b) -> FromTextShow2 f a a -> FromTextShow2 f a b
Functor
           , forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromTextShow2 f a b -> m Exp
forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromTextShow2 f a b -> Code m (FromTextShow2 f a b)
forall t.
(forall (m :: * -> *). Quote m => t -> m Exp)
-> (forall (m :: * -> *). Quote m => t -> Code m t) -> Lift t
forall (m :: * -> *). Quote m => FromTextShow2 f a b -> m Exp
forall (m :: * -> *).
Quote m =>
FromTextShow2 f a b -> Code m (FromTextShow2 f a b)
liftTyped :: forall (m :: * -> *).
Quote m =>
FromTextShow2 f a b -> Code m (FromTextShow2 f a b)
$cliftTyped :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromTextShow2 f a b -> Code m (FromTextShow2 f a b)
lift :: forall (m :: * -> *). Quote m => FromTextShow2 f a b -> m Exp
$clift :: forall k k (f :: k -> k -> *) (a :: k) (b :: k) (m :: * -> *).
(Lift (f a b), Quote m) =>
FromTextShow2 f a b -> m Exp
Lift
           , forall a b.
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> FromTextShow2 f a b
-> Builder
forall a b.
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [FromTextShow2 f a b]
-> Builder
forall {f :: * -> * -> *} a.
(TextShow2 f, TextShow a) =>
TextShow1 (FromTextShow2 f a)
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> FromTextShow2 f a b
-> Builder
forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [FromTextShow2 f a b]
-> Builder
forall (f :: * -> * -> *).
(forall a. TextShow a => TextShow1 (f a))
-> (forall a b.
    (Int -> a -> Builder)
    -> ([a] -> Builder)
    -> (Int -> b -> Builder)
    -> ([b] -> Builder)
    -> Int
    -> f a b
    -> Builder)
-> (forall a b.
    (Int -> a -> Builder)
    -> ([a] -> Builder)
    -> (Int -> b -> Builder)
    -> ([b] -> Builder)
    -> [f a b]
    -> Builder)
-> TextShow2 f
liftShowbList2 :: forall a b.
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [FromTextShow2 f a b]
-> Builder
$cliftShowbList2 :: forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [FromTextShow2 f a b]
-> Builder
liftShowbPrec2 :: forall a b.
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> FromTextShow2 f a b
-> Builder
$cliftShowbPrec2 :: forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> FromTextShow2 f a b
-> Builder
TextShow2
           , forall {k} {f :: k -> * -> *} {a :: k}.
Traversable (f a) =>
Functor (FromTextShow2 f a)
forall {k} {f :: k -> * -> *} {a :: k}.
Traversable (f a) =>
Foldable (FromTextShow2 f a)
forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a.
(Traversable (f a), Monad m) =>
FromTextShow2 f a (m a) -> m (FromTextShow2 f a a)
forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a.
(Traversable (f a), Applicative f) =>
FromTextShow2 f a (f a) -> f (FromTextShow2 f a a)
forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a b.
(Traversable (f a), Monad m) =>
(a -> m b) -> FromTextShow2 f a a -> m (FromTextShow2 f a b)
forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a b.
(Traversable (f a), Applicative f) =>
(a -> f b) -> FromTextShow2 f a a -> f (FromTextShow2 f a b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow2 f a a -> f (FromTextShow2 f a b)
sequence :: forall (m :: * -> *) a.
Monad m =>
FromTextShow2 f a (m a) -> m (FromTextShow2 f a a)
$csequence :: forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a.
(Traversable (f a), Monad m) =>
FromTextShow2 f a (m a) -> m (FromTextShow2 f a a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> FromTextShow2 f a a -> m (FromTextShow2 f a b)
$cmapM :: forall k (f :: k -> * -> *) (a :: k) (m :: * -> *) a b.
(Traversable (f a), Monad m) =>
(a -> m b) -> FromTextShow2 f a a -> m (FromTextShow2 f a b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
FromTextShow2 f a (f a) -> f (FromTextShow2 f a a)
$csequenceA :: forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a.
(Traversable (f a), Applicative f) =>
FromTextShow2 f a (f a) -> f (FromTextShow2 f a a)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> FromTextShow2 f a a -> f (FromTextShow2 f a b)
$ctraverse :: forall k (f :: k -> * -> *) (a :: k) (f :: * -> *) a b.
(Traversable (f a), Applicative f) =>
(a -> f b) -> FromTextShow2 f a a -> f (FromTextShow2 f a b)
Traversable
#endif
           )

#if __GLASGOW_HASKELL__ < 800
deriving instance TextShow2    f    => TextShow2   (FromTextShow2 f)
deriving instance Functor     (f a) => Functor     (FromTextShow2 f a)
deriving instance Foldable    (f a) => Foldable    (FromTextShow2 f a)
deriving instance Traversable (f a) => Traversable (FromTextShow2 f a)
deriving instance Typeable FromTextShow2
deriving instance ( Data (f a b), Typeable f, Typeable a, Typeable b
                  ) => Data (FromTextShow2 f (a :: *) (b :: *))
#endif

instance Read (f a b) => Read (FromTextShow2 f a b) where
    readPrec :: ReadPrec (FromTextShow2 f a b)
readPrec     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec a
readPrec     :: ReadPrec (f a b))
    readsPrec :: Int -> ReadS (FromTextShow2 f a b)
readsPrec    = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => Int -> ReadS a
readsPrec    :: Int -> ReadS (f a b))
    readList :: ReadS [FromTextShow2 f a b]
readList     = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadS [a]
readList     :: ReadS [f a b])
    readListPrec :: ReadPrec [FromTextShow2 f a b]
readListPrec = coerce :: forall a b. Coercible a b => a -> b
coerce (forall a. Read a => ReadPrec [a]
readListPrec :: ReadPrec [f a b])

#if defined(NEW_FUNCTOR_CLASSES)
-- | Not available if using @transformers-0.4@
--
-- This instance is somewhat strange, as its instance context mixes a
-- 'TextShow2' constraint with 'Show' constraints. The 'Show' constraints are
-- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really,
-- the 'Show' constraints ought to be 'TextShow' constraints instead, but GHC
-- has no way of knowing that the 'TextShow' constraints can be converted to
-- 'Show' constraints when checking superclasses.
--
-- This is all to say: this instance is almost surely not what you want if you
-- are looking to derive a 'Show' instance only via 'TextShow'-related
-- classes. If you wish to do this, derive via 'FromTextShow' instead.
instance (TextShow2 f, Show a, Show b) => Show (FromTextShow2 f a b) where
  showsPrec :: Int -> FromTextShow2 f a b -> ShowS
showsPrec = forall (f :: * -> * -> *) a b.
(Show2 f, Show a, Show b) =>
Int -> f a b -> ShowS
showsPrec2

-- | Not available if using @transformers-0.4@
--
-- This instance is somewhat strange, as its instance context mixes a
-- 'TextShow2' constraint with a 'Show' constraint. The 'Show' constraint is
-- necessary to satisfy the quantified 'Show' superclass in 'Show2'. Really,
-- the 'Show' constraint ought to be a 'TextShow' constraint instead, but GHC
-- has no way of knowing that the 'TextShow' constraint can be converted to a
-- 'Show' constraint when checking superclasses.
--
-- This is all to say: this instance is almost surely not what you want if you
-- are looking to derive a 'Show1' instance only via 'TextShow'-related
-- classes. If you wish to do this, derive via 'FromTextShow1' instead.
instance (TextShow2 f, Show a) => Show1 (FromTextShow2 f a) where
    liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> FromTextShow2 f a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
    liftShowList :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> [FromTextShow2 f a a] -> ShowS
liftShowList = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList

-- | Not available if using @transformers-0.4@
instance TextShow2 f => Show2 (FromTextShow2 f) where
    liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> FromTextShow2 f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 Int
p =
        forall a. (Int -> a -> Builder) -> Int -> a -> ShowS
showbPrecToShowsPrec (forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 (forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> a -> ShowS
sp1)
                                             (forall a. (a -> ShowS) -> a -> Builder
showsToShowb         [a] -> ShowS
sl1)
                                             (forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> b -> ShowS
sp2)
                                             (forall a. (a -> ShowS) -> a -> Builder
showsToShowb         [b] -> ShowS
sl2))
                             Int
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (f :: k -> k -> *) (a :: k) (b :: k).
FromTextShow2 f a b -> f a b
fromTextShow2
    liftShowList2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [FromTextShow2 f a b]
-> ShowS
liftShowList2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 =
        forall a. (a -> Builder) -> a -> ShowS
showbToShows (forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [f a b]
-> Builder
liftShowbList2 (forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> a -> ShowS
sp1)
                                     (forall a. (a -> ShowS) -> a -> Builder
showsToShowb         [a] -> ShowS
sl1)
                                     (forall a. (Int -> a -> ShowS) -> Int -> a -> Builder
showsPrecToShowbPrec Int -> b -> ShowS
sp2)
                                     (forall a. (a -> ShowS) -> a -> Builder
showsToShowb         [b] -> ShowS
sl2))
                     forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. [FromTextShow2 f a b] -> [f a b]
coerceList
      where
        coerceList :: [FromTextShow2 f a b] -> [f a b]
        coerceList :: forall a b. [FromTextShow2 f a b] -> [f a b]
coerceList = coerce :: forall a b. Coercible a b => a -> b
coerce
#endif

instance (TextShow2 f, TextShow a, TextShow b) => TextShow (FromTextShow2 f a b) where
    showbPrec :: Int -> FromTextShow2 f a b -> Builder
showbPrec = forall (f :: * -> * -> *) a b.
(TextShow2 f, TextShow a, TextShow b) =>
Int -> f a b -> Builder
showbPrec2
    showbList :: [FromTextShow2 f a b] -> Builder
showbList = forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [f a b]
-> Builder
liftShowbList2 forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList

instance (TextShow2 f, TextShow a) => TextShow1 (FromTextShow2 f a) where
    liftShowbPrec :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> Int -> FromTextShow2 f a a -> Builder
liftShowbPrec = forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> Int
-> f a b
-> Builder
liftShowbPrec2 forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList
    liftShowbList :: forall a.
(Int -> a -> Builder)
-> ([a] -> Builder) -> [FromTextShow2 f a a] -> Builder
liftShowbList = forall (f :: * -> * -> *) a b.
TextShow2 f =>
(Int -> a -> Builder)
-> ([a] -> Builder)
-> (Int -> b -> Builder)
-> ([b] -> Builder)
-> [f a b]
-> Builder
liftShowbList2 forall a. TextShow a => Int -> a -> Builder
showbPrec forall a. TextShow a => [a] -> Builder
showbList

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

#if !defined(NEW_FUNCTOR_CLASSES)
liftShowsPrec :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS)
              -> Int -> f a -> ShowS
liftShowsPrec _ _ = showsPrec1

liftShowList :: (Show1 f, Show a) => (Int -> a -> ShowS) -> ([a] -> ShowS)
              -> [f a] -> ShowS
liftShowList sp' sl' = showListWith (liftShowsPrec sp' sl' 0)

sp :: Int -> a -> ShowS
sp  = undefined

sl :: [a] -> ShowS
sl  = undefined
#endif

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

$(deriveBifunctor     ''FromStringShow2)
$(deriveBifunctor     ''FromTextShow2)
$(deriveBifoldable    ''FromStringShow2)
$(deriveBifoldable    ''FromTextShow2)
$(deriveBitraversable ''FromStringShow2)
$(deriveBitraversable ''FromTextShow2)

#if __GLASGOW_HASKELL__ < 800
$(deriveLift ''FromStringShow)
$(deriveLift ''FromTextShow)

instance Lift (f a) => Lift (FromStringShow1 f a) where
    lift = $(makeLift ''FromStringShow1)
instance Lift (f a) => Lift (FromTextShow1 f a) where
    lift = $(makeLift ''FromTextShow1)

instance Lift (f a b) => Lift (FromStringShow2 f a b) where
    lift = $(makeLift ''FromStringShow2)
instance Lift (f a b) => Lift (FromTextShow2 f a b) where
    lift = $(makeLift ''FromTextShow2)
#endif

#if !defined(__LANGUAGE_DERIVE_GENERIC1__)
$(Generics.deriveMeta           ''FromStringShow1)
$(Generics.deriveRepresentable1 ''FromStringShow1)
$(Generics.deriveMeta           ''FromTextShow1)
$(Generics.deriveRepresentable1 ''FromTextShow1)
$(Generics.deriveMeta           ''FromStringShow2)
$(Generics.deriveRepresentable1 ''FromStringShow2)
$(Generics.deriveMeta           ''FromTextShow2)
$(Generics.deriveRepresentable1 ''FromTextShow2)
#endif