{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DefaultSignatures #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE Safe #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- |
-- Module      : Data.Char.Core
-- Description : A module that defines data structures used in the other modules.
-- Maintainer  : hapytexeu+gh@gmail.com
-- Stability   : experimental
-- Portability : POSIX
--
-- This module defines data structures that are used in other modules, for example to rotate the characters.
module Data.Char.Core
  ( -- * Possible rotations
    Orientation (Horizontal, Vertical),
    Rotate90 (R0, R90, R180, R270),

    -- * Rotated objects
    Oriented (Oriented, oobject, orientation),
    Rotated (Rotated, robject, rotation),

    -- * Letter case
    LetterCase (UpperCase, LowerCase),
    splitLetterCase,

    -- * Ligating
    Ligate (Ligate, NoLigate),
    splitLigate,
    ligate,
    ligateF,

    -- * Types of fonts
    Emphasis (NoBold, Bold),
    splitEmphasis,
    ItalicType (NoItalic, Italic),
    splitItalicType,
    FontStyle (SansSerif, Serif),
    splitFontStyle,

    -- * Character range checks
    isAsciiAlphaNum,
    isAsciiAlpha,
    isGreek,
    isACharacter,
    isNotACharacter,
    isReserved,
    isNotReserved,

    -- * Map characters from and to 'Enum's
    mapFromEnum,
    mapToEnum,
    mapToEnumSafe,
    liftNumberFrom,
    liftNumberFrom',
    liftNumber,
    liftNumber',
    liftDigit,
    liftDigit',
    liftUppercase,
    liftUppercase',
    liftLowercase,
    liftLowercase',
    liftUpperLowercase,
    liftUpperLowercase',

    -- * Convert objects from and to Unicode 'Char'acters
    UnicodeCharacter (toUnicodeChar, fromUnicodeChar, fromUnicodeChar', isInCharRange),
    UnicodeChar,
    UnicodeText (toUnicodeText, fromUnicodeText, fromUnicodeText', isInTextRange),
    generateIsInTextRange,
    generateIsInTextRange',

    -- * Mirroring items horizontally and/or vertically
    MirrorHorizontal (mirrorHorizontal),
    MirrorVertical (mirrorVertical),

    -- * Ways to display numbers
    PlusStyle (WithoutPlus, WithPlus),
    splitPlusStyle,

    -- * Functions to implement a number system
    withSign,
    signValueSystem,
    positionalNumberSystem,
    positionalNumberSystem10,

    -- * Re-export of some functions of the 'Data.Char' module
    chr,
    isAlpha,
    isAlphaNum,
    isAscii,
    ord,
  )
where

import Control.DeepSeq (NFData, NFData1)
import Data.Bits ((.&.))
import Data.Char (chr, isAlpha, isAlphaNum, isAscii, isAsciiLower, isAsciiUpper, ord)
import Data.Data (Data)
import Data.Default.Class (Default (def))
import Data.Functor.Classes (Eq1 (liftEq), Ord1 (liftCompare))
import Data.Hashable (Hashable)
import Data.Hashable.Lifted (Hashable1)
import Data.Maybe (fromJust, isJust)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text (Text, cons, null, pack, singleton, snoc, uncons, unpack)
import GHC.Generics (Generic, Generic1)
import Test.QuickCheck.Arbitrary (Arbitrary (arbitrary), Arbitrary1 (liftArbitrary), arbitrary1, arbitraryBoundedEnum)
import Prelude hiding (null)

-- | Specify whether we write a value in 'UpperCase' or 'LowerCase'. The
-- 'Default' is 'UpperCase', since for example often Roman numerals are written
-- in /upper case/.
data LetterCase
  = -- | The /upper case/ formatting.
    UpperCase
  | -- | The /lower case/ formatting.
    LowerCase
  deriving (LetterCase
LetterCase -> LetterCase -> Bounded LetterCase
forall a. a -> a -> Bounded a
$cminBound :: LetterCase
minBound :: LetterCase
$cmaxBound :: LetterCase
maxBound :: LetterCase
Bounded, Typeable LetterCase
Typeable LetterCase
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LetterCase -> c LetterCase)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LetterCase)
-> (LetterCase -> Constr)
-> (LetterCase -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LetterCase))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LetterCase))
-> ((forall b. Data b => b -> b) -> LetterCase -> LetterCase)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LetterCase -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LetterCase -> r)
-> (forall u. (forall d. Data d => d -> u) -> LetterCase -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LetterCase -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LetterCase -> m LetterCase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetterCase -> m LetterCase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetterCase -> m LetterCase)
-> Data LetterCase
LetterCase -> Constr
LetterCase -> DataType
(forall b. Data b => b -> b) -> LetterCase -> LetterCase
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) -> LetterCase -> u
forall u. (forall d. Data d => d -> u) -> LetterCase -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterCase
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterCase -> c LetterCase
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterCase)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterCase)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterCase -> c LetterCase
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterCase -> c LetterCase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterCase
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterCase
$ctoConstr :: LetterCase -> Constr
toConstr :: LetterCase -> Constr
$cdataTypeOf :: LetterCase -> DataType
dataTypeOf :: LetterCase -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterCase)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterCase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterCase)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterCase)
$cgmapT :: (forall b. Data b => b -> b) -> LetterCase -> LetterCase
gmapT :: (forall b. Data b => b -> b) -> LetterCase -> LetterCase
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetterCase -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> LetterCase -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterCase -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterCase -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
Data, Int -> LetterCase
LetterCase -> Int
LetterCase -> [LetterCase]
LetterCase -> LetterCase
LetterCase -> LetterCase -> [LetterCase]
LetterCase -> LetterCase -> LetterCase -> [LetterCase]
(LetterCase -> LetterCase)
-> (LetterCase -> LetterCase)
-> (Int -> LetterCase)
-> (LetterCase -> Int)
-> (LetterCase -> [LetterCase])
-> (LetterCase -> LetterCase -> [LetterCase])
-> (LetterCase -> LetterCase -> [LetterCase])
-> (LetterCase -> LetterCase -> LetterCase -> [LetterCase])
-> Enum LetterCase
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 :: LetterCase -> LetterCase
succ :: LetterCase -> LetterCase
$cpred :: LetterCase -> LetterCase
pred :: LetterCase -> LetterCase
$ctoEnum :: Int -> LetterCase
toEnum :: Int -> LetterCase
$cfromEnum :: LetterCase -> Int
fromEnum :: LetterCase -> Int
$cenumFrom :: LetterCase -> [LetterCase]
enumFrom :: LetterCase -> [LetterCase]
$cenumFromThen :: LetterCase -> LetterCase -> [LetterCase]
enumFromThen :: LetterCase -> LetterCase -> [LetterCase]
$cenumFromTo :: LetterCase -> LetterCase -> [LetterCase]
enumFromTo :: LetterCase -> LetterCase -> [LetterCase]
$cenumFromThenTo :: LetterCase -> LetterCase -> LetterCase -> [LetterCase]
enumFromThenTo :: LetterCase -> LetterCase -> LetterCase -> [LetterCase]
Enum, LetterCase -> LetterCase -> Bool
(LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool) -> Eq LetterCase
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LetterCase -> LetterCase -> Bool
== :: LetterCase -> LetterCase -> Bool
$c/= :: LetterCase -> LetterCase -> Bool
/= :: LetterCase -> LetterCase -> Bool
Eq, (forall x. LetterCase -> Rep LetterCase x)
-> (forall x. Rep LetterCase x -> LetterCase) -> Generic LetterCase
forall x. Rep LetterCase x -> LetterCase
forall x. LetterCase -> Rep LetterCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LetterCase -> Rep LetterCase x
from :: forall x. LetterCase -> Rep LetterCase x
$cto :: forall x. Rep LetterCase x -> LetterCase
to :: forall x. Rep LetterCase x -> LetterCase
Generic, Eq LetterCase
Eq LetterCase
-> (LetterCase -> LetterCase -> Ordering)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> LetterCase)
-> (LetterCase -> LetterCase -> LetterCase)
-> Ord LetterCase
LetterCase -> LetterCase -> Bool
LetterCase -> LetterCase -> Ordering
LetterCase -> LetterCase -> LetterCase
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
$ccompare :: LetterCase -> LetterCase -> Ordering
compare :: LetterCase -> LetterCase -> Ordering
$c< :: LetterCase -> LetterCase -> Bool
< :: LetterCase -> LetterCase -> Bool
$c<= :: LetterCase -> LetterCase -> Bool
<= :: LetterCase -> LetterCase -> Bool
$c> :: LetterCase -> LetterCase -> Bool
> :: LetterCase -> LetterCase -> Bool
$c>= :: LetterCase -> LetterCase -> Bool
>= :: LetterCase -> LetterCase -> Bool
$cmax :: LetterCase -> LetterCase -> LetterCase
max :: LetterCase -> LetterCase -> LetterCase
$cmin :: LetterCase -> LetterCase -> LetterCase
min :: LetterCase -> LetterCase -> LetterCase
Ord, ReadPrec [LetterCase]
ReadPrec LetterCase
Int -> ReadS LetterCase
ReadS [LetterCase]
(Int -> ReadS LetterCase)
-> ReadS [LetterCase]
-> ReadPrec LetterCase
-> ReadPrec [LetterCase]
-> Read LetterCase
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LetterCase
readsPrec :: Int -> ReadS LetterCase
$creadList :: ReadS [LetterCase]
readList :: ReadS [LetterCase]
$creadPrec :: ReadPrec LetterCase
readPrec :: ReadPrec LetterCase
$creadListPrec :: ReadPrec [LetterCase]
readListPrec :: ReadPrec [LetterCase]
Read, Int -> LetterCase -> ShowS
[LetterCase] -> ShowS
LetterCase -> String
(Int -> LetterCase -> ShowS)
-> (LetterCase -> String)
-> ([LetterCase] -> ShowS)
-> Show LetterCase
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LetterCase -> ShowS
showsPrec :: Int -> LetterCase -> ShowS
$cshow :: LetterCase -> String
show :: LetterCase -> String
$cshowList :: [LetterCase] -> ShowS
showList :: [LetterCase] -> ShowS
Show)

instance Hashable LetterCase

instance NFData LetterCase

-- | Pick one of the two values based on the 'LetterCase' value.
splitLetterCase ::
  -- | The value to return in case of 'UpperCase'.
  a ->
  -- | The value to return in case of 'LowerCase'.
  a ->
  -- | The given /letter case/.
  LetterCase ->
  -- | One of the two given values, depending on the 'LetterCase' value.
  a
splitLetterCase :: forall a. a -> a -> LetterCase -> a
splitLetterCase a
x a
y = LetterCase -> a
go
  where
    go :: LetterCase -> a
go LetterCase
UpperCase = a
x
    go LetterCase
LowerCase = a
y

-- | Specify whether we write a positive number /with/ or /without/ a plus sign.
-- the 'Default' is 'WithoutPlus'.
data PlusStyle
  = -- | Write positive numbers /without/ using a plus sign.
    WithoutPlus
  | -- | Write positive numbers /with/ a plus sign.
    WithPlus
  deriving (PlusStyle
PlusStyle -> PlusStyle -> Bounded PlusStyle
forall a. a -> a -> Bounded a
$cminBound :: PlusStyle
minBound :: PlusStyle
$cmaxBound :: PlusStyle
maxBound :: PlusStyle
Bounded, Typeable PlusStyle
Typeable PlusStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PlusStyle -> c PlusStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PlusStyle)
-> (PlusStyle -> Constr)
-> (PlusStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PlusStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle))
-> ((forall b. Data b => b -> b) -> PlusStyle -> PlusStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PlusStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PlusStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PlusStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle)
-> Data PlusStyle
PlusStyle -> Constr
PlusStyle -> DataType
(forall b. Data b => b -> b) -> PlusStyle -> PlusStyle
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) -> PlusStyle -> u
forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlusStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlusStyle -> c PlusStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlusStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlusStyle -> c PlusStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlusStyle -> c PlusStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlusStyle
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlusStyle
$ctoConstr :: PlusStyle -> Constr
toConstr :: PlusStyle -> Constr
$cdataTypeOf :: PlusStyle -> DataType
dataTypeOf :: PlusStyle -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlusStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlusStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle)
$cgmapT :: (forall b. Data b => b -> b) -> PlusStyle -> PlusStyle
gmapT :: (forall b. Data b => b -> b) -> PlusStyle -> PlusStyle
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlusStyle -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlusStyle -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
Data, Int -> PlusStyle
PlusStyle -> Int
PlusStyle -> [PlusStyle]
PlusStyle -> PlusStyle
PlusStyle -> PlusStyle -> [PlusStyle]
PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle]
(PlusStyle -> PlusStyle)
-> (PlusStyle -> PlusStyle)
-> (Int -> PlusStyle)
-> (PlusStyle -> Int)
-> (PlusStyle -> [PlusStyle])
-> (PlusStyle -> PlusStyle -> [PlusStyle])
-> (PlusStyle -> PlusStyle -> [PlusStyle])
-> (PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle])
-> Enum PlusStyle
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 :: PlusStyle -> PlusStyle
succ :: PlusStyle -> PlusStyle
$cpred :: PlusStyle -> PlusStyle
pred :: PlusStyle -> PlusStyle
$ctoEnum :: Int -> PlusStyle
toEnum :: Int -> PlusStyle
$cfromEnum :: PlusStyle -> Int
fromEnum :: PlusStyle -> Int
$cenumFrom :: PlusStyle -> [PlusStyle]
enumFrom :: PlusStyle -> [PlusStyle]
$cenumFromThen :: PlusStyle -> PlusStyle -> [PlusStyle]
enumFromThen :: PlusStyle -> PlusStyle -> [PlusStyle]
$cenumFromTo :: PlusStyle -> PlusStyle -> [PlusStyle]
enumFromTo :: PlusStyle -> PlusStyle -> [PlusStyle]
$cenumFromThenTo :: PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle]
enumFromThenTo :: PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle]
Enum, PlusStyle -> PlusStyle -> Bool
(PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool) -> Eq PlusStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PlusStyle -> PlusStyle -> Bool
== :: PlusStyle -> PlusStyle -> Bool
$c/= :: PlusStyle -> PlusStyle -> Bool
/= :: PlusStyle -> PlusStyle -> Bool
Eq, (forall x. PlusStyle -> Rep PlusStyle x)
-> (forall x. Rep PlusStyle x -> PlusStyle) -> Generic PlusStyle
forall x. Rep PlusStyle x -> PlusStyle
forall x. PlusStyle -> Rep PlusStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. PlusStyle -> Rep PlusStyle x
from :: forall x. PlusStyle -> Rep PlusStyle x
$cto :: forall x. Rep PlusStyle x -> PlusStyle
to :: forall x. Rep PlusStyle x -> PlusStyle
Generic, Eq PlusStyle
Eq PlusStyle
-> (PlusStyle -> PlusStyle -> Ordering)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> PlusStyle)
-> (PlusStyle -> PlusStyle -> PlusStyle)
-> Ord PlusStyle
PlusStyle -> PlusStyle -> Bool
PlusStyle -> PlusStyle -> Ordering
PlusStyle -> PlusStyle -> PlusStyle
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
$ccompare :: PlusStyle -> PlusStyle -> Ordering
compare :: PlusStyle -> PlusStyle -> Ordering
$c< :: PlusStyle -> PlusStyle -> Bool
< :: PlusStyle -> PlusStyle -> Bool
$c<= :: PlusStyle -> PlusStyle -> Bool
<= :: PlusStyle -> PlusStyle -> Bool
$c> :: PlusStyle -> PlusStyle -> Bool
> :: PlusStyle -> PlusStyle -> Bool
$c>= :: PlusStyle -> PlusStyle -> Bool
>= :: PlusStyle -> PlusStyle -> Bool
$cmax :: PlusStyle -> PlusStyle -> PlusStyle
max :: PlusStyle -> PlusStyle -> PlusStyle
$cmin :: PlusStyle -> PlusStyle -> PlusStyle
min :: PlusStyle -> PlusStyle -> PlusStyle
Ord, ReadPrec [PlusStyle]
ReadPrec PlusStyle
Int -> ReadS PlusStyle
ReadS [PlusStyle]
(Int -> ReadS PlusStyle)
-> ReadS [PlusStyle]
-> ReadPrec PlusStyle
-> ReadPrec [PlusStyle]
-> Read PlusStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PlusStyle
readsPrec :: Int -> ReadS PlusStyle
$creadList :: ReadS [PlusStyle]
readList :: ReadS [PlusStyle]
$creadPrec :: ReadPrec PlusStyle
readPrec :: ReadPrec PlusStyle
$creadListPrec :: ReadPrec [PlusStyle]
readListPrec :: ReadPrec [PlusStyle]
Read, Int -> PlusStyle -> ShowS
[PlusStyle] -> ShowS
PlusStyle -> String
(Int -> PlusStyle -> ShowS)
-> (PlusStyle -> String)
-> ([PlusStyle] -> ShowS)
-> Show PlusStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PlusStyle -> ShowS
showsPrec :: Int -> PlusStyle -> ShowS
$cshow :: PlusStyle -> String
show :: PlusStyle -> String
$cshowList :: [PlusStyle] -> ShowS
showList :: [PlusStyle] -> ShowS
Show)

