{-|
Module      : Data.Parsable

This module contains two simple classes, 'Parsable' and 'Printable'.

There is an implicit "soft isomorphism" between 'parser' and 'toString'.
(Successfully parsing a string and then running 'toString' on the result
should result in the original string.)

=== Language extensions

Because 'parser' does not take any arguments, it may be necessary
to explicitly declare the type of @t@ for these functions.

It may be helpful to enable and use the @TypeApplications@ and possibly
@ScopedTypeVariables@ extensions..

Look at the @Language Extensions@ section of the GHC documentation for
instructions on how to use these extensions.
-}

{-# Language DefaultSignatures #-}
{-# Language DeriveDataTypeable #-}
{-# Language DeriveGeneric #-}
{-# Language DeriveTraversable #-}
{-# Language DerivingVia #-}
{-# Language FlexibleContexts #-}
{-# Language FlexibleInstances #-}
{-# Language GeneralizedNewtypeDeriving #-}
{-# Language MultiParamTypeClasses #-}
{-# Language OverloadedStrings #-}
{-# Language QuantifiedConstraints #-}
{-# Language ScopedTypeVariables #-}
{-# Language TypeApplications #-}
{-# Language TypeFamilies #-}
{-# Language UndecidableInstances #-}

module Data.Parsable
    (
    -- * Parsing
      Parsable(..)
    , ParserName(..)
    , runParsableT
    , runParsable
    -- ** Wrappers
    , NaturalParsable(..)
    -- * Parsing functions
    , satisfyAny
    , wordAllowed
    , readParsec
    -- * Printing
    , Printable(..)
    , toText
    -- ** Wrappers
    , ShowPrintable(..)
    -- * Re-exports
    , module Control.Monad
    , module Control.Monad.Trans.Class
    , module Data.Char
    , module Data.Functor.Identity
    , module Data.String
    , module Text.Parsec
    , module Text.Parsec.Char
    ) where

import Control.Applicative hiding (many)
import Control.Monad
import Control.Monad.Trans.Class
import Data.Char
import Data.Data
import Data.Functor.Identity
import Data.Kind
import Data.String
import Data.Text (Text, unpack)
import GHC.Generics
import Text.Parsec
import Text.Parsec.Char
import Text.Read (readMaybe)

newtype ParserName a s u (m :: Type -> Type) = ParserName { forall a s u (m :: * -> *). ParserName a s u m -> String
getParserName :: String }
    deriving stock (Int -> ParserName a s u m -> ShowS
[ParserName a s u m] -> ShowS
ParserName a s u m -> String
(Int -> ParserName a s u m -> ShowS)
-> (ParserName a s u m -> String)
-> ([ParserName a s u m] -> ShowS)
-> Show (ParserName a s u m)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a s u (m :: * -> *). Int -> ParserName a s u m -> ShowS
forall a s u (m :: * -> *). [ParserName a s u m] -> ShowS
forall a s u (m :: * -> *). ParserName a s u m -> String
$cshowsPrec :: forall a s u (m :: * -> *). Int -> ParserName a s u m -> ShowS
showsPrec :: Int -> ParserName a s u m -> ShowS
$cshow :: forall a s u (m :: * -> *). ParserName a s u m -> String
show :: ParserName a s u m -> String
$cshowList :: forall a s u (m :: * -> *). [ParserName a s u m] -> ShowS
showList :: [ParserName a s u m] -> ShowS
Show, ParserName a s u m -> ParserName a s u m -> Bool
(ParserName a s u m -> ParserName a s u m -> Bool)
-> (ParserName a s u m -> ParserName a s u m -> Bool)
-> Eq (ParserName a s u m)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
$c== :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
== :: ParserName a s u m -> ParserName a s u m -> Bool
$c/= :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
/= :: ParserName a s u m -> ParserName a s u m -> Bool
Eq, Eq (ParserName a s u m)
Eq (ParserName a s u m) =>
(ParserName a s u m -> ParserName a s u m -> Ordering)
-> (ParserName a s u m -> ParserName a s u m -> Bool)
-> (ParserName a s u m -> ParserName a s u m -> Bool)
-> (ParserName a s u m -> ParserName a s u m -> Bool)
-> (ParserName a s u m -> ParserName a s u m -> Bool)
-> (ParserName a s u m -> ParserName a s u m -> ParserName a s u m)
-> (ParserName a s u m -> ParserName a s u m -> ParserName a s u m)
-> Ord (ParserName a s u m)
ParserName a s u m -> ParserName a s u m -> Bool
ParserName a s u m -> ParserName a s u m -> Ordering
ParserName a s u m -> ParserName a s u m -> ParserName a s u m
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 s u (m :: * -> *). Eq (ParserName a s u m)
forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Ordering
forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> ParserName a s u m
$ccompare :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Ordering
compare :: ParserName a s u m -> ParserName a s u m -> Ordering
$c< :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
< :: ParserName a s u m -> ParserName a s u m -> Bool
$c<= :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
<= :: ParserName a s u m -> ParserName a s u m -> Bool
$c> :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
> :: ParserName a s u m -> ParserName a s u m -> Bool
$c>= :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> Bool
>= :: ParserName a s u m -> ParserName a s u m -> Bool
$cmax :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> ParserName a s u m
max :: ParserName a s u m -> ParserName a s u m -> ParserName a s u m
$cmin :: forall a s u (m :: * -> *).
ParserName a s u m -> ParserName a s u m -> ParserName a s u m
min :: ParserName a s u m -> ParserName a s u m -> ParserName a s u m
Ord)
    deriving newtype String -> ParserName a s u m
(String -> ParserName a s u m) -> IsString (ParserName a s u m)
forall a. (String -> a) -> IsString a
forall a s u (m :: * -> *). String -> ParserName a s u m
$cfromString :: forall a s u (m :: * -> *). String -> ParserName a s u m
fromString :: String -> ParserName a s u m
IsString

-- | Represents types that have a valid Parsec parser.
class Parsable a (m :: Type -> Type) u s where
    parser :: ParsecT s u m a
    parserName :: ParserName a s u m
    {-# Minimal parser, parserName #-}

newtype NaturalParsable a = NaturalParsable
    { forall a. NaturalParsable a -> a
unwrapNaturalParsable :: a }

instance (Stream s m Char, Read a, Typeable a)
    => Parsable (NaturalParsable a) m u s where
    parserName :: ParserName (NaturalParsable a) s u m
parserName = ParserName (NaturalParsable a) s u m
"natural number"
    parser :: ParsecT s u m (NaturalParsable a)
parser = (ParsecT s u m (NaturalParsable a)
-> String -> ParsecT s u m (NaturalParsable a)
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
"natural number") (ParsecT s u m (NaturalParsable a)
 -> ParsecT s u m (NaturalParsable a))
-> ParsecT s u m (NaturalParsable a)
-> ParsecT s u m (NaturalParsable a)
forall a b. (a -> b) -> a -> b
$ do
        String
ds <- ParsecT s u m Char -> ParsecT s u m String
forall a. ParsecT s u m a -> ParsecT s u m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some ((Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy Char -> Bool
isDigit)
        case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
ds of
            Just a
i -> NaturalParsable a -> ParsecT s u m (NaturalParsable a)
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (NaturalParsable a -> ParsecT s u m (NaturalParsable a))
-> NaturalParsable a -> ParsecT s u m (NaturalParsable a)
forall a b. (a -> b) -> a -> b
$ a -> NaturalParsable a
forall a. a -> NaturalParsable a
NaturalParsable a
i
            Maybe a
Nothing -> String -> ParsecT s u m (NaturalParsable a)
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> ParsecT s u m (NaturalParsable a))
-> String -> ParsecT s u m (NaturalParsable a)
forall a b. (a -> b) -> a -> b
$ String
"Could not parse as " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
t String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
": " String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
ds
      where
        t :: String
t = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

-- | Convenience function to run a 'Parsable' parser.
runParsableT :: forall a m s. (Stream s m Char, Parsable a m () s)
    => String -> s -> m (Either ParseError a)
runParsableT :: forall a (m :: * -> *) s.
(Stream s m Char, Parsable a m () s) =>
String -> s -> m (Either ParseError a)
runParsableT = ParsecT s () m a -> () -> String -> s -> m (Either ParseError a)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> u -> String -> s -> m (Either ParseError a)
runParserT (ParsecT s () m a
forall a (m :: * -> *) u s. Parsable a m u s => ParsecT s u m a
parser ParsecT s () m a -> String -> ParsecT s () m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
n) ()
    where n :: String
n = ParserName a s () m -> String
forall a s u (m :: * -> *). ParserName a s u m -> String
getParserName (ParserName a s () m -> String) -> ParserName a s () m -> String
forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) u s. Parsable a m u s => ParserName a s u m
parserName @a @m @() @s

runParsable :: forall a s. (Stream s Identity Char, Parsable a Identity () s)
    => String -> s -> Either ParseError a
runParsable :: forall a s.
(Stream s Identity Char, Parsable a Identity () s) =>
String -> s -> Either ParseError a
runParsable = Parsec s () a -> () -> String -> s -> Either ParseError a
forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> String -> s -> Either ParseError a
runParser (Parsec s () a
forall a (m :: * -> *) u s. Parsable a m u s => ParsecT s u m a
parser Parsec s () a -> String -> Parsec s () a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
n) ()
    where n :: String
n = ParserName a s () Identity -> String
forall a s u (m :: * -> *). ParserName a s u m -> String
getParserName (ParserName a s () Identity -> String)
-> ParserName a s () Identity -> String
forall a b. (a -> b) -> a -> b
$ forall a (m :: * -> *) u s. Parsable a m u s => ParserName a s u m
parserName @a @Identity @() @s

-- | Pass a previously-parsed string to this function in order to attempt
--   using 'read'. Produces proper error messages on failure.
readParsec :: forall a s u m. (Typeable a, Read a) => String -> ParsecT s u m a
readParsec :: forall a s u (m :: * -> *).
(Typeable a, Read a) =>
String -> ParsecT s u m a
readParsec String
s = (ParsecT s u m a -> String -> ParsecT s u m a
forall s u (m :: * -> *) a.
ParsecT s u m a -> String -> ParsecT s u m a
<?> String
typeName String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" (Read instance)") (ParsecT s u m a -> ParsecT s u m a)
-> ParsecT s u m a -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$
    case String -> Maybe a
forall a. Read a => String -> Maybe a
readMaybe String
s of
        Just a
x -> a -> ParsecT s u m a
forall a. a -> ParsecT s u m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
        Maybe a
Nothing -> String -> ParsecT s u m a
forall a. String -> ParsecT s u m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail
            (String -> ParsecT s u m a) -> String -> ParsecT s u m a
forall a b. (a -> b) -> a -> b
$  String
"unable to parse using "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
typeName
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
" Read instance: "
            String -> ShowS
forall a. [a] -> [a] -> [a]
++ ShowS
forall a. Show a => a -> String
show String
s
    where typeName :: String
typeName = TypeRep -> String
forall a. Show a => a -> String
show (TypeRep -> String) -> TypeRep -> String
forall a b. (a -> b) -> a -> b
$ Proxy a -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy a -> TypeRep) -> Proxy a -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @a

-- | Parse a token that satisfies any of the given predicates
satisfyAny :: Stream s m Char => [Char -> Bool] -> ParsecT s u m Char
satisfyAny :: forall s (m :: * -> *) u.
Stream s m Char =>
[Char -> Bool] -> ParsecT s u m Char
satisfyAny [Char -> Bool]
fs = (Char -> Bool) -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
(Char -> Bool) -> ParsecT s u m Char
satisfy ((Char -> Bool) -> ParsecT s u m Char)
-> (Char -> Bool) -> ParsecT s u m Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> [Bool] -> Bool
forall (t :: * -> *). Foldable t => t Bool -> Bool
or [Char -> Bool
f Char
c | Char -> Bool
f <- [Char -> Bool]
fs]

-- | Parsing of "words" which require a list of predicates for the first
--   token, and a list of predicates for any remaining tokens. This always
--   parses at least one token.
wordAllowed :: Stream s m Char
    => [Char -> Bool] -- ^ Tokens that start the word
    -> [Char -> Bool] -- ^ Any subsequent tokens
    -> ParsecT s u m [Char]
wordAllowed :: forall s (m :: * -> *) u.
Stream s m Char =>
[Char -> Bool] -> [Char -> Bool] -> ParsecT s u m String
wordAllowed [Char -> Bool]
beg [Char -> Bool]
rest = (:) (Char -> ShowS) -> ParsecT s u m Char -> ParsecT s u m ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char -> Bool] -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char -> Bool] -> ParsecT s u m Char
satisfyAny [Char -> Bool]
beg ParsecT s u m ShowS -> ParsecT s u m String -> ParsecT s u m String
forall a b.
ParsecT s u m (a -> b) -> ParsecT s u m a -> ParsecT s u m b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT s u m Char -> ParsecT s u m String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ([Char -> Bool] -> ParsecT s u m Char
forall s (m :: * -> *) u.
Stream s m Char =>
[Char -> Bool] -> ParsecT s u m Char
satisfyAny [Char -> Bool]
rest)

-- | Types that can be converted back to a @String@.
class Printable t where
    toString :: t -> String

    default toString :: Show t => t -> String
    toString = t -> String
forall a. Show a => a -> String
show
    {-# Minimal toString #-}

instance Printable String where
    toString :: ShowS
toString = ShowS
forall a. a -> a
id

instance Printable Text where
    toString :: Text -> String
toString = Text -> String
unpack

-- | Convenience function that will turn a 'Printable' to any 'IsString'.
toText :: (Printable t, IsString s) => t -> s
toText :: forall t s. (Printable t, IsString s) => t -> s
toText = String -> s
forall a. IsString a => String -> a
fromString (String -> s) -> (t -> String) -> t -> s
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> String
forall t. Printable t => t -> String
toString

-- | Wrapper for types that inherit 'toString' directly from their 'Show' instance.
--
--   It is convenient to use the @DerivingVia@ language extension with this.
--
--   > {-# Language DerivingVia #-}
--   >
--   > newtype MyNum Int
--   >     deriving Printable via (ShowPrintable Int) -- Uses Show instance of Int
newtype ShowPrintable a = ShowPrintable
    { forall a. ShowPrintable a -> a
unwrapShowPrintable :: a }
    deriving stock
        ( ReadPrec [ShowPrintable a]
ReadPrec (ShowPrintable a)
Int -> ReadS (ShowPrintable a)
ReadS [ShowPrintable a]
(Int -> ReadS (ShowPrintable a))
-> ReadS [ShowPrintable a]
-> ReadPrec (ShowPrintable a)
-> ReadPrec [ShowPrintable a]
-> Read (ShowPrintable a)
forall a. Read a => ReadPrec [ShowPrintable a]
forall a. Read a => ReadPrec (ShowPrintable a)
forall a. Read a => Int -> ReadS (ShowPrintable a)
forall a. Read a => ReadS [ShowPrintable a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (ShowPrintable a)
readsPrec :: Int -> ReadS (ShowPrintable a)
$creadList :: forall a. Read a => ReadS [ShowPrintable a]
readList :: ReadS [ShowPrintable a]
$creadPrec :: forall a. Read a => ReadPrec (ShowPrintable a)
readPrec :: ReadPrec (ShowPrintable a)
$creadListPrec :: forall a. Read a => ReadPrec [ShowPrintable a]
readListPrec :: ReadPrec [ShowPrintable a]
Read, Int -> ShowPrintable a -> ShowS
[ShowPrintable a] -> ShowS
ShowPrintable a -> String
(Int -> ShowPrintable a -> ShowS)
-> (ShowPrintable a -> String)
-> ([ShowPrintable a] -> ShowS)
-> Show (ShowPrintable a)
forall a. Show a => Int -> ShowPrintable a -> ShowS
forall a. Show a => [ShowPrintable a] -> ShowS
forall a. Show a => ShowPrintable a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> ShowPrintable a -> ShowS
showsPrec :: Int -> ShowPrintable a -> ShowS
$cshow :: forall a. Show a => ShowPrintable a -> String
show :: ShowPrintable a -> String
$cshowList :: forall a. Show a => [ShowPrintable a] -> ShowS
showList :: [ShowPrintable a] -> ShowS
Show, ShowPrintable a -> ShowPrintable a -> Bool
(ShowPrintable a -> ShowPrintable a -> Bool)
-> (ShowPrintable a -> ShowPrintable a -> Bool)
-> Eq (ShowPrintable a)
forall a. Eq a => ShowPrintable a -> ShowPrintable a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => ShowPrintable a -> ShowPrintable a -> Bool
== :: ShowPrintable a -> ShowPrintable a -> Bool
$c/= :: forall a. Eq a => ShowPrintable a -> ShowPrintable a -> Bool
/= :: ShowPrintable a -> ShowPrintable a -> Bool
Eq, Eq (ShowPrintable a)
Eq (ShowPrintable a) =>
(ShowPrintable a -> ShowPrintable a -> Ordering)
-> (ShowPrintable a -> ShowPrintable a -> Bool)
-> (ShowPrintable a -> ShowPrintable a -> Bool)
-> (ShowPrintable a -> ShowPrintable a -> Bool)
-> (ShowPrintable a -> ShowPrintable a -> Bool)
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> Ord (ShowPrintable a)
ShowPrintable a -> ShowPrintable a -> Bool
ShowPrintable a -> ShowPrintable a -> Ordering
ShowPrintable a -> ShowPrintable a -> ShowPrintable 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 (ShowPrintable a)
forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Bool
forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Ordering
forall a.
Ord a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$ccompare :: forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Ordering
compare :: ShowPrintable a -> ShowPrintable a -> Ordering
$c< :: forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Bool
< :: ShowPrintable a -> ShowPrintable a -> Bool
$c<= :: forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Bool
<= :: ShowPrintable a -> ShowPrintable a -> Bool
$c> :: forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Bool
> :: ShowPrintable a -> ShowPrintable a -> Bool
$c>= :: forall a. Ord a => ShowPrintable a -> ShowPrintable a -> Bool
>= :: ShowPrintable a -> ShowPrintable a -> Bool
$cmax :: forall a.
Ord a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
max :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$cmin :: forall a.
Ord a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
min :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
Ord, ShowPrintable a
ShowPrintable a -> ShowPrintable a -> Bounded (ShowPrintable a)
forall a. a -> a -> Bounded a
forall a. Bounded a => ShowPrintable a
$cminBound :: forall a. Bounded a => ShowPrintable a
minBound :: ShowPrintable a
$cmaxBound :: forall a. Bounded a => ShowPrintable a
maxBound :: ShowPrintable a
Bounded, (forall a b. (a -> b) -> ShowPrintable a -> ShowPrintable b)
-> (forall a b. a -> ShowPrintable b -> ShowPrintable a)
-> Functor ShowPrintable
forall a b. a -> ShowPrintable b -> ShowPrintable a
forall a b. (a -> b) -> ShowPrintable a -> ShowPrintable b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> ShowPrintable a -> ShowPrintable b
fmap :: forall a b. (a -> b) -> ShowPrintable a -> ShowPrintable b
$c<$ :: forall a b. a -> ShowPrintable b -> ShowPrintable a
<$ :: forall a b. a -> ShowPrintable b -> ShowPrintable a
Functor, (forall m. Monoid m => ShowPrintable m -> m)
-> (forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m)
-> (forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m)
-> (forall a b. (a -> b -> b) -> b -> ShowPrintable a -> b)
-> (forall a b. (a -> b -> b) -> b -> ShowPrintable a -> b)
-> (forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b)
-> (forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b)
-> (forall a. (a -> a -> a) -> ShowPrintable a -> a)
-> (forall a. (a -> a -> a) -> ShowPrintable a -> a)
-> (forall a. ShowPrintable a -> [a])
-> (forall a. ShowPrintable a -> Bool)
-> (forall a. ShowPrintable a -> Int)
-> (forall a. Eq a => a -> ShowPrintable a -> Bool)
-> (forall a. Ord a => ShowPrintable a -> a)
-> (forall a. Ord a => ShowPrintable a -> a)
-> (forall a. Num a => ShowPrintable a -> a)
-> (forall a. Num a => ShowPrintable a -> a)
-> Foldable ShowPrintable
forall a. Eq a => a -> ShowPrintable a -> Bool
forall a. Num a => ShowPrintable a -> a
forall a. Ord a => ShowPrintable a -> a
forall m. Monoid m => ShowPrintable m -> m
forall a. ShowPrintable a -> Bool
forall a. ShowPrintable a -> Int
forall a. ShowPrintable a -> [a]
forall a. (a -> a -> a) -> ShowPrintable a -> a
forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m
forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b
forall a b. (a -> b -> b) -> b -> ShowPrintable 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
$cfold :: forall m. Monoid m => ShowPrintable m -> m
fold :: forall m. Monoid m => ShowPrintable m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> ShowPrintable a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> ShowPrintable a -> b
foldr :: forall a b. (a -> b -> b) -> b -> ShowPrintable a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> ShowPrintable a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> ShowPrintable a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b
foldl :: forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> ShowPrintable a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> ShowPrintable a -> a
foldr1 :: forall a. (a -> a -> a) -> ShowPrintable a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> ShowPrintable a -> a
foldl1 :: forall a. (a -> a -> a) -> ShowPrintable a -> a
$ctoList :: forall a. ShowPrintable a -> [a]
toList :: forall a. ShowPrintable a -> [a]
$cnull :: forall a. ShowPrintable a -> Bool
null :: forall a. ShowPrintable a -> Bool
$clength :: forall a. ShowPrintable a -> Int
length :: forall a. ShowPrintable a -> Int
$celem :: forall a. Eq a => a -> ShowPrintable a -> Bool
elem :: forall a. Eq a => a -> ShowPrintable a -> Bool
$cmaximum :: forall a. Ord a => ShowPrintable a -> a
maximum :: forall a. Ord a => ShowPrintable a -> a
$cminimum :: forall a. Ord a => ShowPrintable a -> a
minimum :: forall a. Ord a => ShowPrintable a -> a
$csum :: forall a. Num a => ShowPrintable a -> a
sum :: forall a. Num a => ShowPrintable a -> a
$cproduct :: forall a. Num a => ShowPrintable a -> a
product :: forall a. Num a => ShowPrintable a -> a
Foldable, Functor ShowPrintable
Foldable ShowPrintable
(Functor ShowPrintable, Foldable ShowPrintable) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> ShowPrintable a -> f (ShowPrintable b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    ShowPrintable (f a) -> f (ShowPrintable a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> ShowPrintable a -> m (ShowPrintable b))
-> (forall (m :: * -> *) a.
    Monad m =>
    ShowPrintable (m a) -> m (ShowPrintable a))
-> Traversable ShowPrintable
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 =>
ShowPrintable (m a) -> m (ShowPrintable a)
forall (f :: * -> *) a.
Applicative f =>
ShowPrintable (f a) -> f (ShowPrintable a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ShowPrintable a -> m (ShowPrintable b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShowPrintable a -> f (ShowPrintable b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShowPrintable a -> f (ShowPrintable b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> ShowPrintable a -> f (ShowPrintable b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
ShowPrintable (f a) -> f (ShowPrintable a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
ShowPrintable (f a) -> f (ShowPrintable a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ShowPrintable a -> m (ShowPrintable b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> ShowPrintable a -> m (ShowPrintable b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
ShowPrintable (m a) -> m (ShowPrintable a)
sequence :: forall (m :: * -> *) a.
Monad m =>
ShowPrintable (m a) -> m (ShowPrintable a)
Traversable, (forall x. ShowPrintable a -> Rep (ShowPrintable a) x)
-> (forall x. Rep (ShowPrintable a) x -> ShowPrintable a)
-> Generic (ShowPrintable a)
forall x. Rep (ShowPrintable a) x -> ShowPrintable a
forall x. ShowPrintable a -> Rep (ShowPrintable a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (ShowPrintable a) x -> ShowPrintable a
forall a x. ShowPrintable a -> Rep (ShowPrintable a) x
$cfrom :: forall a x. ShowPrintable a -> Rep (ShowPrintable a) x
from :: forall x. ShowPrintable a -> Rep (ShowPrintable a) x
$cto :: forall a x. Rep (ShowPrintable a) x -> ShowPrintable a
to :: forall x. Rep (ShowPrintable a) x -> ShowPrintable a
Generic
        , (forall a. ShowPrintable a -> Rep1 ShowPrintable a)
-> (forall a. Rep1 ShowPrintable a -> ShowPrintable a)
-> Generic1 ShowPrintable
forall a. Rep1 ShowPrintable a -> ShowPrintable a
forall a. ShowPrintable a -> Rep1 ShowPrintable a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cfrom1 :: forall a. ShowPrintable a -> Rep1 ShowPrintable a
from1 :: forall a. ShowPrintable a -> Rep1 ShowPrintable a
$cto1 :: forall a. Rep1 ShowPrintable a -> ShowPrintable a
to1 :: forall a. Rep1 ShowPrintable a -> ShowPrintable a
Generic1, Typeable (ShowPrintable a)
Typeable (ShowPrintable a) =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> ShowPrintable a -> c (ShowPrintable a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (ShowPrintable a))
-> (ShowPrintable a -> Constr)
-> (ShowPrintable a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (ShowPrintable a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (ShowPrintable a)))
-> ((forall b. Data b => b -> b)
    -> ShowPrintable a -> ShowPrintable a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ShowPrintable a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ShowPrintable a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ShowPrintable a -> m (ShowPrintable a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ShowPrintable a -> m (ShowPrintable a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ShowPrintable a -> m (ShowPrintable a))
-> Data (ShowPrintable a)
ShowPrintable a -> Constr
ShowPrintable a -> DataType
(forall b. Data b => b -> b) -> ShowPrintable a -> ShowPrintable a
forall a. Data a => Typeable (ShowPrintable a)
forall a. Data a => ShowPrintable a -> Constr
forall a. Data a => ShowPrintable a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> ShowPrintable a -> ShowPrintable a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> ShowPrintable a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> ShowPrintable a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ShowPrintable a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowPrintable a -> c (ShowPrintable a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ShowPrintable a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ShowPrintable 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 u.
Int -> (forall d. Data d => d -> u) -> ShowPrintable a -> u
forall u. (forall d. Data d => d -> u) -> ShowPrintable a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ShowPrintable a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowPrintable a -> c (ShowPrintable a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ShowPrintable a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ShowPrintable a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowPrintable a -> c (ShowPrintable a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ShowPrintable a -> c (ShowPrintable a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ShowPrintable a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (ShowPrintable a)
$ctoConstr :: forall a. Data a => ShowPrintable a -> Constr
toConstr :: ShowPrintable a -> Constr
$cdataTypeOf :: forall a. Data a => ShowPrintable a -> DataType
dataTypeOf :: ShowPrintable a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (ShowPrintable a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (ShowPrintable a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ShowPrintable a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (ShowPrintable a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> ShowPrintable a -> ShowPrintable a
gmapT :: (forall b. Data b => b -> b) -> ShowPrintable a -> ShowPrintable a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ShowPrintable a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> ShowPrintable a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ShowPrintable a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> ShowPrintable a -> u
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ShowPrintable a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ShowPrintable a -> m (ShowPrintable a)
Data
        )
    deriving newtype (Int -> ShowPrintable a
ShowPrintable a -> Int
ShowPrintable a -> [ShowPrintable a]
ShowPrintable a -> ShowPrintable a
ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
ShowPrintable a
-> ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
(ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (Int -> ShowPrintable a)
-> (ShowPrintable a -> Int)
-> (ShowPrintable a -> [ShowPrintable a])
-> (ShowPrintable a -> ShowPrintable a -> [ShowPrintable a])
-> (ShowPrintable a -> ShowPrintable a -> [ShowPrintable a])
-> (ShowPrintable a
    -> ShowPrintable a -> ShowPrintable a -> [ShowPrintable a])
-> Enum (ShowPrintable a)
forall a. Enum a => Int -> ShowPrintable a
forall a. Enum a => ShowPrintable a -> Int
forall a. Enum a => ShowPrintable a -> [ShowPrintable a]
forall a. Enum a => ShowPrintable a -> ShowPrintable a
forall a.
Enum a =>
ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
forall a.
Enum a =>
ShowPrintable a
-> ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: forall a. Enum a => ShowPrintable a -> ShowPrintable a
succ :: ShowPrintable a -> ShowPrintable a
$cpred :: forall a. Enum a => ShowPrintable a -> ShowPrintable a
pred :: ShowPrintable a -> ShowPrintable a
$ctoEnum :: forall a. Enum a => Int -> ShowPrintable a
toEnum :: Int -> ShowPrintable a
$cfromEnum :: forall a. Enum a => ShowPrintable a -> Int
fromEnum :: ShowPrintable a -> Int
$cenumFrom :: forall a. Enum a => ShowPrintable a -> [ShowPrintable a]
enumFrom :: ShowPrintable a -> [ShowPrintable a]
$cenumFromThen :: forall a.
Enum a =>
ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
enumFromThen :: ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
$cenumFromTo :: forall a.
Enum a =>
ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
enumFromTo :: ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
$cenumFromThenTo :: forall a.
Enum a =>
ShowPrintable a
-> ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
enumFromThenTo :: ShowPrintable a
-> ShowPrintable a -> ShowPrintable a -> [ShowPrintable a]
Enum, Integer -> ShowPrintable a
ShowPrintable a -> ShowPrintable a
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
(ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (Integer -> ShowPrintable a)
-> Num (ShowPrintable a)
forall a. Num a => Integer -> ShowPrintable a
forall a. Num a => ShowPrintable a -> ShowPrintable a
forall a.
Num a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: forall a.
Num a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
+ :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$c- :: forall a.
Num a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
- :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$c* :: forall a.
Num a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
* :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$cnegate :: forall a. Num a => ShowPrintable a -> ShowPrintable a
negate :: ShowPrintable a -> ShowPrintable a
$cabs :: forall a. Num a => ShowPrintable a -> ShowPrintable a
abs :: ShowPrintable a -> ShowPrintable a
$csignum :: forall a. Num a => ShowPrintable a -> ShowPrintable a
signum :: ShowPrintable a -> ShowPrintable a
$cfromInteger :: forall a. Num a => Integer -> ShowPrintable a
fromInteger :: Integer -> ShowPrintable a
Num, Num (ShowPrintable a)
Num (ShowPrintable a) =>
(ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (Rational -> ShowPrintable a)
-> Fractional (ShowPrintable a)
Rational -> ShowPrintable a
ShowPrintable a -> ShowPrintable a
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a. Fractional a => Num (ShowPrintable a)
forall a. Fractional a => Rational -> ShowPrintable a
forall a. Fractional a => ShowPrintable a -> ShowPrintable a
forall a.
Fractional a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a.
Num a =>
(a -> a -> a) -> (a -> a) -> (Rational -> a) -> Fractional a
$c/ :: forall a.
Fractional a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
/ :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$crecip :: forall a. Fractional a => ShowPrintable a -> ShowPrintable a
recip :: ShowPrintable a -> ShowPrintable a
$cfromRational :: forall a. Fractional a => Rational -> ShowPrintable a
fromRational :: Rational -> ShowPrintable a
Fractional, Fractional (ShowPrintable a)
ShowPrintable a
Fractional (ShowPrintable a) =>
ShowPrintable a
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> (ShowPrintable a -> ShowPrintable a)
-> Floating (ShowPrintable a)
ShowPrintable a -> ShowPrintable a
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a. Floating a => Fractional (ShowPrintable a)
forall a. Floating a => ShowPrintable a
forall a. Floating a => ShowPrintable a -> ShowPrintable a
forall a.
Floating a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a.
Fractional a =>
a
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> Floating a
$cpi :: forall a. Floating a => ShowPrintable a
pi :: ShowPrintable a
$cexp :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
exp :: ShowPrintable a -> ShowPrintable a
$clog :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
log :: ShowPrintable a -> ShowPrintable a
$csqrt :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
sqrt :: ShowPrintable a -> ShowPrintable a
$c** :: forall a.
Floating a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
** :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$clogBase :: forall a.
Floating a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
logBase :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$csin :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
sin :: ShowPrintable a -> ShowPrintable a
$ccos :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
cos :: ShowPrintable a -> ShowPrintable a
$ctan :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
tan :: ShowPrintable a -> ShowPrintable a
$casin :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
asin :: ShowPrintable a -> ShowPrintable a
$cacos :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
acos :: ShowPrintable a -> ShowPrintable a
$catan :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
atan :: ShowPrintable a -> ShowPrintable a
$csinh :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
sinh :: ShowPrintable a -> ShowPrintable a
$ccosh :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
cosh :: ShowPrintable a -> ShowPrintable a
$ctanh :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
tanh :: ShowPrintable a -> ShowPrintable a
$casinh :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
asinh :: ShowPrintable a -> ShowPrintable a
$cacosh :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
acosh :: ShowPrintable a -> ShowPrintable a
$catanh :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
atanh :: ShowPrintable a -> ShowPrintable a
$clog1p :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
log1p :: ShowPrintable a -> ShowPrintable a
$cexpm1 :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
expm1 :: ShowPrintable a -> ShowPrintable a
$clog1pexp :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
log1pexp :: ShowPrintable a -> ShowPrintable a
$clog1mexp :: forall a. Floating a => ShowPrintable a -> ShowPrintable a
log1mexp :: ShowPrintable a -> ShowPrintable a
Floating, String -> ShowPrintable a
(String -> ShowPrintable a) -> IsString (ShowPrintable a)
forall a. IsString a => String -> ShowPrintable a
forall a. (String -> a) -> IsString a
$cfromString :: forall a. IsString a => String -> ShowPrintable a
fromString :: String -> ShowPrintable a
IsString, NonEmpty (ShowPrintable a) -> ShowPrintable a
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
(ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> (NonEmpty (ShowPrintable a) -> ShowPrintable a)
-> (forall b.
    Integral b =>
    b -> ShowPrintable a -> ShowPrintable a)
-> Semigroup (ShowPrintable a)
forall b. Integral b => b -> ShowPrintable a -> ShowPrintable a
forall a.
Semigroup a =>
NonEmpty (ShowPrintable a) -> ShowPrintable a
forall a.
Semigroup a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a b.
(Semigroup a, Integral b) =>
b -> ShowPrintable a -> ShowPrintable a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
$c<> :: forall a.
Semigroup a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
<> :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$csconcat :: forall a.
Semigroup a =>
NonEmpty (ShowPrintable a) -> ShowPrintable a
sconcat :: NonEmpty (ShowPrintable a) -> ShowPrintable a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> ShowPrintable a -> ShowPrintable a
stimes :: forall b. Integral b => b -> ShowPrintable a -> ShowPrintable a
Semigroup, Semigroup (ShowPrintable a)
ShowPrintable a
Semigroup (ShowPrintable a) =>
ShowPrintable a
-> (ShowPrintable a -> ShowPrintable a -> ShowPrintable a)
-> ([ShowPrintable a] -> ShowPrintable a)
-> Monoid (ShowPrintable a)
[ShowPrintable a] -> ShowPrintable a
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
forall a.
Semigroup a =>
a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (ShowPrintable a)
forall a. Monoid a => ShowPrintable a
forall a. Monoid a => [ShowPrintable a] -> ShowPrintable a
forall a.
Monoid a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$cmempty :: forall a. Monoid a => ShowPrintable a
mempty :: ShowPrintable a
$cmappend :: forall a.
Monoid a =>
ShowPrintable a -> ShowPrintable a -> ShowPrintable a
mappend :: ShowPrintable a -> ShowPrintable a -> ShowPrintable a
$cmconcat :: forall a. Monoid a => [ShowPrintable a] -> ShowPrintable a
mconcat :: [ShowPrintable a] -> ShowPrintable a
Monoid)
    deriving (Functor ShowPrintable
Functor ShowPrintable =>
(forall a. a -> ShowPrintable a)
-> (forall a b.
    ShowPrintable (a -> b) -> ShowPrintable a -> ShowPrintable b)
-> (forall a b c.
    (a -> b -> c)
    -> ShowPrintable a -> ShowPrintable b -> ShowPrintable c)
-> (forall a b.
    ShowPrintable a -> ShowPrintable b -> ShowPrintable b)
-> (forall a b.
    ShowPrintable a -> ShowPrintable b -> ShowPrintable a)
-> Applicative ShowPrintable
forall a. a -> ShowPrintable a
forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable a
forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable b
forall a b.
ShowPrintable (a -> b) -> ShowPrintable a -> ShowPrintable b
forall a b c.
(a -> b -> c)
-> ShowPrintable a -> ShowPrintable b -> ShowPrintable c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> ShowPrintable a
pure :: forall a. a -> ShowPrintable a
$c<*> :: forall a b.
ShowPrintable (a -> b) -> ShowPrintable a -> ShowPrintable b
<*> :: forall a b.
ShowPrintable (a -> b) -> ShowPrintable a -> ShowPrintable b
$cliftA2 :: forall a b c.
(a -> b -> c)
-> ShowPrintable a -> ShowPrintable b -> ShowPrintable c
liftA2 :: forall a b c.
(a -> b -> c)
-> ShowPrintable a -> ShowPrintable b -> ShowPrintable c
$c*> :: forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable b
*> :: forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable b
$c<* :: forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable a
<* :: forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable a
Applicative, Applicative ShowPrintable
Applicative ShowPrintable =>
(forall a b.
 ShowPrintable a -> (a -> ShowPrintable b) -> ShowPrintable b)
-> (forall a b.
    ShowPrintable a -> ShowPrintable b -> ShowPrintable b)
-> (forall a. a -> ShowPrintable a)
-> Monad ShowPrintable
forall a. a -> ShowPrintable a
forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable b
forall a b.
ShowPrintable a -> (a -> ShowPrintable b) -> ShowPrintable b
forall (m :: * -> *).
Applicative m =>
(forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b.
ShowPrintable a -> (a -> ShowPrintable b) -> ShowPrintable b
>>= :: forall a b.
ShowPrintable a -> (a -> ShowPrintable b) -> ShowPrintable b
$c>> :: forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable b
>> :: forall a b. ShowPrintable a -> ShowPrintable b -> ShowPrintable b
$creturn :: forall a. a -> ShowPrintable a
return :: forall a. a -> ShowPrintable a
Monad) via Identity

-- | Uses 'show' after unwrapping the contents.
instance Show a => Printable (ShowPrintable a) where
    toString :: ShowPrintable a -> String
toString = a -> String
forall a. Show a => a -> String
show (a -> String)
-> (ShowPrintable a -> a) -> ShowPrintable a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowPrintable a -> a
forall a. ShowPrintable a -> a
unwrapShowPrintable