instance Hashable PlusStyle

instance NFData PlusStyle

-- | Pick one of the two values based on the 't:PlusStyle' value.
splitPlusStyle ::
  -- | The value to return in case of 'WithoutPlus'.
  a ->
  -- | The value to return in case of 'WithPlus'.
  a ->
  -- | The plus style.
  PlusStyle ->
  -- | One of the two given values, based on the 't:PlusStyle' value.
  a
splitPlusStyle :: forall a. a -> a -> PlusStyle -> a
splitPlusStyle a
x a
y = PlusStyle -> a
go
  where
    go :: PlusStyle -> a
go PlusStyle
WithoutPlus = a
x
    go PlusStyle
WithPlus = a
y

-- | The possible orientations of a unicode character, these can be
-- /horizontal/, or /vertical/.
data Orientation
  = -- | /Horizontal/ orientation.
    Horizontal
  | -- | /Vertical/ orientation.
    Vertical
  deriving (Orientation
Orientation -> Orientation -> Bounded Orientation
forall a. a -> a -> Bounded a
$cminBound :: Orientation
minBound :: Orientation
$cmaxBound :: Orientation
maxBound :: Orientation
Bounded, Typeable Orientation
Typeable Orientation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Orientation -> c Orientation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Orientation)
-> (Orientation -> Constr)
-> (Orientation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Orientation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Orientation))
-> ((forall b. Data b => b -> b) -> Orientation -> Orientation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Orientation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Orientation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Orientation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Orientation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Orientation -> m Orientation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Orientation -> m Orientation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Orientation -> m Orientation)
-> Data Orientation
Orientation -> Constr
Orientation -> DataType
(forall b. Data b => b -> b) -> Orientation -> Orientation
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) -> Orientation -> u
forall u. (forall d. Data d => d -> u) -> Orientation -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Orientation
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Orientation -> c Orientation
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Orientation)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Orientation)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Orientation -> c Orientation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Orientation -> c Orientation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Orientation
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Orientation
$ctoConstr :: Orientation -> Constr
toConstr :: Orientation -> Constr
$cdataTypeOf :: Orientation -> DataType
dataTypeOf :: Orientation -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Orientation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Orientation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Orientation)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Orientation)
$cgmapT :: (forall b. Data b => b -> b) -> Orientation -> Orientation
gmapT :: (forall b. Data b => b -> b) -> Orientation -> Orientation
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Orientation -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Orientation -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Orientation -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Orientation -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
Data, Int -> Orientation
Orientation -> Int
Orientation -> [Orientation]
Orientation -> Orientation
Orientation -> Orientation -> [Orientation]
Orientation -> Orientation -> Orientation -> [Orientation]
(Orientation -> Orientation)
-> (Orientation -> Orientation)
-> (Int -> Orientation)
-> (Orientation -> Int)
-> (Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> Orientation -> [Orientation])
-> Enum Orientation
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 :: Orientation -> Orientation
succ :: Orientation -> Orientation
$cpred :: Orientation -> Orientation
pred :: Orientation -> Orientation
$ctoEnum :: Int -> Orientation
toEnum :: Int -> Orientation
$cfromEnum :: Orientation -> Int
fromEnum :: Orientation -> Int
$cenumFrom :: Orientation -> [Orientation]
enumFrom :: Orientation -> [Orientation]
$cenumFromThen :: Orientation -> Orientation -> [Orientation]
enumFromThen :: Orientation -> Orientation -> [Orientation]
$cenumFromTo :: Orientation -> Orientation -> [Orientation]
enumFromTo :: Orientation -> Orientation -> [Orientation]
$cenumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
enumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
Enum, Orientation -> Orientation -> Bool
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
/= :: Orientation -> Orientation -> Bool
Eq, (forall x. Orientation -> Rep Orientation x)
-> (forall x. Rep Orientation x -> Orientation)
-> Generic Orientation
forall x. Rep Orientation x -> Orientation
forall x. Orientation -> Rep Orientation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Orientation -> Rep Orientation x
from :: forall x. Orientation -> Rep Orientation x
$cto :: forall x. Rep Orientation x -> Orientation
to :: forall x. Rep Orientation x -> Orientation
Generic, Eq Orientation
Eq Orientation
-> (Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
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
$ccompare :: Orientation -> Orientation -> Ordering
compare :: Orientation -> Orientation -> Ordering
$c< :: Orientation -> Orientation -> Bool
< :: Orientation -> Orientation -> Bool
$c<= :: Orientation -> Orientation -> Bool
<= :: Orientation -> Orientation -> Bool
$c> :: Orientation -> Orientation -> Bool
> :: Orientation -> Orientation -> Bool
$c>= :: Orientation -> Orientation -> Bool
>= :: Orientation -> Orientation -> Bool
$cmax :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
min :: Orientation -> Orientation -> Orientation
Ord, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
(Int -> ReadS Orientation)
-> ReadS [Orientation]
-> ReadPrec Orientation
-> ReadPrec [Orientation]
-> Read Orientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Orientation
readsPrec :: Int -> ReadS Orientation
$creadList :: ReadS [Orientation]
readList :: ReadS [Orientation]
$creadPrec :: ReadPrec Orientation
readPrec :: ReadPrec Orientation
$creadListPrec :: ReadPrec [Orientation]
readListPrec :: ReadPrec [Orientation]
Read, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Orientation -> ShowS
showsPrec :: Int -> Orientation -> ShowS
$cshow :: Orientation -> String
show :: Orientation -> String
$cshowList :: [Orientation] -> ShowS
showList :: [Orientation] -> ShowS
Show)

instance Hashable Orientation

instance NFData Orientation

-- | A data type that specifies that an item has been given an orientation.
data Oriented a = Oriented
  { -- | The object that is oriented.
    forall a. Oriented a -> a
oobject :: a,
    -- | The oriented of the oriented object.
    forall a. Oriented a -> Orientation
orientation :: Orientation
  }
  deriving (Oriented a
Oriented a -> Oriented a -> Bounded (Oriented a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Oriented a
$cminBound :: forall a. Bounded a => Oriented a
minBound :: Oriented a
$cmaxBound :: forall a. Bounded a => Oriented a
maxBound :: Oriented a
Bounded, Typeable (Oriented a)
Typeable (Oriented a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Oriented a -> c (Oriented a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Oriented a))
-> (Oriented a -> Constr)
-> (Oriented a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Oriented a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Oriented a)))
-> ((forall b. Data b => b -> b) -> Oriented a -> Oriented a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Oriented a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Oriented a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Oriented a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Oriented a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a))
-> Data (Oriented a)
Oriented a -> Constr
Oriented a -> DataType
(forall b. Data b => b -> b) -> Oriented a -> Oriented a
forall {a}. Data a => Typeable (Oriented a)
forall a. Data a => Oriented a -> Constr
forall a. Data a => Oriented a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Oriented a -> Oriented a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Oriented a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Oriented a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Oriented a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> c (Oriented a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Oriented 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) -> Oriented a -> u
forall u. (forall d. Data d => d -> u) -> Oriented a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Oriented a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> c (Oriented a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Oriented a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> c (Oriented a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> c (Oriented a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Oriented a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Oriented a)
$ctoConstr :: forall a. Data a => Oriented a -> Constr
toConstr :: Oriented a -> Constr
$cdataTypeOf :: forall a. Data a => Oriented a -> DataType
dataTypeOf :: Oriented a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Oriented a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Oriented a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Oriented a -> Oriented a
gmapT :: (forall b. Data b => b -> b) -> Oriented a -> Oriented a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Oriented a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Oriented a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Oriented a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Oriented a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
Data, Oriented a -> Oriented a -> Bool
(Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool) -> Eq (Oriented a)
forall a. Eq a => Oriented a -> Oriented a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Oriented a -> Oriented a -> Bool
== :: Oriented a -> Oriented a -> Bool
$c/= :: forall a. Eq a => Oriented a -> Oriented a -> Bool
/= :: Oriented a -> Oriented a -> Bool
Eq, (forall m. Monoid m => Oriented m -> m)
-> (forall m a. Monoid m => (a -> m) -> Oriented a -> m)
-> (forall m a. Monoid m => (a -> m) -> Oriented a -> m)
-> (forall a b. (a -> b -> b) -> b -> Oriented a -> b)
-> (forall a b. (a -> b -> b) -> b -> Oriented a -> b)
-> (forall b a. (b -> a -> b) -> b -> Oriented a -> b)
-> (forall b a. (b -> a -> b) -> b -> Oriented a -> b)
-> (forall a. (a -> a -> a) -> Oriented a -> a)
-> (forall a. (a -> a -> a) -> Oriented a -> a)
-> (forall a. Oriented a -> [a])
-> (forall a. Oriented a -> Bool)
-> (forall a. Oriented a -> Int)
-> (forall a. Eq a => a -> Oriented a -> Bool)
-> (forall a. Ord a => Oriented a -> a)
-> (forall a. Ord a => Oriented a -> a)
-> (forall a. Num a => Oriented a -> a)
-> (forall a. Num a => Oriented a -> a)
-> Foldable Oriented
forall a. Eq a => a -> Oriented a -> Bool
forall a. Num a => Oriented a -> a
forall a. Ord a => Oriented a -> a
forall m. Monoid m => Oriented m -> m
forall a. Oriented a -> Bool
forall a. Oriented a -> Int
forall a. Oriented a -> [a]
forall a. (a -> a -> a) -> Oriented a -> a
forall m a. Monoid m => (a -> m) -> Oriented a -> m
forall b a. (b -> a -> b) -> b -> Oriented a -> b
forall a b. (a -> b -> b) -> b -> Oriented 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 => Oriented m -> m
fold :: forall m. Monoid m => Oriented m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Oriented a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Oriented a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Oriented a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Oriented a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Oriented a -> a
foldr1 :: forall a. (a -> a -> a) -> Oriented a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Oriented a -> a
foldl1 :: forall a. (a -> a -> a) -> Oriented a -> a
$ctoList :: forall a. Oriented a -> [a]
toList :: forall a. Oriented a -> [a]
$cnull :: forall a. Oriented a -> Bool
null :: forall a. Oriented a -> Bool
$clength :: forall a. Oriented a -> Int
length :: forall a. Oriented a -> Int
$celem :: forall a. Eq a => a -> Oriented a -> Bool
elem :: forall a. Eq a => a -> Oriented a -> Bool
$cmaximum :: forall a. Ord a => Oriented a -> a
maximum :: forall a. Ord a => Oriented a -> a
$cminimum :: forall a. Ord a => Oriented a -> a
minimum :: forall a. Ord a => Oriented a -> a
$csum :: forall a. Num a => Oriented a -> a
sum :: forall a. Num a => Oriented a -> a
$cproduct :: forall a. Num a => Oriented a -> a
product :: forall a. Num a => Oriented a -> a
Foldable, (forall a b. (a -> b) -> Oriented a -> Oriented b)
-> (forall a b. a -> Oriented b -> Oriented a) -> Functor Oriented
forall a b. a -> Oriented b -> Oriented a
forall a b. (a -> b) -> Oriented a -> Oriented 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) -> Oriented a -> Oriented b
fmap :: forall a b. (a -> b) -> Oriented a -> Oriented b
$c<$ :: forall a b. a -> Oriented b -> Oriented a
<$ :: forall a b. a -> Oriented b -> Oriented a
Functor, (forall x. Oriented a -> Rep (Oriented a) x)
-> (forall x. Rep (Oriented a) x -> Oriented a)
-> Generic (Oriented a)
forall x. Rep (Oriented a) x -> Oriented a
forall x. Oriented a -> Rep (Oriented a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Oriented a) x -> Oriented a
forall a x. Oriented a -> Rep (Oriented a) x
$cfrom :: forall a x. Oriented a -> Rep (Oriented a) x
from :: forall x. Oriented a -> Rep (Oriented a) x
$cto :: forall a x. Rep (Oriented a) x -> Oriented a
to :: forall x. Rep (Oriented a) x -> Oriented a
Generic, (forall a. Oriented a -> Rep1 Oriented a)
-> (forall a. Rep1 Oriented a -> Oriented a) -> Generic1 Oriented
forall a. Rep1 Oriented a -> Oriented a
forall a. Oriented a -> Rep1 Oriented 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. Oriented a -> Rep1 Oriented a
from1 :: forall a. Oriented a -> Rep1 Oriented a
$cto1 :: forall a. Rep1 Oriented a -> Oriented a
to1 :: forall a. Rep1 Oriented a -> Oriented a
Generic1, Eq (Oriented a)
Eq (Oriented a)
-> (Oriented a -> Oriented a -> Ordering)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Oriented a)
-> (Oriented a -> Oriented a -> Oriented a)
-> Ord (Oriented a)
Oriented a -> Oriented a -> Bool
Oriented a -> Oriented a -> Ordering
Oriented a -> Oriented a -> Oriented 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 (Oriented a)
forall a. Ord a => Oriented a -> Oriented a -> Bool
forall a. Ord a => Oriented a -> Oriented a -> Ordering
forall a. Ord a => Oriented a -> Oriented a -> Oriented a
$ccompare :: forall a. Ord a => Oriented a -> Oriented a -> Ordering
compare :: Oriented a -> Oriented a -> Ordering
$c< :: forall a. Ord a => Oriented a -> Oriented a -> Bool
< :: Oriented a -> Oriented a -> Bool
$c<= :: forall a. Ord a => Oriented a -> Oriented a -> Bool
<= :: Oriented a -> Oriented a -> Bool
$c> :: forall a. Ord a => Oriented a -> Oriented a -> Bool
> :: Oriented a -> Oriented a -> Bool
$c>= :: forall a. Ord a => Oriented a -> Oriented a -> Bool
>= :: Oriented a -> Oriented a -> Bool
$cmax :: forall a. Ord a => Oriented a -> Oriented a -> Oriented a
max :: Oriented a -> Oriented a -> Oriented a
$cmin :: forall a. Ord a => Oriented a -> Oriented a -> Oriented a
min :: Oriented a -> Oriented a -> Oriented a
Ord, ReadPrec [Oriented a]
ReadPrec (Oriented a)
Int -> ReadS (Oriented a)
ReadS [Oriented a]
(Int -> ReadS (Oriented a))
-> ReadS [Oriented a]
-> ReadPrec (Oriented a)
-> ReadPrec [Oriented a]
-> Read (Oriented a)
forall a. Read a => ReadPrec [Oriented a]
forall a. Read a => ReadPrec (Oriented a)
forall a. Read a => Int -> ReadS (Oriented a)
forall a. Read a => ReadS [Oriented a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Oriented a)
readsPrec :: Int -> ReadS (Oriented a)
$creadList :: forall a. Read a => ReadS [Oriented a]
readList :: ReadS [Oriented a]
$creadPrec :: forall a. Read a => ReadPrec (Oriented a)
readPrec :: ReadPrec (Oriented a)
$creadListPrec :: forall a. Read a => ReadPrec [Oriented a]
readListPrec :: ReadPrec [Oriented a]
Read, Int -> Oriented a -> ShowS
[Oriented a] -> ShowS
Oriented a -> String
(Int -> Oriented a -> ShowS)
-> (Oriented a -> String)
-> ([Oriented a] -> ShowS)
-> Show (Oriented a)
forall a. Show a => Int -> Oriented a -> ShowS
forall a. Show a => [Oriented a] -> ShowS
forall a. Show a => Oriented a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Oriented a -> ShowS
showsPrec :: Int -> Oriented a -> ShowS
$cshow :: forall a. Show a => Oriented a -> String
show :: Oriented a -> String
$cshowList :: forall a. Show a => [Oriented a] -> ShowS
showList :: [Oriented a] -> ShowS
Show, Functor Oriented
Foldable Oriented
Functor Oriented
-> Foldable Oriented
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Oriented a -> f (Oriented b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Oriented (f a) -> f (Oriented a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Oriented a -> m (Oriented b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Oriented (m a) -> m (Oriented a))
-> Traversable Oriented
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 => Oriented (m a) -> m (Oriented a)
forall (f :: * -> *) a.
Applicative f =>
Oriented (f a) -> f (Oriented a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oriented a -> m (Oriented b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oriented a -> f (Oriented b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oriented a -> f (Oriented b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oriented a -> f (Oriented b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Oriented (f a) -> f (Oriented a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Oriented (f a) -> f (Oriented a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oriented a -> m (Oriented b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oriented a -> m (Oriented b)
$csequence :: forall (m :: * -> *) a. Monad m => Oriented (m a) -> m (Oriented a)
sequence :: forall (m :: * -> *) a. Monad m => Oriented (m a) -> m (Oriented a)
Traversable)

instance Eq1 Oriented where
  liftEq :: forall a b. (a -> b -> Bool) -> Oriented a -> Oriented b -> Bool
liftEq a -> b -> Bool
cmp ~(Oriented a
ba Orientation
oa) ~(Oriented b
bb Orientation
ob) = a -> b -> Bool
cmp a
ba b
bb Bool -> Bool -> Bool
&& Orientation
oa Orientation -> Orientation -> Bool
forall a. Eq a => a -> a -> Bool
== Orientation
ob

instance Hashable1 Oriented

instance Hashable a => Hashable (Oriented a)

instance NFData a => NFData (Oriented a)

instance NFData1 Oriented

instance Ord1 Oriented where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Oriented a -> Oriented b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Oriented a
ba Orientation
oa) ~(Oriented b
bb Orientation
ob) = a -> b -> Ordering
cmp a
ba b
bb Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Orientation -> Orientation -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Orientation
oa Orientation
ob

-- | Possible rotations of a unicode character if that character can be rotated
-- over 0, 90, 180, and 270 degrees.
data Rotate90
  = -- | No rotation.
    R0
  | -- | Rotation over /90/ degrees.
    R90
  | -- | Rotation over /180/ degrees.
    R180
  | -- | Rotation over /270/ degrees.
    R270
  deriving (Rotate90
Rotate90 -> Rotate90 -> Bounded Rotate90
forall a. a -> a -> Bounded a
$cminBound :: Rotate90
minBound :: Rotate90
$cmaxBound :: Rotate90
maxBound :: Rotate90
Bounded, Typeable Rotate90
Typeable Rotate90
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Rotate90 -> c Rotate90)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Rotate90)
-> (Rotate90 -> Constr)
-> (Rotate90 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Rotate90))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90))
-> ((forall b. Data b => b -> b) -> Rotate90 -> Rotate90)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotate90 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotate90 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90)
-> Data Rotate90
Rotate90 -> Constr
Rotate90 -> DataType
(forall b. Data b => b -> b) -> Rotate90 -> Rotate90
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) -> Rotate90 -> u
forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rotate90
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotate90 -> c Rotate90
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rotate90)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotate90 -> c Rotate90
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotate90 -> c Rotate90
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rotate90
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rotate90
$ctoConstr :: Rotate90 -> Constr
toConstr :: Rotate90 -> Constr
$cdataTypeOf :: Rotate90 -> DataType
dataTypeOf :: Rotate90 -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rotate90)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rotate90)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90)
$cgmapT :: (forall b. Data b => b -> b) -> Rotate90 -> Rotate90
gmapT :: (forall b. Data b => b -> b) -> Rotate90 -> Rotate90
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
Data, Int -> Rotate90
Rotate90 -> Int
Rotate90 -> [Rotate90]
Rotate90 -> Rotate90
Rotate90 -> Rotate90 -> [Rotate90]
Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90]
(Rotate90 -> Rotate90)
-> (Rotate90 -> Rotate90)
-> (Int -> Rotate90)
-> (Rotate90 -> Int)
-> (Rotate90 -> [Rotate90])
-> (Rotate90 -> Rotate90 -> [Rotate90])
-> (Rotate90 -> Rotate90 -> [Rotate90])
-> (Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90])
-> Enum Rotate90
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 :: Rotate90 -> Rotate90
succ :: Rotate90 -> Rotate90
$cpred :: Rotate90 -> Rotate90
pred :: Rotate90 -> Rotate90
$ctoEnum :: Int -> Rotate90
toEnum :: Int -> Rotate90
$cfromEnum :: Rotate90 -> Int
fromEnum :: Rotate90 -> Int
$cenumFrom :: Rotate90 -> [Rotate90]
enumFrom :: Rotate90 -> [Rotate90]
$cenumFromThen :: Rotate90 -> Rotate90 -> [Rotate90]
enumFromThen :: Rotate90 -> Rotate90 -> [Rotate90]
$cenumFromTo :: Rotate90 -> Rotate90 -> [Rotate90]
enumFromTo :: Rotate90 -> Rotate90 -> [Rotate90]
$cenumFromThenTo :: Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90]
enumFromThenTo :: Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90]
Enum, Rotate90 -> Rotate90 -> Bool
(Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool) -> Eq Rotate90
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rotate90 -> Rotate90 -> Bool
== :: Rotate90 -> Rotate90 -> Bool
$c/= :: Rotate90 -> Rotate90 -> Bool
/= :: Rotate90 -> Rotate90 -> Bool
Eq, (forall x. Rotate90 -> Rep Rotate90 x)
-> (forall x. Rep Rotate90 x -> Rotate90) -> Generic Rotate90
forall x. Rep Rotate90 x -> Rotate90
forall x. Rotate90 -> Rep Rotate90 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Rotate90 -> Rep Rotate90 x
from :: forall x. Rotate90 -> Rep Rotate90 x
$cto :: forall x. Rep Rotate90 x -> Rotate90
to :: forall x. Rep Rotate90 x -> Rotate90
Generic, Eq Rotate90
Eq Rotate90
-> (Rotate90 -> Rotate90 -> Ordering)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Rotate90)
-> (Rotate90 -> Rotate90 -> Rotate90)
-> Ord Rotate90
Rotate90 -> Rotate90 -> Bool
Rotate90 -> Rotate90 -> Ordering
Rotate90 -> Rotate90 -> Rotate90
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
$ccompare :: Rotate90 -> Rotate90 -> Ordering
compare :: Rotate90 -> Rotate90 -> Ordering
$c< :: Rotate90 -> Rotate90 -> Bool
< :: Rotate90 -> Rotate90 -> Bool
$c<= :: Rotate90 -> Rotate90 -> Bool
<= :: Rotate90 -> Rotate90 -> Bool
$c> :: Rotate90 -> Rotate90 -> Bool
> :: Rotate90 -> Rotate90 -> Bool
$c>= :: Rotate90 -> Rotate90 -> Bool
>= :: Rotate90 -> Rotate90 -> Bool
$cmax :: Rotate90 -> Rotate90 -> Rotate90
max :: Rotate90 -> Rotate90 -> Rotate90
$cmin :: Rotate90 -> Rotate90 -> Rotate90
min :: Rotate90 -> Rotate90 -> Rotate90
Ord, ReadPrec [Rotate90]
ReadPrec Rotate90
Int -> ReadS Rotate90
ReadS [Rotate90]
(Int -> ReadS Rotate90)
-> ReadS [Rotate90]
-> ReadPrec Rotate90
-> ReadPrec [Rotate90]
-> Read Rotate90
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Rotate90
readsPrec :: Int -> ReadS Rotate90
$creadList :: ReadS [Rotate90]
readList :: ReadS [Rotate90]
$creadPrec :: ReadPrec Rotate90
readPrec :: ReadPrec Rotate90
$creadListPrec :: ReadPrec [Rotate90]
readListPrec :: ReadPrec [Rotate90]
Read, Int -> Rotate90 -> ShowS
[Rotate90] -> ShowS
Rotate90 -> String
(Int -> Rotate90 -> ShowS)
-> (Rotate90 -> String) -> ([Rotate90] -> ShowS) -> Show Rotate90
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rotate90 -> ShowS
showsPrec :: Int -> Rotate90 -> ShowS
$cshow :: Rotate90 -> String
show :: Rotate90 -> String
$cshowList :: [Rotate90] -> ShowS
showList :: [Rotate90] -> ShowS
Show)

instance Hashable Rotate90

instance NFData Rotate90

-- | A data type that specifies that an item has been given a rotation.
data Rotated a = Rotated
  { -- | The object that is rotated.
    forall a. Rotated a -> a
robject :: a,
    -- | The rotation of the rotated object.
    forall a. Rotated a -> Rotate90
rotation :: Rotate90
  }
  deriving (Rotated a
Rotated a -> Rotated a -> Bounded (Rotated a)
forall a. a -> a -> Bounded a
forall a. Bounded a => Rotated a
$cminBound :: forall a. Bounded a => Rotated a
minBound :: Rotated a
$cmaxBound :: forall a. Bounded a => Rotated a
maxBound :: Rotated a
Bounded, Typeable (Rotated a)
Typeable (Rotated a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Rotated a -> c (Rotated a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Rotated a))
-> (Rotated a -> Constr)
-> (Rotated a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Rotated a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Rotated a)))
-> ((forall b. Data b => b -> b) -> Rotated a -> Rotated a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotated a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotated a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rotated a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Rotated a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a))
-> Data (Rotated a)
Rotated a -> Constr
Rotated a -> DataType
(forall b. Data b => b -> b) -> Rotated a -> Rotated a
forall {a}. Data a => Typeable (Rotated a)
forall a. Data a => Rotated a -> Constr
forall a. Data a => Rotated a -> DataType
forall a.
Data a =>
(forall b. Data b => b -> b) -> Rotated a -> Rotated a
forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Rotated a -> u
forall a u.
Data a =>
(forall d. Data d => d -> u) -> Rotated a -> [u]
forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rotated a)
forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> c (Rotated a)
forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Rotated 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) -> Rotated a -> u
forall u. (forall d. Data d => d -> u) -> Rotated a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rotated a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> c (Rotated a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Rotated a))
$cgfoldl :: forall a (c :: * -> *).
Data a =>
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> c (Rotated a)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> c (Rotated a)
$cgunfold :: forall a (c :: * -> *).
Data a =>
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rotated a)
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rotated a)
$ctoConstr :: forall a. Data a => Rotated a -> Constr
toConstr :: Rotated a -> Constr
$cdataTypeOf :: forall a. Data a => Rotated a -> DataType
dataTypeOf :: Rotated a -> DataType
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
$cdataCast2 :: forall a (t :: * -> * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Rotated a))
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Rotated a))
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Rotated a -> Rotated a
gmapT :: (forall b. Data b => b -> b) -> Rotated a -> Rotated a
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
$cgmapQr :: forall a r r'.
Data a =>
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Rotated a -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Rotated a -> [u]
$cgmapQi :: forall a u.
Data a =>
Int -> (forall d. Data d => d -> u) -> Rotated a -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rotated a -> u
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
$cgmapMp :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
$cgmapMo :: forall a (m :: * -> *).
(Data a, MonadPlus m) =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
Data, Rotated a -> Rotated a -> Bool
(Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool) -> Eq (Rotated a)
forall a. Eq a => Rotated a -> Rotated a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall a. Eq a => Rotated a -> Rotated a -> Bool
== :: Rotated a -> Rotated a -> Bool
$c/= :: forall a. Eq a => Rotated a -> Rotated a -> Bool
/= :: Rotated a -> Rotated a -> Bool
Eq, (forall m. Monoid m => Rotated m -> m)
-> (forall m a. Monoid m => (a -> m) -> Rotated a -> m)
-> (forall m a. Monoid m => (a -> m) -> Rotated a -> m)
-> (forall a b. (a -> b -> b) -> b -> Rotated a -> b)
-> (forall a b. (a -> b -> b) -> b -> Rotated a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rotated a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rotated a -> b)
-> (forall a. (a -> a -> a) -> Rotated a -> a)
-> (forall a. (a -> a -> a) -> Rotated a -> a)
-> (forall a. Rotated a -> [a])
-> (forall a. Rotated a -> Bool)
-> (forall a. Rotated a -> Int)
-> (forall a. Eq a => a -> Rotated a -> Bool)
-> (forall a. Ord a => Rotated a -> a)
-> (forall a. Ord a => Rotated a -> a)
-> (forall a. Num a => Rotated a -> a)
-> (forall a. Num a => Rotated a -> a)
-> Foldable Rotated
forall a. Eq a => a -> Rotated a -> Bool
forall a. Num a => Rotated a -> a
forall a. Ord a => Rotated a -> a
forall m. Monoid m => Rotated m -> m
forall a. Rotated a -> Bool
forall a. Rotated a -> Int
forall a. Rotated a -> [a]
forall a. (a -> a -> a) -> Rotated a -> a
forall m a. Monoid m => (a -> m) -> Rotated a -> m
forall b a. (b -> a -> b) -> b -> Rotated a -> b
forall a b. (a -> b -> b) -> b -> Rotated 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 => Rotated m -> m
fold :: forall m. Monoid m => Rotated m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Rotated a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Rotated a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Rotated a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Rotated a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Rotated a -> a
foldr1 :: forall a. (a -> a -> a) -> Rotated a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rotated a -> a
foldl1 :: forall a. (a -> a -> a) -> Rotated a -> a
$ctoList :: forall a. Rotated a -> [a]
toList :: forall a. Rotated a -> [a]
$cnull :: forall a. Rotated a -> Bool
null :: forall a. Rotated a -> Bool
$clength :: forall a. Rotated a -> Int
length :: forall a. Rotated a -> Int
$celem :: forall a. Eq a => a -> Rotated a -> Bool
elem :: forall a. Eq a => a -> Rotated a -> Bool
$cmaximum :: forall a. Ord a => Rotated a -> a
maximum :: forall a. Ord a => Rotated a -> a
$cminimum :: forall a. Ord a => Rotated a -> a
minimum :: forall a. Ord a => Rotated a -> a
$csum :: forall a. Num a => Rotated a -> a
sum :: forall a. Num a => Rotated a -> a
$cproduct :: forall a. Num a => Rotated a -> a
product :: forall a. Num a => Rotated a -> a
Foldable, (forall a b. (a -> b) -> Rotated a -> Rotated b)
-> (forall a b. a -> Rotated b -> Rotated a) -> Functor Rotated
forall a b. a -> Rotated b -> Rotated a
forall a b. (a -> b) -> Rotated a -> Rotated 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) -> Rotated a -> Rotated b
fmap :: forall a b. (a -> b) -> Rotated a -> Rotated b
$c<$ :: forall a b. a -> Rotated b -> Rotated a
<$ :: forall a b. a -> Rotated b -> Rotated a
Functor, (forall x. Rotated a -> Rep (Rotated a) x)
-> (forall x. Rep (Rotated a) x -> Rotated a)
-> Generic (Rotated a)
forall x. Rep (Rotated a) x -> Rotated a
forall x. Rotated a -> Rep (Rotated a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Rotated a) x -> Rotated a
forall a x. Rotated a -> Rep (Rotated a) x
$cfrom :: forall a x. Rotated a -> Rep (Rotated a) x
from :: forall x. Rotated a -> Rep (Rotated a) x
$cto :: forall a x. Rep (Rotated a) x -> Rotated a
to :: forall x. Rep (Rotated a) x -> Rotated a
Generic, (forall a. Rotated a -> Rep1 Rotated a)
-> (forall a. Rep1 Rotated a -> Rotated a) -> Generic1 Rotated
forall a. Rep1 Rotated a -> Rotated a
forall a. Rotated a -> Rep1 Rotated 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. Rotated a -> Rep1 Rotated a
from1 :: forall a. Rotated a -> Rep1 Rotated a
$cto1 :: forall a. Rep1 Rotated a -> Rotated a
to1 :: forall a. Rep1 Rotated a -> Rotated a
Generic1, Eq (Rotated a)
Eq (Rotated a)
-> (Rotated a -> Rotated a -> Ordering)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Rotated a)
-> (Rotated a -> Rotated a -> Rotated a)
-> Ord (Rotated a)
Rotated a -> Rotated a -> Bool
Rotated a -> Rotated a -> Ordering
Rotated a -> Rotated a -> Rotated 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 (Rotated a)
forall a. Ord a => Rotated a -> Rotated a -> Bool
forall a. Ord a => Rotated a -> Rotated a -> Ordering
forall a. Ord a => Rotated a -> Rotated a -> Rotated a
$ccompare :: forall a. Ord a => Rotated a -> Rotated a -> Ordering
compare :: Rotated a -> Rotated a -> Ordering
$c< :: forall a. Ord a => Rotated a -> Rotated a -> Bool
< :: Rotated a -> Rotated a -> Bool
$c<= :: forall a. Ord a => Rotated a -> Rotated a -> Bool
<= :: Rotated a -> Rotated a -> Bool
$c> :: forall a. Ord a => Rotated a -> Rotated a -> Bool
> :: Rotated a -> Rotated a -> Bool
$c>= :: forall a. Ord a => Rotated a -> Rotated a -> Bool
>= :: Rotated a -> Rotated a -> Bool
$cmax :: forall a. Ord a => Rotated a -> Rotated a -> Rotated a
max :: Rotated a -> Rotated a -> Rotated a
$cmin :: forall a. Ord a => Rotated a -> Rotated a -> Rotated a
min :: Rotated a -> Rotated a -> Rotated a
Ord, ReadPrec [Rotated a]
ReadPrec (Rotated a)
Int -> ReadS (Rotated a)
ReadS [Rotated a]
(Int -> ReadS (Rotated a))
-> ReadS [Rotated a]
-> ReadPrec (Rotated a)
-> ReadPrec [Rotated a]
-> Read (Rotated a)
forall a. Read a => ReadPrec [Rotated a]
forall a. Read a => ReadPrec (Rotated a)
forall a. Read a => Int -> ReadS (Rotated a)
forall a. Read a => ReadS [Rotated a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: forall a. Read a => Int -> ReadS (Rotated a)
readsPrec :: Int -> ReadS (Rotated a)
$creadList :: forall a. Read a => ReadS [Rotated a]
readList :: ReadS [Rotated a]
$creadPrec :: forall a. Read a => ReadPrec (Rotated a)
readPrec :: ReadPrec (Rotated a)
$creadListPrec :: forall a. Read a => ReadPrec [Rotated a]
readListPrec :: ReadPrec [Rotated a]
Read, Int -> Rotated a -> ShowS
[Rotated a] -> ShowS
Rotated a -> String
(Int -> Rotated a -> ShowS)
-> (Rotated a -> String)
-> ([Rotated a] -> ShowS)
-> Show (Rotated a)
forall a. Show a => Int -> Rotated a -> ShowS
forall a. Show a => [Rotated a] -> ShowS
forall a. Show a => Rotated a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall a. Show a => Int -> Rotated a -> ShowS
showsPrec :: Int -> Rotated a -> ShowS
$cshow :: forall a. Show a => Rotated a -> String
show :: Rotated a -> String
$cshowList :: forall a. Show a => [Rotated a] -> ShowS
showList :: [Rotated a] -> ShowS
Show, Functor Rotated
Foldable Rotated
Functor Rotated
-> Foldable Rotated
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Rotated a -> f (Rotated b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Rotated (f a) -> f (Rotated a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Rotated a -> m (Rotated b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Rotated (m a) -> m (Rotated a))
-> Traversable Rotated
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 => Rotated (m a) -> m (Rotated a)
forall (f :: * -> *) a.
Applicative f =>
Rotated (f a) -> f (Rotated a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rotated a -> m (Rotated b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rotated a -> f (Rotated b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rotated a -> f (Rotated b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rotated a -> f (Rotated b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Rotated (f a) -> f (Rotated a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Rotated (f a) -> f (Rotated a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rotated a -> m (Rotated b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rotated a -> m (Rotated b)
$csequence :: forall (m :: * -> *) a. Monad m => Rotated (m a) -> m (Rotated a)
sequence :: forall (m :: * -> *) a. Monad m => Rotated (m a) -> m (Rotated a)
Traversable)

instance Eq1 Rotated where
  liftEq :: forall a b. (a -> b -> Bool) -> Rotated a -> Rotated b -> Bool
liftEq a -> b -> Bool
cmp ~(Rotated a
oa Rotate90
ra) ~(Rotated b
ob Rotate90
rb) = a -> b -> Bool
cmp a
oa b
ob Bool -> Bool -> Bool
&& Rotate90
ra Rotate90 -> Rotate90 -> Bool
forall a. Eq a => a -> a -> Bool
== Rotate90
rb

instance Hashable1 Rotated

instance Hashable a => Hashable (Rotated a)

instance NFData a => NFData (Rotated a)

instance NFData1 Rotated

instance Ord1 Rotated where
  liftCompare :: forall a b.
(a -> b -> Ordering) -> Rotated a -> Rotated b -> Ordering
liftCompare a -> b -> Ordering
cmp ~(Rotated a
oa Rotate90
ra) ~(Rotated b
ob Rotate90
rb) = a -> b -> Ordering
cmp a
oa b
ob Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> Rotate90 -> Rotate90 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Rotate90
ra Rotate90
rb

-- | A data type that lists the possible emphasis of a font. This can be 'Bold'
-- or 'NoBold' the 'Default' is 'NoBold'.
data Emphasis
  = -- | The characters are not stressed with boldface.
    NoBold
  | -- | The characters are stressed in boldface.
    Bold
  deriving (Emphasis
Emphasis -> Emphasis -> Bounded Emphasis
forall a. a -> a -> Bounded a
$cminBound :: Emphasis
minBound :: Emphasis
$cmaxBound :: Emphasis
maxBound :: Emphasis
Bounded, Typeable Emphasis
Typeable Emphasis
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Emphasis -> c Emphasis)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Emphasis)
-> (Emphasis -> Constr)
-> (Emphasis -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Emphasis))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis))
-> ((forall b. Data b => b -> b) -> Emphasis -> Emphasis)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Emphasis -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Emphasis -> r)
-> (forall u. (forall d. Data d => d -> u) -> Emphasis -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Emphasis -> m Emphasis)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Emphasis -> m Emphasis)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Emphasis -> m Emphasis)
-> Data Emphasis
Emphasis -> Constr
Emphasis -> DataType
(forall b. Data b => b -> b) -> Emphasis -> Emphasis
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) -> Emphasis -> u
forall u. (forall d. Data d => d -> u) -> Emphasis -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Emphasis
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Emphasis -> c Emphasis
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Emphasis)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Emphasis -> c Emphasis
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Emphasis -> c Emphasis
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Emphasis
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Emphasis
$ctoConstr :: Emphasis -> Constr
toConstr :: Emphasis -> Constr
$cdataTypeOf :: Emphasis -> DataType
dataTypeOf :: Emphasis -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Emphasis)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Emphasis)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis)
$cgmapT :: (forall b. Data b => b -> b) -> Emphasis -> Emphasis
gmapT :: (forall b. Data b => b -> b) -> Emphasis -> Emphasis
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Emphasis -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Emphasis -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
Data, Int -> Emphasis
Emphasis -> Int
Emphasis -> [Emphasis]
Emphasis -> Emphasis
Emphasis -> Emphasis -> [Emphasis]
Emphasis -> Emphasis -> Emphasis -> [Emphasis]
(Emphasis -> Emphasis)
-> (Emphasis -> Emphasis)
-> (Int -> Emphasis)
-> (Emphasis -> Int)
-> (Emphasis -> [Emphasis])
-> (Emphasis -> Emphasis -> [Emphasis])
-> (Emphasis -> Emphasis -> [Emphasis])
-> (Emphasis -> Emphasis -> Emphasis -> [Emphasis])
-> Enum Emphasis
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 :: Emphasis -> Emphasis
succ :: Emphasis -> Emphasis
$cpred :: Emphasis -> Emphasis
pred :: Emphasis -> Emphasis
$ctoEnum :: Int -> Emphasis
toEnum :: Int -> Emphasis
$cfromEnum :: Emphasis -> Int
fromEnum :: Emphasis -> Int
$cenumFrom :: Emphasis -> [Emphasis]
enumFrom :: Emphasis -> [Emphasis]
$cenumFromThen :: Emphasis -> Emphasis -> [Emphasis]
enumFromThen :: Emphasis -> Emphasis -> [Emphasis]
$cenumFromTo :: Emphasis -> Emphasis -> [Emphasis]
enumFromTo :: Emphasis -> Emphasis -> [Emphasis]
$cenumFromThenTo :: Emphasis -> Emphasis -> Emphasis -> [Emphasis]
enumFromThenTo :: Emphasis -> Emphasis -> Emphasis -> [Emphasis]
Enum, Emphasis -> Emphasis -> Bool
(Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool) -> Eq Emphasis
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Emphasis -> Emphasis -> Bool
== :: Emphasis -> Emphasis -> Bool
$c/= :: Emphasis -> Emphasis -> Bool
/= :: Emphasis -> Emphasis -> Bool
Eq, (forall x. Emphasis -> Rep Emphasis x)
-> (forall x. Rep Emphasis x -> Emphasis) -> Generic Emphasis
forall x. Rep Emphasis x -> Emphasis
forall x. Emphasis -> Rep Emphasis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Emphasis -> Rep Emphasis x
from :: forall x. Emphasis -> Rep Emphasis x
$cto :: forall x. Rep Emphasis x -> Emphasis
to :: forall x. Rep Emphasis x -> Emphasis
Generic, Eq Emphasis
Eq Emphasis
-> (Emphasis -> Emphasis -> Ordering)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Emphasis)
-> (Emphasis -> Emphasis -> Emphasis)
-> Ord Emphasis
Emphasis -> Emphasis -> Bool
Emphasis -> Emphasis -> Ordering
Emphasis -> Emphasis -> Emphasis
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
$ccompare :: Emphasis -> Emphasis -> Ordering
compare :: Emphasis -> Emphasis -> Ordering
$c< :: Emphasis -> Emphasis -> Bool
< :: Emphasis -> Emphasis -> Bool
$c<= :: Emphasis -> Emphasis -> Bool
<= :: Emphasis -> Emphasis -> Bool
$c> :: Emphasis -> Emphasis -> Bool
> :: Emphasis -> Emphasis -> Bool
$c>= :: Emphasis -> Emphasis -> Bool
>= :: Emphasis -> Emphasis -> Bool
$cmax :: Emphasis -> Emphasis -> Emphasis
max :: Emphasis -> Emphasis -> Emphasis
$cmin :: Emphasis -> Emphasis -> Emphasis
min :: Emphasis -> Emphasis -> Emphasis
Ord, ReadPrec [Emphasis]
ReadPrec Emphasis
Int -> ReadS Emphasis
ReadS [Emphasis]
(Int -> ReadS Emphasis)
-> ReadS [Emphasis]
-> ReadPrec Emphasis
-> ReadPrec [Emphasis]
-> Read Emphasis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Emphasis
readsPrec :: Int -> ReadS Emphasis
$creadList :: ReadS [Emphasis]
readList :: ReadS [Emphasis]
$creadPrec :: ReadPrec Emphasis
readPrec :: ReadPrec Emphasis
$creadListPrec :: ReadPrec [Emphasis]
readListPrec :: ReadPrec [Emphasis]
Read, Int -> Emphasis -> ShowS
[Emphasis] -> ShowS
Emphasis -> String
(Int -> Emphasis -> ShowS)
-> (Emphasis -> String) -> ([Emphasis] -> ShowS) -> Show Emphasis
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Emphasis -> ShowS
showsPrec :: Int -> Emphasis -> ShowS
$cshow :: Emphasis -> String
show :: Emphasis -> String
$cshowList :: [Emphasis] -> ShowS
showList :: [Emphasis] -> ShowS
Show)

instance Hashable Emphasis

instance NFData Emphasis

-- | Pick one of the two values based on the 't:Emphasis' value.
splitEmphasis ::
  -- | The value to return in case of 'NoBold'.
  a ->
  -- | The value to return in case of 'Bold'.
  a ->
  -- | The emphasis type.
  Emphasis ->
  -- | One of the two given values, based on the 't:Emphasis' value.
  a
splitEmphasis :: forall a. a -> a -> Emphasis -> a
splitEmphasis a
x a
y = Emphasis -> a
go
  where
    go :: Emphasis -> a
go Emphasis
NoBold = a
x
    go Emphasis
Bold = a
y

-- | A data type that can be used to specify if an /italic/ character is used.
-- The 'Default' is 'NoItalic'.
data ItalicType
  = -- | No italic characters are used.
    NoItalic
  | -- | Italic characters are used.
    Italic
  deriving (ItalicType
ItalicType -> ItalicType -> Bounded ItalicType
forall a. a -> a -> Bounded a
$cminBound :: ItalicType
minBound :: ItalicType
$cmaxBound :: ItalicType
maxBound :: ItalicType
Bounded, Typeable ItalicType
Typeable ItalicType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ItalicType -> c ItalicType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ItalicType)
-> (ItalicType -> Constr)
-> (ItalicType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ItalicType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ItalicType))
-> ((forall b. Data b => b -> b) -> ItalicType -> ItalicType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ItalicType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ItalicType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ItalicType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ItalicType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ItalicType -> m ItalicType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ItalicType -> m ItalicType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ItalicType -> m ItalicType)
-> Data ItalicType
ItalicType -> Constr
ItalicType -> DataType
(forall b. Data b => b -> b) -> ItalicType -> ItalicType
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) -> ItalicType -> u
forall u. (forall d. Data d => d -> u) -> ItalicType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ItalicType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ItalicType -> c ItalicType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ItalicType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ItalicType)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ItalicType -> c ItalicType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ItalicType -> c ItalicType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ItalicType
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ItalicType
$ctoConstr :: ItalicType -> Constr
toConstr :: ItalicType -> Constr
$cdataTypeOf :: ItalicType -> DataType
dataTypeOf :: ItalicType -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ItalicType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ItalicType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ItalicType)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ItalicType)
$cgmapT :: (forall b. Data b => b -> b) -> ItalicType -> ItalicType
gmapT :: (forall b. Data b => b -> b) -> ItalicType -> ItalicType
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ItalicType -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> ItalicType -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ItalicType -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ItalicType -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
Data, Int -> ItalicType
ItalicType -> Int
ItalicType -> [ItalicType]
ItalicType -> ItalicType
ItalicType -> ItalicType -> [ItalicType]
ItalicType -> ItalicType -> ItalicType -> [ItalicType]
(ItalicType -> ItalicType)
-> (ItalicType -> ItalicType)
-> (Int -> ItalicType)
-> (ItalicType -> Int)
-> (ItalicType -> [ItalicType])
-> (ItalicType -> ItalicType -> [ItalicType])
-> (ItalicType -> ItalicType -> [ItalicType])
-> (ItalicType -> ItalicType -> ItalicType -> [ItalicType])
-> Enum ItalicType
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 :: ItalicType -> ItalicType
succ :: ItalicType -> ItalicType
$cpred :: ItalicType -> ItalicType
pred :: ItalicType -> ItalicType
$ctoEnum :: Int -> ItalicType
toEnum :: Int -> ItalicType
$cfromEnum :: ItalicType -> Int
fromEnum :: ItalicType -> Int
$cenumFrom :: ItalicType -> [ItalicType]
enumFrom :: ItalicType -> [ItalicType]
$cenumFromThen :: ItalicType -> ItalicType -> [ItalicType]
enumFromThen :: ItalicType -> ItalicType -> [ItalicType]
$cenumFromTo :: ItalicType -> ItalicType -> [ItalicType]
enumFromTo :: ItalicType -> ItalicType -> [ItalicType]
$cenumFromThenTo :: ItalicType -> ItalicType -> ItalicType -> [ItalicType]
enumFromThenTo :: ItalicType -> ItalicType -> ItalicType -> [ItalicType]
Enum, ItalicType -> ItalicType -> Bool
(ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool) -> Eq ItalicType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ItalicType -> ItalicType -> Bool
== :: ItalicType -> ItalicType -> Bool
$c/= :: ItalicType -> ItalicType -> Bool
/= :: ItalicType -> ItalicType -> Bool
Eq, (forall x. ItalicType -> Rep ItalicType x)
-> (forall x. Rep ItalicType x -> ItalicType) -> Generic ItalicType
forall x. Rep ItalicType x -> ItalicType
forall x. ItalicType -> Rep ItalicType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. ItalicType -> Rep ItalicType x
from :: forall x. ItalicType -> Rep ItalicType x
$cto :: forall x. Rep ItalicType x -> ItalicType
to :: forall x. Rep ItalicType x -> ItalicType
Generic, Eq ItalicType
Eq ItalicType
-> (ItalicType -> ItalicType -> Ordering)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> ItalicType)
-> (ItalicType -> ItalicType -> ItalicType)
-> Ord ItalicType
ItalicType -> ItalicType -> Bool
ItalicType -> ItalicType -> Ordering
ItalicType -> ItalicType -> ItalicType
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
$ccompare :: ItalicType -> ItalicType -> Ordering
compare :: ItalicType -> ItalicType -> Ordering
$c< :: ItalicType -> ItalicType -> Bool
< :: ItalicType -> ItalicType -> Bool
$c<= :: ItalicType -> ItalicType -> Bool
<= :: ItalicType -> ItalicType -> Bool
$c> :: ItalicType -> ItalicType -> Bool
> :: ItalicType -> ItalicType -> Bool
$c>= :: ItalicType -> ItalicType -> Bool
>= :: ItalicType -> ItalicType -> Bool
$cmax :: ItalicType -> ItalicType -> ItalicType
max :: ItalicType -> ItalicType -> ItalicType
$cmin :: ItalicType -> ItalicType -> ItalicType
min :: ItalicType -> ItalicType -> ItalicType
Ord, ReadPrec [ItalicType]
ReadPrec ItalicType
Int -> ReadS ItalicType
ReadS [ItalicType]
(Int -> ReadS ItalicType)
-> ReadS [ItalicType]
-> ReadPrec ItalicType
-> ReadPrec [ItalicType]
-> Read ItalicType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ItalicType
readsPrec :: Int -> ReadS ItalicType
$creadList :: ReadS [ItalicType]
readList :: ReadS [ItalicType]
$creadPrec :: ReadPrec ItalicType
readPrec :: ReadPrec ItalicType
$creadListPrec :: ReadPrec [ItalicType]
readListPrec :: ReadPrec [ItalicType]
Read, Int -> ItalicType -> ShowS
[ItalicType] -> ShowS
ItalicType -> String
(Int -> ItalicType -> ShowS)
-> (ItalicType -> String)
-> ([ItalicType] -> ShowS)
-> Show ItalicType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ItalicType -> ShowS
showsPrec :: Int -> ItalicType -> ShowS
$cshow :: ItalicType -> String
show :: ItalicType -> String
$cshowList :: [ItalicType] -> ShowS
showList :: [ItalicType] -> ShowS
Show)

instance Hashable ItalicType

instance NFData ItalicType

-- | Pick one of the two values based on the 't:ItalicType' value.
splitItalicType ::
  -- | The value to return in case of 'NoItalic'.
  a ->
  -- | The value to return in case of 'Italic'.
  a ->
  -- | The italic type.
  ItalicType ->
  -- | One of the two given values, based on the 't:ItalicType' value.
  a
splitItalicType :: forall a. a -> a -> ItalicType -> a
splitItalicType a
x a
y = ItalicType -> a
go
  where
    go :: ItalicType -> a
go ItalicType
NoItalic = a
x
    go ItalicType
Italic = a
y

-- | A data type that specifies if the font is with /serifs/ or not. The
-- 'Defaul;t' is 'Serif'.
data FontStyle
  = -- | The character is a character rendered /without/ serifs.
    SansSerif
  | -- | The character is a character rendered /with/ serifs.
    Serif
  deriving (FontStyle
FontStyle -> FontStyle -> Bounded FontStyle
forall a. a -> a -> Bounded a
$cminBound :: FontStyle
minBound :: FontStyle
$cmaxBound :: FontStyle
maxBound :: FontStyle
Bounded, Typeable FontStyle
Typeable FontStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FontStyle -> c FontStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FontStyle)
-> (FontStyle -> Constr)
-> (FontStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FontStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle))
-> ((forall b. Data b => b -> b) -> FontStyle -> FontStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FontStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FontStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> FontStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FontStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FontStyle -> m FontStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FontStyle -> m FontStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FontStyle -> m FontStyle)
-> Data FontStyle
FontStyle -> Constr
FontStyle -> DataType
(forall b. Data b => b -> b) -> FontStyle -> FontStyle
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) -> FontStyle -> u
forall u. (forall d. Data d => d -> u) -> FontStyle -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStyle
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStyle -> c FontStyle
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStyle)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStyle -> c FontStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStyle -> c FontStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStyle
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStyle
$ctoConstr :: FontStyle -> Constr
toConstr :: FontStyle -> Constr
$cdataTypeOf :: FontStyle -> DataType
dataTypeOf :: FontStyle -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle)
$cgmapT :: (forall b. Data b => b -> b) -> FontStyle -> FontStyle
gmapT :: (forall b. Data b => b -> b) -> FontStyle -> FontStyle
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FontStyle -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> FontStyle -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStyle -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStyle -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
Data, Int -> FontStyle
FontStyle -> Int
FontStyle -> [FontStyle]
FontStyle -> FontStyle
FontStyle -> FontStyle -> [FontStyle]
FontStyle -> FontStyle -> FontStyle -> [FontStyle]
(FontStyle -> FontStyle)
-> (FontStyle -> FontStyle)
-> (Int -> FontStyle)
-> (FontStyle -> Int)
-> (FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> FontStyle -> [FontStyle])
-> Enum FontStyle
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 :: FontStyle -> FontStyle
succ :: FontStyle -> FontStyle
$cpred :: FontStyle -> FontStyle
pred :: FontStyle -> FontStyle
$ctoEnum :: Int -> FontStyle
toEnum :: Int -> FontStyle
$cfromEnum :: FontStyle -> Int
fromEnum :: FontStyle -> Int
$cenumFrom :: FontStyle -> [FontStyle]
enumFrom :: FontStyle -> [FontStyle]
$cenumFromThen :: FontStyle -> FontStyle -> [FontStyle]
enumFromThen :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromTo :: FontStyle -> FontStyle -> [FontStyle]
enumFromTo :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
enumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
Enum, FontStyle -> FontStyle -> Bool
(FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool) -> Eq FontStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontStyle -> FontStyle -> Bool
== :: FontStyle -> FontStyle -> Bool
$c/= :: FontStyle -> FontStyle -> Bool
/= :: FontStyle -> FontStyle -> Bool
Eq, (forall x. FontStyle -> Rep FontStyle x)
-> (forall x. Rep FontStyle x -> FontStyle) -> Generic FontStyle
forall x. Rep FontStyle x -> FontStyle
forall x. FontStyle -> Rep FontStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. FontStyle -> Rep FontStyle x
from :: forall x. FontStyle -> Rep FontStyle x
$cto :: forall x. Rep FontStyle x -> FontStyle
to :: forall x. Rep FontStyle x -> FontStyle
Generic, Eq FontStyle
Eq FontStyle
-> (FontStyle -> FontStyle -> Ordering)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> FontStyle)
-> (FontStyle -> FontStyle -> FontStyle)
-> Ord FontStyle
FontStyle -> FontStyle -> Bool
FontStyle -> FontStyle -> Ordering
FontStyle -> FontStyle -> FontStyle
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
$ccompare :: FontStyle -> FontStyle -> Ordering
compare :: FontStyle -> FontStyle -> Ordering
$c< :: FontStyle -> FontStyle -> Bool
< :: FontStyle -> FontStyle -> Bool
$c<= :: FontStyle -> FontStyle -> Bool
<= :: FontStyle -> FontStyle -> Bool
$c> :: FontStyle -> FontStyle -> Bool
> :: FontStyle -> FontStyle -> Bool
$c>= :: FontStyle -> FontStyle -> Bool
>= :: FontStyle -> FontStyle -> Bool
$cmax :: FontStyle -> FontStyle -> FontStyle
max :: FontStyle -> FontStyle -> FontStyle
$cmin :: FontStyle -> FontStyle -> FontStyle
min :: FontStyle -> FontStyle -> FontStyle
Ord, ReadPrec [FontStyle]
ReadPrec FontStyle
Int -> ReadS FontStyle
ReadS [FontStyle]
(Int -> ReadS FontStyle)
-> ReadS [FontStyle]
-> ReadPrec FontStyle
-> ReadPrec [FontStyle]
-> Read FontStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS FontStyle
readsPrec :: Int -> ReadS FontStyle
$creadList :: ReadS [FontStyle]
readList :: ReadS [FontStyle]
$creadPrec :: ReadPrec FontStyle
readPrec :: ReadPrec FontStyle
$creadListPrec :: ReadPrec [FontStyle]
readListPrec :: ReadPrec [FontStyle]
Read, Int -> FontStyle -> ShowS
[FontStyle] -> ShowS
FontStyle -> String
(Int -> FontStyle -> ShowS)
-> (FontStyle -> String)
-> ([FontStyle] -> ShowS)
-> Show FontStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontStyle -> ShowS
showsPrec :: Int -> FontStyle -> ShowS
$cshow :: FontStyle -> String
show :: FontStyle -> String
$cshowList :: [FontStyle] -> ShowS
showList :: [FontStyle] -> ShowS
Show)

instance Hashable FontStyle

instance NFData FontStyle

-- | Pick one of the two values based on the 't:FontStyle' value.
splitFontStyle ::
  -- | The value to return in case of 'SansSerif'.
  a ->
  -- | The value to return in case of 'Serif'.
  a ->
  -- | The font style.
  FontStyle ->
  -- | One of the two given values, based on the 't:FontStyle' value.
  a
splitFontStyle :: forall a. a -> a -> FontStyle -> a
splitFontStyle a
x a
y = FontStyle -> a
go
  where
    go :: FontStyle -> a
go FontStyle
SansSerif = a
x
    go FontStyle
Serif = a
y

-- | Specify if one should ligate, or not. When litigation is done
-- characters that are normally written in two (or more) characters
-- are combined in one character. For example @Ⅲ@ instead of @ⅠⅠⅠ@.
data Ligate
  = -- | A ligate operation is performed on the characters, the 'def' for 't:Ligate'.
    Ligate
  | -- | No ligate operation is performed on the charaters.
    NoLigate
  deriving (Ligate
Ligate -> Ligate -> Bounded Ligate
forall a. a -> a -> Bounded a
$cminBound :: Ligate
minBound :: Ligate
$cmaxBound :: Ligate
maxBound :: Ligate
Bounded, Typeable Ligate
Typeable Ligate
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Ligate -> c Ligate)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Ligate)
-> (Ligate -> Constr)
-> (Ligate -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Ligate))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate))
-> ((forall b. Data b => b -> b) -> Ligate -> Ligate)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Ligate -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Ligate -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ligate -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ligate -> m Ligate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ligate -> m Ligate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ligate -> m Ligate)
-> Data Ligate
Ligate -> Constr
Ligate -> DataType
(forall b. Data b => b -> b) -> Ligate -> Ligate
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) -> Ligate -> u
forall u. (forall d. Data d => d -> u) -> Ligate -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ligate
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ligate -> c Ligate
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ligate)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ligate -> c Ligate
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ligate -> c Ligate
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ligate
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ligate
$ctoConstr :: Ligate -> Constr
toConstr :: Ligate -> Constr
$cdataTypeOf :: Ligate -> DataType
dataTypeOf :: Ligate -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ligate)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ligate)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate)
$cgmapT :: (forall b. Data b => b -> b) -> Ligate -> Ligate
gmapT :: (forall b. Data b => b -> b) -> Ligate -> Ligate
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ligate -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ligate -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
Data, Int -> Ligate
Ligate -> Int
Ligate -> [Ligate]
Ligate -> Ligate
Ligate -> Ligate -> [Ligate]
Ligate -> Ligate -> Ligate -> [Ligate]
(Ligate -> Ligate)
-> (Ligate -> Ligate)
-> (Int -> Ligate)
-> (Ligate -> Int)
-> (Ligate -> [Ligate])
-> (Ligate -> Ligate -> [Ligate])
-> (Ligate -> Ligate -> [Ligate])
-> (Ligate -> Ligate -> Ligate -> [Ligate])
-> Enum Ligate
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 :: Ligate -> Ligate
succ :: Ligate -> Ligate
$cpred :: Ligate -> Ligate
pred :: Ligate -> Ligate
$ctoEnum :: Int -> Ligate
toEnum :: Int -> Ligate
$cfromEnum :: Ligate -> Int
fromEnum :: Ligate -> Int
$cenumFrom :: Ligate -> [Ligate]
enumFrom :: Ligate -> [Ligate]
$cenumFromThen :: Ligate -> Ligate -> [Ligate]
enumFromThen :: Ligate -> Ligate -> [Ligate]
$cenumFromTo :: Ligate -> Ligate -> [Ligate]
enumFromTo :: Ligate -> Ligate -> [Ligate]
$cenumFromThenTo :: Ligate -> Ligate -> Ligate -> [Ligate]
enumFromThenTo :: Ligate -> Ligate -> Ligate -> [Ligate]
Enum, Ligate -> Ligate -> Bool
(Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool) -> Eq Ligate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Ligate -> Ligate -> Bool
== :: Ligate -> Ligate -> Bool
$c/= :: Ligate -> Ligate -> Bool
/= :: Ligate -> Ligate -> Bool
Eq, (forall x. Ligate -> Rep Ligate x)
-> (forall x. Rep Ligate x -> Ligate) -> Generic Ligate
forall x. Rep Ligate x -> Ligate
forall x. Ligate -> Rep Ligate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Ligate -> Rep Ligate x
from :: forall x. Ligate -> Rep Ligate x
$cto :: forall x. Rep Ligate x -> Ligate
to :: forall x. Rep Ligate x -> Ligate
Generic, Eq Ligate
Eq Ligate
-> (Ligate -> Ligate -> Ordering)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Ligate)
-> (Ligate -> Ligate -> Ligate)
-> Ord Ligate
Ligate -> Ligate -> Bool
Ligate -> Ligate -> Ordering
Ligate -> Ligate -> Ligate
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
$ccompare :: Ligate -> Ligate -> Ordering
compare :: Ligate -> Ligate -> Ordering
$c< :: Ligate -> Ligate -> Bool
< :: Ligate -> Ligate -> Bool
$c<= :: Ligate -> Ligate -> Bool
<= :: Ligate -> Ligate -> Bool
$c> :: Ligate -> Ligate -> Bool
> :: Ligate -> Ligate -> Bool
$c>= :: Ligate -> Ligate -> Bool
>= :: Ligate -> Ligate -> Bool
$cmax :: Ligate -> Ligate -> Ligate
max :: Ligate -> Ligate -> Ligate
$cmin :: Ligate -> Ligate -> Ligate
min :: Ligate -> Ligate -> Ligate
Ord, ReadPrec [Ligate]
ReadPrec Ligate
Int -> ReadS Ligate
ReadS [Ligate]
(Int -> ReadS Ligate)
-> ReadS [Ligate]
-> ReadPrec Ligate
-> ReadPrec [Ligate]
-> Read Ligate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Ligate
readsPrec :: Int -> ReadS Ligate
$creadList :: ReadS [Ligate]
readList :: ReadS [Ligate]
$creadPrec :: ReadPrec Ligate
readPrec :: ReadPrec Ligate
$creadListPrec :: ReadPrec [Ligate]
readListPrec :: ReadPrec [Ligate]
Read, Int -> Ligate -> ShowS
[Ligate] -> ShowS
Ligate -> String
(Int -> Ligate -> ShowS)
-> (Ligate -> String) -> ([Ligate] -> ShowS) -> Show Ligate
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Ligate -> ShowS
showsPrec :: Int -> Ligate -> ShowS
$cshow :: Ligate -> String
show :: Ligate -> String
$cshowList :: [Ligate] -> ShowS
showList :: [Ligate] -> ShowS
Show)

instance Hashable Ligate

instance NFData Ligate

-- | Pick one of the two values based on the value for 't:Ligate'.
splitLigate ::
  -- | The value to return in case of 'v:Ligate'.
  a ->
  -- | The value to return in case of 'NoLigate'.
  a ->
  -- | The ligation style.
  Ligate ->
  -- | One of the two given values, based on the 't:Ligate' value.
  a
splitLigate :: forall a. a -> a -> Ligate -> a
splitLigate a
x a
y = Ligate -> a
go
  where
    go :: Ligate -> a
go Ligate
Ligate = a
x
    go Ligate
NoLigate = a
y

-- | Specify if the given ligate function should be performed on the input,
-- if 'v:Ligate' is passed, and the /identity/ function otherwise.
ligate :: (a -> a) -> Ligate -> a -> a
ligate :: forall a. (a -> a) -> Ligate -> a -> a
ligate a -> a
f Ligate
Ligate = a -> a
f
ligate a -> a
_ Ligate
NoLigate = a -> a
forall a. a -> a
id

-- | Specify if the given ligate function is performed over the functor object
-- if 'v:Ligate' is passed, and the /identity/ function otherwise.
ligateF :: Functor f => (a -> a) -> Ligate -> f a -> f a
ligateF :: forall (f :: * -> *) a.
Functor f =>
(a -> a) -> Ligate -> f a -> f a
ligateF = (f a -> f a) -> Ligate -> f a -> f a
forall a. (a -> a) -> Ligate -> a -> a
ligate ((f a -> f a) -> Ligate -> f a -> f a)
-> ((a -> a) -> f a -> f a) -> (a -> a) -> Ligate -> f a -> f a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> a) -> f a -> f a
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

-- | Checks if a charcter is an /alphabetic/ character in ASCII. The characters
-- @"ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz"@ satisfy this
-- predicate.
isAsciiAlpha :: Char -> Bool
isAsciiAlpha :: Char -> Bool
isAsciiAlpha Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlpha Char
x

-- | Checks if a character is an /alphabetic/ or /numerical/ character in ASCII.
-- The characters @0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz@
-- satisfy this predicate.
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum :: Char -> Bool
isAsciiAlphaNum Char
x = Char -> Bool
isAscii Char
x Bool -> Bool -> Bool
&& Char -> Bool
isAlphaNum Char
x

-- | Checks if a character is a basic /greek alphabetic/ character or a Greek-like symbol.
-- The characters @ΑΒΓΔΕΖΗΘΙΚΛΜΝΞΟΠΡΣΤΥΦΧΨΩ∇ϴαβγδεζηθικλμνξοπρςστυφχψω∂ϵϑϰϕϱϖ@ satisfy this predicate.
isGreek :: Char -> Bool
isGreek :: Char -> Bool
isGreek Char
'ϑ' = Bool
True -- U+03D1 GREEK THETA SYMBOL
isGreek Char
'ϕ' = Bool
True -- U+03D5 GREEK PHI SYMBOL
isGreek Char
'ϖ' = Bool
True -- U+03D6 GREEK PI SYMBOL
isGreek Char
'ϰ' = Bool
True -- U+03F0 GREEK KAPPA SYMBOL
isGreek Char
'ϱ' = Bool
True -- U+03F1 GREEK RHO SYMBOL
isGreek Char
'ϴ' = Bool
True -- U+03F4 GREEK CAPITAL THETA SYMBOL
isGreek Char
'ϵ' = Bool
True -- U+03F5 GREEK LUNATE EPSILON SYMBOL
isGreek Char
'∂' = Bool
True -- U+2202 PARTIAL DIFFERENTIAL
isGreek Char
'∇' = Bool
True -- U+2207 NABLA
isGreek Char
c =
  (Char
'Α' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'Ω' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\x03A2') -- U+0391 GREEK CAPITAL LETTER ALPHA, U+03A9 GREEK CAPITAL LETTER OMEGA
    Bool -> Bool -> Bool
|| (Char
'α' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'ω') -- U+03B1 GREEK SMALL LETTER ALPHA, U+03C9 GREEK SMALL LETTER OMEGA

-- | Calculate for a given plus and minus sign a 'Text' object for the given
-- number in the given 'PlusStyle'.
withSign ::
  Integral i =>
  -- | The function that maps the absolute value of the number to a 'Text' object that is appended to the sign.
  (i -> Text) ->
  -- | The /plus/ sign to use.
  Char ->
  -- | The /minus/ sign to use.
  Char ->
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given 'Integral' number to render.
  i ->
  -- | A 'Text' object that represents the given number, with the given sign numbers in the given 'PlusStyle'.
  Text
withSign :: forall i.
Integral i =>
(i -> Text) -> Char -> Char -> PlusStyle -> i -> Text
withSign i -> Text
f Char
cp Char
cn PlusStyle
ps i
n
  | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
0 = Char -> Text -> Text
cons Char
cn (i -> Text
f (-i
n))
  | PlusStyle
WithPlus <- PlusStyle
ps = Char -> Text -> Text
cons Char
cp (i -> Text
f i
n)
  | Bool
otherwise = i -> Text
f i
n

-- | A function to make it more convenient to implement a /sign-value system/.
-- This is done for a given /radix/ a function that maps the given value and the
-- given weight to a 'Text' object, a 'Text' object for /zero/ (since in some
-- systems that is different), and characters for /plus/ and /minus/.
-- The function then will for a given 'PlusStyle' convert the number to a
-- sequence of characters with respect to how the /sign-value system/ is
-- implemented.
signValueSystem ::
  Integral i =>
  -- | The given /radix/ to use.
  i ->
  -- | A function that maps the /value/ and the /weight/ to a 'Text' object.
  (Int -> Int -> Text) ->
  -- | The given 'Text' used to represent /zero/.
  Text ->
  -- | The given 'Char' used to denote /plus/.
  Char ->
  -- | The given 'Char' used to denote /minus/.
  Char ->
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given number to convert.
  i ->
  -- | A 'Text' object that denotes the given number with the given /sign-value system/.
  Text
signValueSystem :: forall i.
Integral i =>
i
-> (Int -> Int -> Text)
-> Text
-> Char
-> Char
-> PlusStyle
-> i
-> Text
signValueSystem i
radix Int -> Int -> Text
fi Text
zero = (i -> Text) -> Char -> Char -> PlusStyle -> i -> Text
forall i.
Integral i =>
(i -> Text) -> Char -> Char -> PlusStyle -> i -> Text
withSign (Int -> i -> Text
f Int
0)
  where
    f :: Int -> i -> Text
f Int
0 i
0 = Text
zero
    f Int
i i
n
      | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
radix = i -> Int -> Text
fi' i
n Int
i
      | Bool
otherwise = Int -> i -> Text
f (Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) i
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> i -> Int -> Text
fi' i
r Int
i
      where
        (i
q, i
r) = i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
quotRem i
n i
radix
    fi' :: i -> Int -> Text
fi' = (Int -> Int -> Text) -> Int -> Int -> Text
forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Text
fi (Int -> Int -> Text) -> (i -> Int) -> i -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | A function to make it more convenient to implement a /positional number
-- system/. This is done for a given /radix/ a given conversion funtion that
-- maps a value to a 'Char', and a 'Char' for /plus/ and /minus/.
-- The function then construct a 'Text' object for a given 'PlusStyle' and a given number.
positionalNumberSystem ::
  Integral i =>
  -- | The given radix to use.
  i ->
  -- | A function that maps the value of a /digit/ to the corresponding 'Char'.
  (Int -> Char) ->
  -- | The given character used to denote /plus/.
  Char ->
  -- | The given character used to denote /minus/.
  Char ->
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given number to convert.
  i ->
  -- | A 'Text' object that denotes the given number with the given /positional number system/.
  Text
positionalNumberSystem :: forall i.
Integral i =>
i -> (Int -> Char) -> Char -> Char -> PlusStyle -> i -> Text
positionalNumberSystem i
radix Int -> Char
fi = (i -> Text) -> Char -> Char -> PlusStyle -> i -> Text
forall i.
Integral i =>
(i -> Text) -> Char -> Char -> PlusStyle -> i -> Text
withSign i -> Text
f
  where
    f :: i -> Text
f i
n
      | i
n i -> i -> Bool
forall a. Ord a => a -> a -> Bool
< i
radix = Char -> Text
singleton (i -> Char
fi' i
n)
      | Bool
otherwise = Text -> Char -> Text
snoc (i -> Text
f i
q) (i -> Char
fi' i
r)
      where
        (i
q, i
r) = i -> i -> (i, i)
forall a. Integral a => a -> a -> (a, a)
quotRem i
n i
radix
    fi' :: i -> Char
fi' = Int -> Char
fi (Int -> Char) -> (i -> Int) -> i -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. i -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral

-- | A function to make it more convenient to implement a /positional number
-- system/ with /radix/ 10.
positionalNumberSystem10 ::
  Integral i =>
  -- | A function that maps the value of a /digit/ to the corresponding 'Char'.
  (Int -> Char) ->
  -- | The given character used to denote /plus/.
  Char ->
  -- | The given character used to denote /minus/.
  Char ->
  -- | The given 'PlusStyle' to use.
  PlusStyle ->
  -- | The given number to convert.
  i ->
  -- | A 'Text' object that denotes the given number with the given /positional number system/.
  Text
positionalNumberSystem10 :: forall i.
Integral i =>
(Int -> Char) -> Char -> Char -> PlusStyle -> i -> Text
positionalNumberSystem10 = i -> (Int -> Char) -> Char -> Char -> PlusStyle -> i -> Text
forall i.
Integral i =>
i -> (Int -> Char) -> Char -> Char -> PlusStyle -> i -> Text
positionalNumberSystem i
10

-- | Check if the given character is not a /reserved character/. This is denoted in
-- the Unicode documentation with @\<reserved\>@.
isNotReserved ::
  -- | The given 'Char'acter to check.
  Char ->
  -- | 'True' if the given 'Char'acter is not reserved; 'False' otherwise.
  Bool
isNotReserved :: Char -> Bool
isNotReserved = Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isReserved

-- | Check if the given character is a /reserved character/. This is denoted in
-- the Unicode documentation with @\<reserved\>@.
isReserved ::
  -- | The given 'Char'acter to check.
  Char ->
  -- | 'True' if the given 'Char'acter is reserved; 'False' otherwise.
  Bool
isReserved :: Char -> Bool
isReserved Char
'\x9e4' = Bool
True
isReserved Char
'\x9e5' = Bool
True
isReserved Char
'\xa64' = Bool
True
isReserved Char
'\xa65' = Bool
True
isReserved Char
'\xae4' = Bool
True
isReserved Char
'\xae5' = Bool
True
isReserved Char
'\xb64' = Bool
True
isReserved Char
'\xb65' = Bool
True
isReserved Char
'\xbe4' = Bool
True
isReserved Char
'\xbe5' = Bool
True
isReserved Char
'\xc64' = Bool
True
isReserved Char
'\xc65' = Bool
True
isReserved Char
'\xce4' = Bool
True
isReserved Char
'\xce5' = Bool
True
isReserved Char
'\xd64' = Bool
True
isReserved Char
'\xd65' = Bool
True
isReserved Char
'\x2072' = Bool
True
isReserved Char
'\x2073' = Bool
True
isReserved Char
'\x1d4a0' = Bool
True
isReserved Char
'\x1d4a1' = Bool
True
isReserved Char
'\x1d4a3' = Bool
True
isReserved Char
'\x1d4a4' = Bool
True
isReserved Char
'\x1d4a7' = Bool
True
isReserved Char
'\x1d4a8' = Bool
True
isReserved Char
'\x1d50b' = Bool
True
isReserved Char
'\x1d50c' = Bool
True
isReserved Char
'\x1d455' = Bool
True
isReserved Char
'\x1d49d' = Bool
True
isReserved Char
'\x1d4ad' = Bool
True
isReserved Char
'\x1d4ba' = Bool
True
isReserved Char
'\x1d4bc' = Bool
True
isReserved Char
'\x1d4c4' = Bool
True
isReserved Char
'\x1d506' = Bool
True
isReserved Char
'\x1d515' = Bool
True
isReserved Char
'\x1d51d' = Bool
True
isReserved Char
'\x1d53a' = Bool
True
isReserved Char
'\x1d53f' = Bool
True
isReserved Char
'\x1d545' = Bool
True
isReserved Char
'\x1d551' = Bool
True
isReserved Char
c = Char
'\x1d547' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1d549'

-- | Check if the given character is a character according to the Unicode
-- specifications. Codepoints that are not a character are denoted in the
-- Unicode documentation with @\<not a character\>@.
isACharacter ::
  -- | The given 'Char'acter to check.
  Char ->
  -- | 'True' if the given 'Char'acter is a character (according to the Unicode specifications); 'False' otherwise.
  Bool
isACharacter :: Char -> Bool
isACharacter Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xfffe Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0xfffe Bool -> Bool -> Bool
&& (Char
'\xfdd0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
> Char
'\xfdef')

-- | Check if the given character is not a character according to the Unicode
-- specifications. The Unicode documentation denotes these with @\<not a character\>@.
isNotACharacter ::
  -- | The given 'Char'acter to check.
  Char ->
  -- | 'True' if the given 'Char'acter is not a character (according to the Unicode specifications); 'False' otherwise.
  Bool
isNotACharacter :: Char -> Bool
isNotACharacter Char
c = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xfffe Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0xfffe Bool -> Bool -> Bool
|| Char
'\xfdd0' Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\xfdef'

-- | Map the given 'Char' object to an object with a type that is an instance of
-- 'Enum' with a given offset for the 'Char'acter range.
mapToEnum ::
  Enum a =>
  -- | The given /offset/ value.
  Int ->
  -- | The 'Char'acter to map to an 'Enum' object.
  Char ->
  -- | The given 'Enum' object for the given 'Char'.
  a
mapToEnum :: forall a. Enum a => Int -> Char -> a
mapToEnum Int
o = Int -> a
forall a. Enum a => Int -> a
toEnum (Int -> a) -> (Char -> Int) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int -> Int
forall a. Num a => a -> a -> a
subtract Int
o (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord

-- | Map the given 'Char' object to an object with a type that is an instance of
-- 'Enum'. It first checks if the mapping results in a value between the
-- 'fromEnum' values for 'minBound' and 'maxBound'.
mapToEnumSafe ::
  forall a.
  (Bounded a, Enum a) =>
  -- | The given /offset/ value.
  Int ->
  -- | The given 'Char'acter to map to an 'Enum' object.
  Char ->
  -- | The given 'Enum' object for the given 'Char'acter wrapped in a 'Just' if that exists; 'Nothing' otherwise.
  Maybe a
mapToEnumSafe :: forall a. (Bounded a, Enum a) => Int -> Char -> Maybe a
mapToEnumSafe Int
o = Char -> Maybe a
forall {a}. Enum a => Char -> Maybe a
go
  where
    go :: Char -> Maybe a
go Char
c
      | Int
e0 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
ei Bool -> Bool -> Bool
&& Int
ei Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
en = a -> Maybe a
forall a. a -> Maybe a
Just (Int -> a
forall a. Enum a => Int -> a
toEnum Int
ei)
      | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing
      where
        ei :: Int
ei = Char -> Int
ord Char
c Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o
    e0 :: Int
e0 = a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a)
    en :: Int
en = a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound :: a)

-- | Map the given object with a type that is an instance of 'Enum' to a
-- 'Char'acter with a given offset for the 'Char'acter value.
mapFromEnum ::
  Enum a =>
  -- | The given /offset/ value.
  Int ->
  -- | The given 'Enum' value to convert to a 'Char'acter.
  a ->
  -- | The character that corresponds to the given 'Enum' object.
  Char
mapFromEnum :: forall a. Enum a => Int -> a -> Char
mapFromEnum Int
o = Int -> Char
chr (Int -> Char) -> (a -> Int) -> a -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
o Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (a -> Int) -> a -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Int
forall a. Enum a => a -> Int
fromEnum

-- | An alias of the 'UnicodeCharacter' type class.
type UnicodeChar = UnicodeCharacter

-- | A class from which objects can be derived that map to and from a /single/
-- unicode character.
class UnicodeCharacter a where
  -- | Convert the given object to a Unicode 'Char'acter.
  toUnicodeChar ::
    -- | The given object to convert to a 'Char'acter.
    a ->
    -- | The equivalent Unicode 'Char'acter.
    Char

  -- | Convert the given 'Char'acter to an object wrapped in a 'Just' data
  -- constructor if that exists; 'Nothing' otherwise.
  fromUnicodeChar ::
    -- | The given 'Char'acter to convert to an element.
    Char ->
    -- | An element if the given 'Char'acter maps to an element wrapped in a 'Just'; 'Nothing' otherwise.
    Maybe a

  -- | Convert the given 'Char'acter to an object. If the 'Char'acter does not
  -- map on an element, the behavior is /unspecified/, it can for example
  -- result in an error.
  fromUnicodeChar' ::
    -- | The given 'Char'acter to convert to an element.
    Char ->
    -- | The given element that is equivalent to the given 'Char'acter.
    a
  fromUnicodeChar' = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Char -> Maybe a) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe a
forall a. UnicodeCharacter a => Char -> Maybe a
fromUnicodeChar

  -- | Check if the given 'Char'acter maps on an item of @a@.
  isInCharRange ::
    -- | The given 'Char'acter to test.
    Char ->
    -- | 'True' if the given 'Char'acter has a corresponding value for @a@; 'False' otherwise.
    Bool
  isInCharRange = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (Char -> Maybe a) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. UnicodeCharacter a => Char -> Maybe a
fromUnicodeChar @a)

  {-# MINIMAL toUnicodeChar, fromUnicodeChar #-}

-- | A class from which boejcts can be derived that map to and from a /sequence/
-- of unicode characters.
class UnicodeText a where
  -- | Convert the given object to a 'Text' object.
  toUnicodeText ::
    -- | The given object to convert to a 'Text' object.
    a ->
    -- | A 'Text' object that is the Unicode representation of the element.
    Text
  default toUnicodeText :: UnicodeCharacter a => a -> Text
  toUnicodeText = Char -> Text
singleton (Char -> Text) -> (a -> Char) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Char
forall a. UnicodeCharacter a => a -> Char
toUnicodeChar

  -- | Convert the given 'Text' to an object wrapped in a 'Just' data
  -- constructor if that exists; 'Nothing' otherwise.
  fromUnicodeText ::
    -- | The given 'Text' to convert to an object.
    Text ->
    -- | The equivalent object wrapped in a 'Just' data constructor if it exists; 'Nothing' otherwise.
    Maybe a
  default fromUnicodeText :: UnicodeCharacter a => Text -> Maybe a
  fromUnicodeText Text
t
    | [Char
c] <- Text -> String
unpack Text
t = Char -> Maybe a
forall a. UnicodeCharacter a => Char -> Maybe a
fromUnicodeChar Char
c
    | Bool
otherwise = Maybe a
forall a. Maybe a
Nothing

  -- | Convert the given 'Text' to an object. If the 'Text' does not map on
  -- an element, the behavior is /unspecified/, it can for example result in
  -- an error.
  fromUnicodeText' ::
    -- | The given 'Text' to convert to an object.
    Text ->
    -- | The given equivalent object. If there is no equivalent object, the behavior is unspecified.
    a
  fromUnicodeText' = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Text -> Maybe a) -> Text -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe a
forall a. UnicodeText a => Text -> Maybe a
fromUnicodeText

  -- | Determine if the given 'Text' value maps on a value of type @a@.
  isInTextRange ::
    -- | The given 'Text' object to test.
    Text ->
    -- | 'True' if there is a counterpart of type @a@; 'False' otherwise.
    Bool
  isInTextRange = Maybe a -> Bool
forall a. Maybe a -> Bool
isJust (Maybe a -> Bool) -> (Text -> Maybe a) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. UnicodeText a => Text -> Maybe a
fromUnicodeText @a)

-- | Convert a given 'isInCharRange' check into a 'isInTextRange' check.
generateIsInTextRange ::
  -- | The given 'isInCharRange' check.
  (Char -> Bool) ->
  -- | The 'Text' object to check.
  Text ->
  -- | 'True' if the given 'Text' object has a single character for which the 'isInCharRange' check succeeds, 'False' otherwise.
  Bool
generateIsInTextRange :: (Char -> Bool) -> Text -> Bool
generateIsInTextRange Char -> Bool
f = Maybe (Char, Text) -> Bool
go (Maybe (Char, Text) -> Bool)
-> (Text -> Maybe (Char, Text)) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe (Char, Text)
uncons
  where
    go :: Maybe (Char, Text) -> Bool
go (Just (Char
c, Text
t)) = Text -> Bool
null Text
t Bool -> Bool -> Bool
&& Char -> Bool
f Char
c
    go Maybe (Char, Text)
Nothing = Bool
False

-- | Generate an 'isInTextRange' check with the 'isInCharRange' check for the instance of 'UnicodeCharacter' of that type.
generateIsInTextRange' ::
  forall a.
  UnicodeCharacter a =>
  -- | The given 'Text' object to check.
  Text ->
  -- | 'True' if the given 'Text' object has a single character for which the 'isInCharRange' check succeeds, 'False' otherwise.
  Bool
generateIsInTextRange' :: forall a. UnicodeCharacter a => Text -> Bool
generateIsInTextRange' = (Char -> Bool) -> Text -> Bool
generateIsInTextRange (forall a. UnicodeCharacter a => Char -> Bool
isInCharRange @a)

-- | A type class that specifies that the items can be mirrored in the /horizontal/ direction (such that up is now down).
-- The mirror is /not/ per se /pixel perfect/. For example the mirror of 🂁 is 🁵, so the dots of the bottom pat
-- of the domino are not mirrored correctly.
class MirrorHorizontal a where
  -- | Obtain the /horizontally/ mirrored variant of the given item. Applying the same function twice should
  -- return the original object.
  mirrorHorizontal ::
    -- | The given item to mirror /horizontally/.
    a ->
    -- | The corresponding mirrored item.
    a

  {-# MINIMAL mirrorHorizontal #-}

-- | A type class that specifies that the items can be mirrored in the /vertical/ direction (such that left is now right).
-- The mirror is /not/ per se pixel perfect. For example the vertical mirror of 🁏 is 🁃, so the dots of the right part
-- of the domino are not mirrored correctly.
class MirrorVertical a where
  -- | Obtain the /vertically/ mirrored variant of the given item. Applying the same function twice should
  -- return the original object.
  mirrorVertical ::
    -- | The given item to mirror /vertically/.
    a ->
    -- | The corresponding mirrored item.
    a

  {-# MINIMAL mirrorVertical #-}

-- | Construct a function that maps digits to the character with the given value
-- for the offset.
liftNumberFrom ::
  -- | The given offset value.
  Int ->
  -- | The maximum value that can be mapped.
  Int ->
  -- | The given Unicode value used for the offset.
  Int ->
  -- | The given number to convert, must be between the offset and the maximum.
  Int ->
  -- | The corresponding 'Char'acter wrapped in a 'Just' if the number is between the offset and the maximum; 'Nothing' otherwise.
  Maybe Char
liftNumberFrom :: Int -> Int -> Int -> Int -> Maybe Char
liftNumberFrom Int
o Int
m Int
d = Int -> Maybe Char
go
  where
    go :: Int -> Maybe Char
go Int
n
      | Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
o Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
m = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
n))
      | Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
    !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o

-- | Construct a function that maps digits to the character with the given value
-- for the offset.
liftNumberFrom' ::
  -- | The given offset value.
  Int ->
  -- | The given Unicode value used for the offset.
  Int ->
  -- | The given number to convert to a corresponding 'Char'acter.
  Int ->
  -- | The corresponding 'Char'acter for the given mapping function.
  Char
liftNumberFrom' :: Int -> Int -> Int -> Char
liftNumberFrom' Int
o Int
d = Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+)
  where
    !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
o

-- | Construct a function that maps digits to the character with the given value
-- for @0@.
liftNumber ::
  -- | The maximum value that can be mapped.
  Int ->
  -- | The given Unicode value used for @0@.
  Int ->
  -- | The given digit to convert to a number between 0 and the maximum.
  Int ->
  -- | The corresponding 'Char'acter wrapped in a 'Just' if the number is between @0@ and @9@; 'Nothing' otherwise.
  Maybe Char
liftNumber :: Int -> Int -> Int -> Maybe Char
liftNumber = Int -> Int -> Int -> Int -> Maybe Char
liftNumberFrom Int
0

-- | Construct a function that maps digits to characters with the given value
-- for @0@.
liftNumber' ::
  -- | The  given Unicode value used for @0@.
  Int ->
  -- | The given digit to convert.
  Int ->
  -- | The corresponding 'Char'acter, for numbers outside the @0-9@ range, the result is unspecified.
  Char
liftNumber' :: Int -> Int -> Char
liftNumber' = Int -> Int -> Char
liftDigit'

-- | Construct a function that maps digits to the character with the given value
-- for @0@.
liftDigit ::
  -- | The given Unicode value used for @0@.
  Int ->
  -- | The given digit to convert to a number between 0 and 9.
  Int ->
  -- | The corresponding 'Char'acter wrapped in a 'Just' if the number is between @0@ and @9@; 'Nothing' otherwise.
  Maybe Char
liftDigit :: Int -> Int -> Maybe Char
liftDigit = Int -> Int -> Int -> Maybe Char
liftNumber Int
9

-- | Construct a function that maps digits to characters with the given value
-- for @0@.
liftDigit' ::
  -- | The  given Unicode value used for @0@.
  Int ->
  -- | The given digit to convert, must be between @0@ and @9@.
  Int ->
  -- | The corresponding 'Char'acter, for numbers outside the @0-9@ range, the result is unspecified.
  Char
liftDigit' :: Int -> Int -> Char
liftDigit' Int
d = Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+)

-- | Construct a function that maps upper case alphabetic characters with the
-- given value for @A@.
liftUppercase ::
  -- | The given Unicode value for @A@.
  Int ->
  -- | The given character to convert.
  Char ->
  -- | The corresponding character wrapped in a 'Just' if the given character is in the @A-Z@ range; 'Nothing' otherwise.
  Maybe Char
liftUppercase :: Int -> Char -> Maybe Char
liftUppercase Int
d = Char -> Maybe Char
go
  where
    go :: Char -> Maybe Char
go Char
c
      | Char -> Bool
isAsciiUpper Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c))
      | Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
    !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65

-- | Construct a function that maps upper case alphabetic characters with the
-- given value for @A@.
liftUppercase' ::
  -- | The given Unicode value for @A@.
  Int ->
  -- | The given upper case alphabetic value to convert.
  Char ->
  -- | The corresponding character, if the given value is outside the @A-Z@ range, the result is unspecified.
  Char
liftUppercase' :: Int -> Char -> Char
liftUppercase' Int
d = Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  where
    !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65

-- | Construct a function that maps lower case alphabetic characters with the
-- given value for @a@.
liftLowercase ::
  -- | The given Unicode value for @a@.
  Int ->
  -- | The given character to convert.
  Char ->
  -- | The corresponding character wrapped in a 'Just' if the given character is in the @a-z@ range; 'Nothing' otherwise.
  Maybe Char
liftLowercase :: Int -> Char -> Maybe Char
liftLowercase Int
d = Char -> Maybe Char
go
  where
    go :: Char -> Maybe Char
go Char
c
      | Char -> Bool
isAsciiLower Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c))
      | Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
    !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
97

-- | Construct a function that maps lower case alphabetic characters with the
-- given value for @a@.
liftLowercase' ::
  -- | The given Unicode value for @a@.
  Int ->
  -- | The given upper case alphabetic value to convert.
  Char ->
  -- | The corresponding character, if the given value is outside the @a-z@ range, the result is unspecified.
  Char
liftLowercase' :: Int -> Char -> Char
liftLowercase' Int
d = Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  where
    !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
97

-- | Construct a function that maps lower case alphabetic characters with the
-- given values for @A@ and @a@.
liftUpperLowercase ::
  -- | The given Unicode value for @A@.
  Int ->
  -- | The given Unicode value for @a@.
  Int ->
  -- | The given character to convert.
  Char ->
  -- | The corresponding character wrapped in a 'Just' if the given character is in the @A-Z,a-z@ range; 'Nothing' otherwise.
  Maybe Char
liftUpperLowercase :: Int -> Int -> Char -> Maybe Char
liftUpperLowercase Int
du Int
dl = Char -> Maybe Char
go
  where
    go :: Char -> Maybe Char
go Char
c
      | Char -> Bool
isAsciiLower Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Int
dl' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c'))
      | Char -> Bool
isAsciiUpper Char
c = Char -> Maybe Char
forall a. a -> Maybe a
Just (Int -> Char
chr (Int
du' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c'))
      | Bool
otherwise = Maybe Char
forall a. Maybe a
Nothing
      where
        c' :: Int
c' = Char -> Int
ord Char
c
    !du' :: Int
du' = Int
du Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65
    !dl' :: Int
dl' = Int
dl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
97

-- | Construct a function that maps lower case alphabetic characters with the
-- given values for @A@ and @a@.
liftUpperLowercase' ::
  -- | The given Unicode value for @A@.
  Int ->
  -- | The given Unicode value for @a@.
  Int ->
  -- | The given character to convert.
  Char ->
  -- | The corresponding character if the given character is in the @A-Z,a-z@ range; unspecified otherwise.
  Char
liftUpperLowercase' :: Int -> Int -> Char -> Char
liftUpperLowercase' Int
du Int
dl = Char -> Char
go
  where
    go :: Char -> Char
go Char
c
      | Char -> Bool
isAsciiUpper Char
c = Int -> Char
chr (Int
du' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c')
      | Bool
otherwise = Int -> Char
chr (Int
dl' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
c')
      where
        c' :: Int
c' = Char -> Int
ord Char
c
    du' :: Int
du' = Int
du Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65
    dl' :: Int
dl' = Int
dl Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
97

instance Arbitrary LetterCase where
  arbitrary :: Gen LetterCase
arbitrary = Gen LetterCase
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary Orientation where
  arbitrary :: Gen Orientation
arbitrary = Gen Orientation
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary a => Arbitrary (Oriented a) where
  arbitrary :: Gen (Oriented a)
arbitrary = Gen (Oriented a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1

instance Arbitrary a => Arbitrary (Rotated a) where
  arbitrary :: Gen (Rotated a)
arbitrary = Gen (Rotated a)
forall (f :: * -> *) a. (Arbitrary1 f, Arbitrary a) => Gen (f a)
arbitrary1

instance Arbitrary1 Oriented where
  liftArbitrary :: forall a. Gen a -> Gen (Oriented a)
liftArbitrary Gen a
arb = a -> Orientation -> Oriented a
forall a. a -> Orientation -> Oriented a
Oriented (a -> Orientation -> Oriented a)
-> Gen a -> Gen (Orientation -> Oriented a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb Gen (Orientation -> Oriented a)
-> Gen Orientation -> Gen (Oriented a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Orientation
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary1 Rotated where
  liftArbitrary :: forall a. Gen a -> Gen (Rotated a)
liftArbitrary Gen a
arb = a -> Rotate90 -> Rotated a
forall a. a -> Rotate90 -> Rotated a
Rotated (a -> Rotate90 -> Rotated a)
-> Gen a -> Gen (Rotate90 -> Rotated a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb Gen (Rotate90 -> Rotated a) -> Gen Rotate90 -> Gen (Rotated a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Rotate90
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary PlusStyle where
  arbitrary :: Gen PlusStyle
arbitrary = Gen PlusStyle
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary Rotate90 where
  arbitrary :: Gen Rotate90
arbitrary = Gen Rotate90
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary Ligate where
  arbitrary :: Gen Ligate
arbitrary = Gen Ligate
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary Emphasis where
  arbitrary :: Gen Emphasis
arbitrary = Gen Emphasis
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary ItalicType where
  arbitrary :: Gen ItalicType
arbitrary = Gen ItalicType
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Arbitrary FontStyle where
  arbitrary :: Gen FontStyle
arbitrary = Gen FontStyle
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum

instance Default LetterCase where
  def :: LetterCase
def = LetterCase
UpperCase

instance Default PlusStyle where
  def :: PlusStyle
def = PlusStyle
WithoutPlus

instance Default Ligate where
  def :: Ligate
def = Ligate
Ligate

instance Default Emphasis where
  def :: Emphasis
def = Emphasis
NoBold

instance Default ItalicType where
  def :: ItalicType
def = ItalicType
NoItalic

instance Default FontStyle where
  def :: FontStyle
def = FontStyle
Serif

instance UnicodeCharacter Char where
  toUnicodeChar :: Char -> Char
toUnicodeChar = Char -> Char
forall a. a -> a
id
  fromUnicodeChar :: Char -> Maybe Char
fromUnicodeChar = Char -> Maybe Char
forall a. a -> Maybe a
Just
  fromUnicodeChar' :: Char -> Char
fromUnicodeChar' = Char -> Char
forall a. a -> a
id
  isInCharRange :: Char -> Bool
isInCharRange = Bool -> Char -> Bool
forall a b. a -> b -> a
const Bool
True

instance UnicodeText [Char] where
  toUnicodeText :: String -> Text
toUnicodeText = String -> Text
pack
  fromUnicodeText :: Text -> Maybe String
fromUnicodeText = String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String)
-> (Text -> String) -> Text -> Maybe String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  fromUnicodeText' :: Text -> String
fromUnicodeText' = Text -> String
unpack
  isInTextRange :: Text -> Bool
isInTextRange = Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True

instance UnicodeText Char where
  isInTextRange :: Text -> Bool
isInTextRange Text
cs
    | Just (Char
_, Text
c) <- Text -> Maybe (Char, Text)
uncons Text
cs = Text -> Bool
null Text
c
    | Bool
otherwise = Bool
False

instance UnicodeText Text where
  toUnicodeText :: Text -> Text
toUnicodeText = Text -> Text
forall a. a -> a
id
  fromUnicodeText :: Text -> Maybe Text
fromUnicodeText = Text -> Maybe Text
forall a. a -> Maybe a
Just
  fromUnicodeText' :: Text -> Text
fromUnicodeText' = Text -> Text
forall a. a -> a
id
  isInTextRange :: Text -> Bool
isInTextRange = Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True