{-# 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
forall a. a -> a -> Bounded a
maxBound :: LetterCase
$cmaxBound :: LetterCase
minBound :: LetterCase
$cminBound :: LetterCase
Bounded, Typeable LetterCase
LetterCase -> DataType
LetterCase -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> LetterCase -> m LetterCase
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterCase -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterCase -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> LetterCase -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetterCase -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LetterCase -> r
gmapT :: (forall b. Data b => b -> b) -> LetterCase -> LetterCase
$cgmapT :: (forall b. Data b => b -> b) -> LetterCase -> LetterCase
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterCase)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c LetterCase)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterCase)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LetterCase)
dataTypeOf :: LetterCase -> DataType
$cdataTypeOf :: LetterCase -> DataType
toConstr :: LetterCase -> Constr
$ctoConstr :: LetterCase -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterCase
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LetterCase
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterCase -> c LetterCase
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterCase -> c LetterCase
Data, Int -> LetterCase
LetterCase -> Int
LetterCase -> [LetterCase]
LetterCase -> LetterCase
LetterCase -> LetterCase -> [LetterCase]
LetterCase -> LetterCase -> LetterCase -> [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
enumFromThenTo :: LetterCase -> LetterCase -> LetterCase -> [LetterCase]
$cenumFromThenTo :: LetterCase -> LetterCase -> LetterCase -> [LetterCase]
enumFromTo :: LetterCase -> LetterCase -> [LetterCase]
$cenumFromTo :: LetterCase -> LetterCase -> [LetterCase]
enumFromThen :: LetterCase -> LetterCase -> [LetterCase]
$cenumFromThen :: LetterCase -> LetterCase -> [LetterCase]
enumFrom :: LetterCase -> [LetterCase]
$cenumFrom :: LetterCase -> [LetterCase]
fromEnum :: LetterCase -> Int
$cfromEnum :: LetterCase -> Int
toEnum :: Int -> LetterCase
$ctoEnum :: Int -> LetterCase
pred :: LetterCase -> LetterCase
$cpred :: LetterCase -> LetterCase
succ :: LetterCase -> LetterCase
$csucc :: LetterCase -> LetterCase
Enum, LetterCase -> LetterCase -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LetterCase -> LetterCase -> Bool
$c/= :: LetterCase -> LetterCase -> Bool
== :: LetterCase -> LetterCase -> Bool
$c== :: LetterCase -> LetterCase -> Bool
Eq, 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
$cto :: forall x. Rep LetterCase x -> LetterCase
$cfrom :: forall x. LetterCase -> Rep LetterCase x
Generic, Eq 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
min :: LetterCase -> LetterCase -> LetterCase
$cmin :: LetterCase -> LetterCase -> LetterCase
max :: LetterCase -> LetterCase -> LetterCase
$cmax :: LetterCase -> LetterCase -> LetterCase
>= :: LetterCase -> LetterCase -> Bool
$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
compare :: LetterCase -> LetterCase -> Ordering
$ccompare :: LetterCase -> LetterCase -> Ordering
Ord, ReadPrec [LetterCase]
ReadPrec LetterCase
Int -> ReadS LetterCase
ReadS [LetterCase]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LetterCase]
$creadListPrec :: ReadPrec [LetterCase]
readPrec :: ReadPrec LetterCase
$creadPrec :: ReadPrec LetterCase
readList :: ReadS [LetterCase]
$creadList :: ReadS [LetterCase]
readsPrec :: Int -> ReadS LetterCase
$creadsPrec :: Int -> ReadS LetterCase
Read, Int -> LetterCase -> ShowS
[LetterCase] -> ShowS
LetterCase -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LetterCase] -> ShowS
$cshowList :: [LetterCase] -> ShowS
show :: LetterCase -> String
$cshow :: LetterCase -> String
showsPrec :: Int -> LetterCase -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
maxBound :: PlusStyle
$cmaxBound :: PlusStyle
minBound :: PlusStyle
$cminBound :: PlusStyle
Bounded, Typeable PlusStyle
PlusStyle -> DataType
PlusStyle -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlusStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlusStyle -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> PlusStyle -> r
gmapT :: (forall b. Data b => b -> b) -> PlusStyle -> PlusStyle
$cgmapT :: (forall b. Data b => b -> b) -> PlusStyle -> PlusStyle
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlusStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c PlusStyle)
dataTypeOf :: PlusStyle -> DataType
$cdataTypeOf :: PlusStyle -> DataType
toConstr :: PlusStyle -> Constr
$ctoConstr :: PlusStyle -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlusStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c PlusStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlusStyle -> c PlusStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlusStyle -> c PlusStyle
Data, Int -> PlusStyle
PlusStyle -> Int
PlusStyle -> [PlusStyle]
PlusStyle -> PlusStyle
PlusStyle -> PlusStyle -> [PlusStyle]
PlusStyle -> PlusStyle -> PlusStyle -> [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
enumFromThenTo :: PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle]
$cenumFromThenTo :: PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle]
enumFromTo :: PlusStyle -> PlusStyle -> [PlusStyle]
$cenumFromTo :: PlusStyle -> PlusStyle -> [PlusStyle]
enumFromThen :: PlusStyle -> PlusStyle -> [PlusStyle]
$cenumFromThen :: PlusStyle -> PlusStyle -> [PlusStyle]
enumFrom :: PlusStyle -> [PlusStyle]
$cenumFrom :: PlusStyle -> [PlusStyle]
fromEnum :: PlusStyle -> Int
$cfromEnum :: PlusStyle -> Int
toEnum :: Int -> PlusStyle
$ctoEnum :: Int -> PlusStyle
pred :: PlusStyle -> PlusStyle
$cpred :: PlusStyle -> PlusStyle
succ :: PlusStyle -> PlusStyle
$csucc :: PlusStyle -> PlusStyle
Enum, PlusStyle -> PlusStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlusStyle -> PlusStyle -> Bool
$c/= :: PlusStyle -> PlusStyle -> Bool
== :: PlusStyle -> PlusStyle -> Bool
$c== :: PlusStyle -> PlusStyle -> Bool
Eq, 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
$cto :: forall x. Rep PlusStyle x -> PlusStyle
$cfrom :: forall x. PlusStyle -> Rep PlusStyle x
Generic, Eq 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
min :: PlusStyle -> PlusStyle -> PlusStyle
$cmin :: PlusStyle -> PlusStyle -> PlusStyle
max :: PlusStyle -> PlusStyle -> PlusStyle
$cmax :: PlusStyle -> PlusStyle -> PlusStyle
>= :: PlusStyle -> PlusStyle -> Bool
$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
compare :: PlusStyle -> PlusStyle -> Ordering
$ccompare :: PlusStyle -> PlusStyle -> Ordering
Ord, ReadPrec [PlusStyle]
ReadPrec PlusStyle
Int -> ReadS PlusStyle
ReadS [PlusStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PlusStyle]
$creadListPrec :: ReadPrec [PlusStyle]
readPrec :: ReadPrec PlusStyle
$creadPrec :: ReadPrec PlusStyle
readList :: ReadS [PlusStyle]
$creadList :: ReadS [PlusStyle]
readsPrec :: Int -> ReadS PlusStyle
$creadsPrec :: Int -> ReadS PlusStyle
Read, Int -> PlusStyle -> ShowS
[PlusStyle] -> ShowS
PlusStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlusStyle] -> ShowS
$cshowList :: [PlusStyle] -> ShowS
show :: PlusStyle -> String
$cshow :: PlusStyle -> String
showsPrec :: Int -> PlusStyle -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
maxBound :: Orientation
$cmaxBound :: Orientation
minBound :: Orientation
$cminBound :: Orientation
Bounded, Typeable Orientation
Orientation -> DataType
Orientation -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Orientation -> m Orientation
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Orientation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Orientation -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Orientation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Orientation -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Orientation -> r
gmapT :: (forall b. Data b => b -> b) -> Orientation -> Orientation
$cgmapT :: (forall b. Data b => b -> b) -> Orientation -> Orientation
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Orientation)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Orientation)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Orientation)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Orientation)
dataTypeOf :: Orientation -> DataType
$cdataTypeOf :: Orientation -> DataType
toConstr :: Orientation -> Constr
$ctoConstr :: Orientation -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Orientation
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Orientation
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Orientation -> c Orientation
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Orientation -> c Orientation
Data, Int -> Orientation
Orientation -> Int
Orientation -> [Orientation]
Orientation -> Orientation
Orientation -> Orientation -> [Orientation]
Orientation -> Orientation -> Orientation -> [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
enumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
$cenumFromThenTo :: Orientation -> Orientation -> Orientation -> [Orientation]
enumFromTo :: Orientation -> Orientation -> [Orientation]
$cenumFromTo :: Orientation -> Orientation -> [Orientation]
enumFromThen :: Orientation -> Orientation -> [Orientation]
$cenumFromThen :: Orientation -> Orientation -> [Orientation]
enumFrom :: Orientation -> [Orientation]
$cenumFrom :: Orientation -> [Orientation]
fromEnum :: Orientation -> Int
$cfromEnum :: Orientation -> Int
toEnum :: Int -> Orientation
$ctoEnum :: Int -> Orientation
pred :: Orientation -> Orientation
$cpred :: Orientation -> Orientation
succ :: Orientation -> Orientation
$csucc :: Orientation -> Orientation
Enum, Orientation -> Orientation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Orientation -> Orientation -> Bool
$c/= :: Orientation -> Orientation -> Bool
== :: Orientation -> Orientation -> Bool
$c== :: Orientation -> Orientation -> Bool
Eq, 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
$cto :: forall x. Rep Orientation x -> Orientation
$cfrom :: forall x. Orientation -> Rep Orientation x
Generic, Eq 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
min :: Orientation -> Orientation -> Orientation
$cmin :: Orientation -> Orientation -> Orientation
max :: Orientation -> Orientation -> Orientation
$cmax :: Orientation -> Orientation -> Orientation
>= :: Orientation -> Orientation -> Bool
$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
compare :: Orientation -> Orientation -> Ordering
$ccompare :: Orientation -> Orientation -> Ordering
Ord, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Orientation]
$creadListPrec :: ReadPrec [Orientation]
readPrec :: ReadPrec Orientation
$creadPrec :: ReadPrec Orientation
readList :: ReadS [Orientation]
$creadList :: ReadS [Orientation]
readsPrec :: Int -> ReadS Orientation
$creadsPrec :: Int -> ReadS Orientation
Read, Int -> Orientation -> ShowS
[Orientation] -> ShowS
Orientation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Orientation] -> ShowS
$cshowList :: [Orientation] -> ShowS
show :: Orientation -> String
$cshow :: Orientation -> String
showsPrec :: Int -> Orientation -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
forall a. Bounded a => Oriented a
maxBound :: Oriented a
$cmaxBound :: forall a. Bounded a => Oriented a
minBound :: Oriented a
$cminBound :: forall a. Bounded a => Oriented a
Bounded, Oriented a -> DataType
Oriented a -> Constr
forall {a}. Data a => Typeable (Oriented a)
forall a. Data a => Oriented a -> DataType
forall a. Data a => Oriented a -> Constr
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 (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))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
gmapQi :: forall u. Int -> (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
gmapQ :: forall u. (forall d. Data d => d -> u) -> Oriented a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Oriented a -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
gmapT :: (forall b. Data b => b -> b) -> Oriented a -> Oriented a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Oriented a -> Oriented a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> 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))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
dataTypeOf :: Oriented a -> DataType
$cdataTypeOf :: forall a. Data a => Oriented a -> DataType
toConstr :: Oriented a -> Constr
$ctoConstr :: forall a. Data a => Oriented a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> 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)
Data, Oriented a -> Oriented a -> Bool
forall a. Eq a => Oriented a -> Oriented a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Oriented a -> Oriented a -> Bool
$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
Eq, 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
product :: forall a. Num a => Oriented a -> a
$cproduct :: forall a. Num a => Oriented a -> a
sum :: forall a. Num a => Oriented a -> a
$csum :: forall a. Num a => Oriented a -> a
minimum :: forall a. Ord a => Oriented a -> a
$cminimum :: forall a. Ord a => Oriented a -> a
maximum :: forall a. Ord a => Oriented a -> a
$cmaximum :: forall a. Ord a => Oriented a -> a
elem :: forall a. Eq a => a -> Oriented a -> Bool
$celem :: forall a. Eq a => a -> Oriented a -> Bool
length :: forall a. Oriented a -> Int
$clength :: forall a. Oriented a -> Int
null :: forall a. Oriented a -> Bool
$cnull :: forall a. Oriented a -> Bool
toList :: forall a. Oriented a -> [a]
$ctoList :: forall a. Oriented a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Oriented a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Oriented a -> a
foldr1 :: forall a. (a -> a -> a) -> Oriented a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Oriented a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
fold :: forall m. Monoid m => Oriented m -> m
$cfold :: forall m. Monoid m => Oriented m -> m
Foldable, 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
<$ :: forall a b. a -> Oriented b -> Oriented a
$c<$ :: forall a b. a -> Oriented b -> Oriented a
fmap :: forall a b. (a -> b) -> Oriented a -> Oriented b
$cfmap :: forall a b. (a -> b) -> Oriented a -> Oriented b
Functor, 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
$cto :: forall a x. Rep (Oriented a) x -> Oriented a
$cfrom :: forall a x. Oriented a -> Rep (Oriented a) x
Generic, 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
$cto1 :: forall a. Rep1 Oriented a -> Oriented a
$cfrom1 :: forall a. Oriented a -> Rep1 Oriented a
Generic1, Oriented a -> Oriented a -> Bool
Oriented a -> Oriented a -> Ordering
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
min :: Oriented a -> Oriented a -> Oriented a
$cmin :: forall a. Ord a => Oriented a -> Oriented a -> Oriented a
max :: Oriented a -> Oriented a -> Oriented a
$cmax :: forall a. Ord a => Oriented a -> Oriented a -> Oriented a
>= :: 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
$c< :: forall a. Ord a => Oriented a -> Oriented a -> Bool
compare :: Oriented a -> Oriented a -> Ordering
$ccompare :: forall a. Ord a => Oriented a -> Oriented a -> Ordering
Ord, ReadPrec [Oriented a]
ReadPrec (Oriented a)
ReadS [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
readListPrec :: ReadPrec [Oriented a]
$creadListPrec :: forall a. Read a => ReadPrec [Oriented a]
readPrec :: ReadPrec (Oriented a)
$creadPrec :: forall a. Read a => ReadPrec (Oriented a)
readList :: ReadS [Oriented a]
$creadList :: forall a. Read a => ReadS [Oriented a]
readsPrec :: Int -> ReadS (Oriented a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Oriented a)
Read, Int -> Oriented a -> ShowS
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
showList :: [Oriented a] -> ShowS
$cshowList :: forall a. Show a => [Oriented a] -> ShowS
show :: Oriented a -> String
$cshow :: forall a. Show a => Oriented a -> String
showsPrec :: Int -> Oriented a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Oriented a -> ShowS
Show, Functor Oriented
Foldable 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)
sequence :: forall (m :: * -> *) a. Monad m => Oriented (m a) -> m (Oriented a)
$csequence :: forall (m :: * -> *) a. Monad m => Oriented (m a) -> m (Oriented a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oriented a -> m (Oriented b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oriented a -> m (Oriented b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Oriented (f a) -> f (Oriented a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Oriented (f a) -> f (Oriented a)
traverse :: 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)
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 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 forall a. Semigroup a => a -> a -> a
<> 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
forall a. a -> a -> Bounded a
maxBound :: Rotate90
$cmaxBound :: Rotate90
minBound :: Rotate90
$cminBound :: Rotate90
Bounded, Typeable Rotate90
Rotate90 -> DataType
Rotate90 -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotate90 -> r
gmapT :: (forall b. Data b => b -> b) -> Rotate90 -> Rotate90
$cgmapT :: (forall b. Data b => b -> b) -> Rotate90 -> Rotate90
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rotate90)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Rotate90)
dataTypeOf :: Rotate90 -> DataType
$cdataTypeOf :: Rotate90 -> DataType
toConstr :: Rotate90 -> Constr
$ctoConstr :: Rotate90 -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rotate90
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Rotate90
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotate90 -> c Rotate90
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotate90 -> c Rotate90
Data, Int -> Rotate90
Rotate90 -> Int
Rotate90 -> [Rotate90]
Rotate90 -> Rotate90
Rotate90 -> Rotate90 -> [Rotate90]
Rotate90 -> Rotate90 -> Rotate90 -> [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
enumFromThenTo :: Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90]
$cenumFromThenTo :: Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90]
enumFromTo :: Rotate90 -> Rotate90 -> [Rotate90]
$cenumFromTo :: Rotate90 -> Rotate90 -> [Rotate90]
enumFromThen :: Rotate90 -> Rotate90 -> [Rotate90]
$cenumFromThen :: Rotate90 -> Rotate90 -> [Rotate90]
enumFrom :: Rotate90 -> [Rotate90]
$cenumFrom :: Rotate90 -> [Rotate90]
fromEnum :: Rotate90 -> Int
$cfromEnum :: Rotate90 -> Int
toEnum :: Int -> Rotate90
$ctoEnum :: Int -> Rotate90
pred :: Rotate90 -> Rotate90
$cpred :: Rotate90 -> Rotate90
succ :: Rotate90 -> Rotate90
$csucc :: Rotate90 -> Rotate90
Enum, Rotate90 -> Rotate90 -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rotate90 -> Rotate90 -> Bool
$c/= :: Rotate90 -> Rotate90 -> Bool
== :: Rotate90 -> Rotate90 -> Bool
$c== :: Rotate90 -> Rotate90 -> Bool
Eq, 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
$cto :: forall x. Rep Rotate90 x -> Rotate90
$cfrom :: forall x. Rotate90 -> Rep Rotate90 x
Generic, Eq 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
min :: Rotate90 -> Rotate90 -> Rotate90
$cmin :: Rotate90 -> Rotate90 -> Rotate90
max :: Rotate90 -> Rotate90 -> Rotate90
$cmax :: Rotate90 -> Rotate90 -> Rotate90
>= :: Rotate90 -> Rotate90 -> Bool
$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
compare :: Rotate90 -> Rotate90 -> Ordering
$ccompare :: Rotate90 -> Rotate90 -> Ordering
Ord, ReadPrec [Rotate90]
ReadPrec Rotate90
Int -> ReadS Rotate90
ReadS [Rotate90]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rotate90]
$creadListPrec :: ReadPrec [Rotate90]
readPrec :: ReadPrec Rotate90
$creadPrec :: ReadPrec Rotate90
readList :: ReadS [Rotate90]
$creadList :: ReadS [Rotate90]
readsPrec :: Int -> ReadS Rotate90
$creadsPrec :: Int -> ReadS Rotate90
Read, Int -> Rotate90 -> ShowS
[Rotate90] -> ShowS
Rotate90 -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rotate90] -> ShowS
$cshowList :: [Rotate90] -> ShowS
show :: Rotate90 -> String
$cshow :: Rotate90 -> String
showsPrec :: Int -> Rotate90 -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
forall a. Bounded a => Rotated a
maxBound :: Rotated a
$cmaxBound :: forall a. Bounded a => Rotated a
minBound :: Rotated a
$cminBound :: forall a. Bounded a => Rotated a
Bounded, Rotated a -> DataType
Rotated a -> Constr
forall {a}. Data a => Typeable (Rotated a)
forall a. Data a => Rotated a -> DataType
forall a. Data a => Rotated a -> Constr
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 (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))
gmapMo :: 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)
gmapMp :: forall (m :: * -> *).
MonadPlus 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)
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
$cgmapM :: forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
gmapQi :: forall u. Int -> (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
gmapQ :: forall u. (forall d. Data d => d -> u) -> Rotated a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Rotated a -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
$cgmapQl :: forall a r r'.
Data a =>
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
gmapT :: (forall b. Data b => b -> b) -> Rotated a -> Rotated a
$cgmapT :: forall a.
Data a =>
(forall b. Data b => b -> b) -> Rotated a -> Rotated a
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> 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))
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
$cdataCast1 :: forall a (t :: * -> *) (c :: * -> *).
(Data a, Typeable t) =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
dataTypeOf :: Rotated a -> DataType
$cdataTypeOf :: forall a. Data a => Rotated a -> DataType
toConstr :: Rotated a -> Constr
$ctoConstr :: forall a. Data a => Rotated a -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> 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)
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> 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)
Data, Rotated a -> Rotated a -> Bool
forall a. Eq a => Rotated a -> Rotated a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rotated a -> Rotated a -> Bool
$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
Eq, 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
product :: forall a. Num a => Rotated a -> a
$cproduct :: forall a. Num a => Rotated a -> a
sum :: forall a. Num a => Rotated a -> a
$csum :: forall a. Num a => Rotated a -> a
minimum :: forall a. Ord a => Rotated a -> a
$cminimum :: forall a. Ord a => Rotated a -> a
maximum :: forall a. Ord a => Rotated a -> a
$cmaximum :: forall a. Ord a => Rotated a -> a
elem :: forall a. Eq a => a -> Rotated a -> Bool
$celem :: forall a. Eq a => a -> Rotated a -> Bool
length :: forall a. Rotated a -> Int
$clength :: forall a. Rotated a -> Int
null :: forall a. Rotated a -> Bool
$cnull :: forall a. Rotated a -> Bool
toList :: forall a. Rotated a -> [a]
$ctoList :: forall a. Rotated a -> [a]
foldl1 :: forall a. (a -> a -> a) -> Rotated a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rotated a -> a
foldr1 :: forall a. (a -> a -> a) -> Rotated a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Rotated a -> a
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
$cfoldl :: forall b a. (b -> a -> 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
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
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
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
fold :: forall m. Monoid m => Rotated m -> m
$cfold :: forall m. Monoid m => Rotated m -> m
Foldable, 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
<$ :: forall a b. a -> Rotated b -> Rotated a
$c<$ :: forall a b. a -> Rotated b -> Rotated a
fmap :: forall a b. (a -> b) -> Rotated a -> Rotated b
$cfmap :: forall a b. (a -> b) -> Rotated a -> Rotated b
Functor, 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
$cto :: forall a x. Rep (Rotated a) x -> Rotated a
$cfrom :: forall a x. Rotated a -> Rep (Rotated a) x
Generic, 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
$cto1 :: forall a. Rep1 Rotated a -> Rotated a
$cfrom1 :: forall a. Rotated a -> Rep1 Rotated a
Generic1, Rotated a -> Rotated a -> Bool
Rotated a -> Rotated a -> Ordering
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
min :: Rotated a -> Rotated a -> Rotated a
$cmin :: forall a. Ord a => Rotated a -> Rotated a -> Rotated a
max :: Rotated a -> Rotated a -> Rotated a
$cmax :: forall a. Ord a => Rotated a -> Rotated a -> Rotated a
>= :: 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
$c< :: forall a. Ord a => Rotated a -> Rotated a -> Bool
compare :: Rotated a -> Rotated a -> Ordering
$ccompare :: forall a. Ord a => Rotated a -> Rotated a -> Ordering
Ord, ReadPrec [Rotated a]
ReadPrec (Rotated a)
ReadS [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
readListPrec :: ReadPrec [Rotated a]
$creadListPrec :: forall a. Read a => ReadPrec [Rotated a]
readPrec :: ReadPrec (Rotated a)
$creadPrec :: forall a. Read a => ReadPrec (Rotated a)
readList :: ReadS [Rotated a]
$creadList :: forall a. Read a => ReadS [Rotated a]
readsPrec :: Int -> ReadS (Rotated a)
$creadsPrec :: forall a. Read a => Int -> ReadS (Rotated a)
Read, Int -> Rotated a -> ShowS
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
showList :: [Rotated a] -> ShowS
$cshowList :: forall a. Show a => [Rotated a] -> ShowS
show :: Rotated a -> String
$cshow :: forall a. Show a => Rotated a -> String
showsPrec :: Int -> Rotated a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> Rotated a -> ShowS
Show, Functor Rotated
Foldable 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)
sequence :: forall (m :: * -> *) a. Monad m => Rotated (m a) -> m (Rotated a)
$csequence :: forall (m :: * -> *) a. Monad m => Rotated (m a) -> m (Rotated a)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rotated a -> m (Rotated b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rotated a -> m (Rotated b)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Rotated (f a) -> f (Rotated a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Rotated (f a) -> f (Rotated a)
traverse :: 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)
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 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 forall a. Semigroup a => a -> a -> a
<> 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
forall a. a -> a -> Bounded a
maxBound :: Emphasis
$cmaxBound :: Emphasis
minBound :: Emphasis
$cminBound :: Emphasis
Bounded, Typeable Emphasis
Emphasis -> DataType
Emphasis -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Emphasis -> m Emphasis
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Emphasis -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Emphasis -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Emphasis -> r
gmapT :: (forall b. Data b => b -> b) -> Emphasis -> Emphasis
$cgmapT :: (forall b. Data b => b -> b) -> Emphasis -> Emphasis
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Emphasis)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Emphasis)
dataTypeOf :: Emphasis -> DataType
$cdataTypeOf :: Emphasis -> DataType
toConstr :: Emphasis -> Constr
$ctoConstr :: Emphasis -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Emphasis
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Emphasis
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Emphasis -> c Emphasis
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Emphasis -> c Emphasis
Data, Int -> Emphasis
Emphasis -> Int
Emphasis -> [Emphasis]
Emphasis -> Emphasis
Emphasis -> Emphasis -> [Emphasis]
Emphasis -> Emphasis -> Emphasis -> [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
enumFromThenTo :: Emphasis -> Emphasis -> Emphasis -> [Emphasis]
$cenumFromThenTo :: Emphasis -> Emphasis -> Emphasis -> [Emphasis]
enumFromTo :: Emphasis -> Emphasis -> [Emphasis]
$cenumFromTo :: Emphasis -> Emphasis -> [Emphasis]
enumFromThen :: Emphasis -> Emphasis -> [Emphasis]
$cenumFromThen :: Emphasis -> Emphasis -> [Emphasis]
enumFrom :: Emphasis -> [Emphasis]
$cenumFrom :: Emphasis -> [Emphasis]
fromEnum :: Emphasis -> Int
$cfromEnum :: Emphasis -> Int
toEnum :: Int -> Emphasis
$ctoEnum :: Int -> Emphasis
pred :: Emphasis -> Emphasis
$cpred :: Emphasis -> Emphasis
succ :: Emphasis -> Emphasis
$csucc :: Emphasis -> Emphasis
Enum, Emphasis -> Emphasis -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Emphasis -> Emphasis -> Bool
$c/= :: Emphasis -> Emphasis -> Bool
== :: Emphasis -> Emphasis -> Bool
$c== :: Emphasis -> Emphasis -> Bool
Eq, 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
$cto :: forall x. Rep Emphasis x -> Emphasis
$cfrom :: forall x. Emphasis -> Rep Emphasis x
Generic, Eq 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
min :: Emphasis -> Emphasis -> Emphasis
$cmin :: Emphasis -> Emphasis -> Emphasis
max :: Emphasis -> Emphasis -> Emphasis
$cmax :: Emphasis -> Emphasis -> Emphasis
>= :: Emphasis -> Emphasis -> Bool
$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
compare :: Emphasis -> Emphasis -> Ordering
$ccompare :: Emphasis -> Emphasis -> Ordering
Ord, ReadPrec [Emphasis]
ReadPrec Emphasis
Int -> ReadS Emphasis
ReadS [Emphasis]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Emphasis]
$creadListPrec :: ReadPrec [Emphasis]
readPrec :: ReadPrec Emphasis
$creadPrec :: ReadPrec Emphasis
readList :: ReadS [Emphasis]
$creadList :: ReadS [Emphasis]
readsPrec :: Int -> ReadS Emphasis
$creadsPrec :: Int -> ReadS Emphasis
Read, Int -> Emphasis -> ShowS
[Emphasis] -> ShowS
Emphasis -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Emphasis] -> ShowS
$cshowList :: [Emphasis] -> ShowS
show :: Emphasis -> String
$cshow :: Emphasis -> String
showsPrec :: Int -> Emphasis -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
maxBound :: ItalicType
$cmaxBound :: ItalicType
minBound :: ItalicType
$cminBound :: ItalicType
Bounded, Typeable ItalicType
ItalicType -> DataType
ItalicType -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ItalicType -> m ItalicType
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ItalicType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ItalicType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ItalicType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ItalicType -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ItalicType -> r
gmapT :: (forall b. Data b => b -> b) -> ItalicType -> ItalicType
$cgmapT :: (forall b. Data b => b -> b) -> ItalicType -> ItalicType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ItalicType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c ItalicType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ItalicType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ItalicType)
dataTypeOf :: ItalicType -> DataType
$cdataTypeOf :: ItalicType -> DataType
toConstr :: ItalicType -> Constr
$ctoConstr :: ItalicType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ItalicType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ItalicType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ItalicType -> c ItalicType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ItalicType -> c ItalicType
Data, Int -> ItalicType
ItalicType -> Int
ItalicType -> [ItalicType]
ItalicType -> ItalicType
ItalicType -> ItalicType -> [ItalicType]
ItalicType -> ItalicType -> ItalicType -> [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
enumFromThenTo :: ItalicType -> ItalicType -> ItalicType -> [ItalicType]
$cenumFromThenTo :: ItalicType -> ItalicType -> ItalicType -> [ItalicType]
enumFromTo :: ItalicType -> ItalicType -> [ItalicType]
$cenumFromTo :: ItalicType -> ItalicType -> [ItalicType]
enumFromThen :: ItalicType -> ItalicType -> [ItalicType]
$cenumFromThen :: ItalicType -> ItalicType -> [ItalicType]
enumFrom :: ItalicType -> [ItalicType]
$cenumFrom :: ItalicType -> [ItalicType]
fromEnum :: ItalicType -> Int
$cfromEnum :: ItalicType -> Int
toEnum :: Int -> ItalicType
$ctoEnum :: Int -> ItalicType
pred :: ItalicType -> ItalicType
$cpred :: ItalicType -> ItalicType
succ :: ItalicType -> ItalicType
$csucc :: ItalicType -> ItalicType
Enum, ItalicType -> ItalicType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItalicType -> ItalicType -> Bool
$c/= :: ItalicType -> ItalicType -> Bool
== :: ItalicType -> ItalicType -> Bool
$c== :: ItalicType -> ItalicType -> Bool
Eq, 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
$cto :: forall x. Rep ItalicType x -> ItalicType
$cfrom :: forall x. ItalicType -> Rep ItalicType x
Generic, Eq 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
min :: ItalicType -> ItalicType -> ItalicType
$cmin :: ItalicType -> ItalicType -> ItalicType
max :: ItalicType -> ItalicType -> ItalicType
$cmax :: ItalicType -> ItalicType -> ItalicType
>= :: ItalicType -> ItalicType -> Bool
$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
compare :: ItalicType -> ItalicType -> Ordering
$ccompare :: ItalicType -> ItalicType -> Ordering
Ord, ReadPrec [ItalicType]
ReadPrec ItalicType
Int -> ReadS ItalicType
ReadS [ItalicType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ItalicType]
$creadListPrec :: ReadPrec [ItalicType]
readPrec :: ReadPrec ItalicType
$creadPrec :: ReadPrec ItalicType
readList :: ReadS [ItalicType]
$creadList :: ReadS [ItalicType]
readsPrec :: Int -> ReadS ItalicType
$creadsPrec :: Int -> ReadS ItalicType
Read, Int -> ItalicType -> ShowS
[ItalicType] -> ShowS
ItalicType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItalicType] -> ShowS
$cshowList :: [ItalicType] -> ShowS
show :: ItalicType -> String
$cshow :: ItalicType -> String
showsPrec :: Int -> ItalicType -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
maxBound :: FontStyle
$cmaxBound :: FontStyle
minBound :: FontStyle
$cminBound :: FontStyle
Bounded, Typeable FontStyle
FontStyle -> DataType
FontStyle -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> FontStyle -> m FontStyle
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStyle -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> FontStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FontStyle -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> FontStyle -> r
gmapT :: (forall b. Data b => b -> b) -> FontStyle -> FontStyle
$cgmapT :: (forall b. Data b => b -> b) -> FontStyle -> FontStyle
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStyle)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c FontStyle)
dataTypeOf :: FontStyle -> DataType
$cdataTypeOf :: FontStyle -> DataType
toConstr :: FontStyle -> Constr
$ctoConstr :: FontStyle -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStyle
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c FontStyle
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStyle -> c FontStyle
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStyle -> c FontStyle
Data, Int -> FontStyle
FontStyle -> Int
FontStyle -> [FontStyle]
FontStyle -> FontStyle
FontStyle -> FontStyle -> [FontStyle]
FontStyle -> FontStyle -> FontStyle -> [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
enumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
$cenumFromThenTo :: FontStyle -> FontStyle -> FontStyle -> [FontStyle]
enumFromTo :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromTo :: FontStyle -> FontStyle -> [FontStyle]
enumFromThen :: FontStyle -> FontStyle -> [FontStyle]
$cenumFromThen :: FontStyle -> FontStyle -> [FontStyle]
enumFrom :: FontStyle -> [FontStyle]
$cenumFrom :: FontStyle -> [FontStyle]
fromEnum :: FontStyle -> Int
$cfromEnum :: FontStyle -> Int
toEnum :: Int -> FontStyle
$ctoEnum :: Int -> FontStyle
pred :: FontStyle -> FontStyle
$cpred :: FontStyle -> FontStyle
succ :: FontStyle -> FontStyle
$csucc :: FontStyle -> FontStyle
Enum, FontStyle -> FontStyle -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FontStyle -> FontStyle -> Bool
$c/= :: FontStyle -> FontStyle -> Bool
== :: FontStyle -> FontStyle -> Bool
$c== :: FontStyle -> FontStyle -> Bool
Eq, 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
$cto :: forall x. Rep FontStyle x -> FontStyle
$cfrom :: forall x. FontStyle -> Rep FontStyle x
Generic, Eq 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
min :: FontStyle -> FontStyle -> FontStyle
$cmin :: FontStyle -> FontStyle -> FontStyle
max :: FontStyle -> FontStyle -> FontStyle
$cmax :: FontStyle -> FontStyle -> FontStyle
>= :: FontStyle -> FontStyle -> Bool
$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
compare :: FontStyle -> FontStyle -> Ordering
$ccompare :: FontStyle -> FontStyle -> Ordering
Ord, ReadPrec [FontStyle]
ReadPrec FontStyle
Int -> ReadS FontStyle
ReadS [FontStyle]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FontStyle]
$creadListPrec :: ReadPrec [FontStyle]
readPrec :: ReadPrec FontStyle
$creadPrec :: ReadPrec FontStyle
readList :: ReadS [FontStyle]
$creadList :: ReadS [FontStyle]
readsPrec :: Int -> ReadS FontStyle
$creadsPrec :: Int -> ReadS FontStyle
Read, Int -> FontStyle -> ShowS
[FontStyle] -> ShowS
FontStyle -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FontStyle] -> ShowS
$cshowList :: [FontStyle] -> ShowS
show :: FontStyle -> String
$cshow :: FontStyle -> String
showsPrec :: Int -> FontStyle -> ShowS
$cshowsPrec :: Int -> 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
forall a. a -> a -> Bounded a
maxBound :: Ligate
$cmaxBound :: Ligate
minBound :: Ligate
$cminBound :: Ligate
Bounded, Typeable Ligate
Ligate -> DataType
Ligate -> Constr
(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)
gmapMo :: 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
gmapMp :: forall (m :: * -> *).
MonadPlus 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
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Ligate -> m Ligate
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Ligate -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ligate -> [u]
gmapQr :: 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
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Ligate -> r
gmapT :: (forall b. Data b => b -> b) -> Ligate -> Ligate
$cgmapT :: (forall b. Data b => b -> b) -> Ligate -> Ligate
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ligate)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Ligate)
dataTypeOf :: Ligate -> DataType
$cdataTypeOf :: Ligate -> DataType
toConstr :: Ligate -> Constr
$ctoConstr :: Ligate -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ligate
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Ligate
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ligate -> c Ligate
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ligate -> c Ligate
Data, Int -> Ligate
Ligate -> Int
Ligate -> [Ligate]
Ligate -> Ligate
Ligate -> Ligate -> [Ligate]
Ligate -> Ligate -> Ligate -> [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
enumFromThenTo :: Ligate -> Ligate -> Ligate -> [Ligate]
$cenumFromThenTo :: Ligate -> Ligate -> Ligate -> [Ligate]
enumFromTo :: Ligate -> Ligate -> [Ligate]
$cenumFromTo :: Ligate -> Ligate -> [Ligate]
enumFromThen :: Ligate -> Ligate -> [Ligate]
$cenumFromThen :: Ligate -> Ligate -> [Ligate]
enumFrom :: Ligate -> [Ligate]
$cenumFrom :: Ligate -> [Ligate]
fromEnum :: Ligate -> Int
$cfromEnum :: Ligate -> Int
toEnum :: Int -> Ligate
$ctoEnum :: Int -> Ligate
pred :: Ligate -> Ligate
$cpred :: Ligate -> Ligate
succ :: Ligate -> Ligate
$csucc :: Ligate -> Ligate
Enum, Ligate -> Ligate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Ligate -> Ligate -> Bool
$c/= :: Ligate -> Ligate -> Bool
== :: Ligate -> Ligate -> Bool
$c== :: Ligate -> Ligate -> Bool
Eq, 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
$cto :: forall x. Rep Ligate x -> Ligate
$cfrom :: forall x. Ligate -> Rep Ligate x
Generic, Eq 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
min :: Ligate -> Ligate -> Ligate
$cmin :: Ligate -> Ligate -> Ligate
max :: Ligate -> Ligate -> Ligate
$cmax :: Ligate -> Ligate -> Ligate
>= :: Ligate -> Ligate -> Bool
$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
compare :: Ligate -> Ligate -> Ordering
$ccompare :: Ligate -> Ligate -> Ordering
Ord, ReadPrec [Ligate]
ReadPrec Ligate
Int -> ReadS Ligate
ReadS [Ligate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Ligate]
$creadListPrec :: ReadPrec [Ligate]
readPrec :: ReadPrec Ligate
$creadPrec :: ReadPrec Ligate
readList :: ReadS [Ligate]
$creadList :: ReadS [Ligate]
readsPrec :: Int -> ReadS Ligate
$creadsPrec :: Int -> ReadS Ligate
Read, Int -> Ligate -> ShowS
[Ligate] -> ShowS
Ligate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Ligate] -> ShowS
$cshowList :: [Ligate] -> ShowS
show :: Ligate -> String
$cshow :: Ligate -> String
showsPrec :: Int -> Ligate -> ShowS
$cshowsPrec :: Int -> 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 = 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 = forall a. (a -> a) -> Ligate -> a -> a
ligate forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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
'Α' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c forall a. Ord a => a -> a -> Bool
<= Char
'Ω' Bool -> Bool -> Bool
&& Char
c 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
'α' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 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 = 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 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 forall a. Num a => a -> a -> a
+ Int
1) i
q forall a. Semigroup a => a -> a -> a
<> i -> Int -> Text
fi' i
r Int
i
      where
        (i
q, i
r) = forall a. Integral a => a -> a -> (a, a)
quotRem i
n i
radix
    fi' :: i -> Int -> Text
fi' = forall a b c. (a -> b -> c) -> b -> a -> c
flip Int -> Int -> Text
fi forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall i.
Integral i =>
(i -> Text) -> Char -> Char -> PlusStyle -> i -> Text
withSign i -> Text
f
  where
    f :: i -> Text
f i
n
      | i
n 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) = forall a. Integral a => a -> a -> (a, a)
quotRem i
n i
radix
    fi' :: i -> Char
fi' = Int -> Char
fi forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = 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 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' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 forall a. Bits a => a -> a -> a
.&. Int
0xfffe forall a. Eq a => a -> a -> Bool
/= Int
0xfffe Bool -> Bool -> Bool
&& (Char
'\xfdd0' forall a. Ord a => a -> a -> Bool
> Char
c Bool -> Bool -> Bool
|| Char
c 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 forall a. Bits a => a -> a -> a
.&. Int
0xfffe forall a. Eq a => a -> a -> Bool
== Int
0xfffe Bool -> Bool -> Bool
|| Char
'\xfdd0' forall a. Ord a => a -> a -> Bool
<= Char
c Bool -> Bool -> Bool
&& Char
c 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 = forall a. Enum a => Int -> a
toEnum forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract Int
o 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 = forall {a}. Enum a => Char -> Maybe a
go
  where
    go :: Char -> Maybe a
go Char
c
      | Int
e0 forall a. Ord a => a -> a -> Bool
<= Int
ei Bool -> Bool -> Bool
&& Int
ei forall a. Ord a => a -> a -> Bool
<= Int
en = forall a. a -> Maybe a
Just (forall a. Enum a => Int -> a
toEnum Int
ei)
      | Bool
otherwise = forall a. Maybe a
Nothing
      where
        ei :: Int
ei = Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Int
o
    e0 :: Int
e0 = forall a. Enum a => a -> Int
fromEnum (forall a. Bounded a => a
minBound :: a)
    en :: Int
en = forall a. Enum a => a -> Int
fromEnum (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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
o forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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' = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Maybe a -> Bool
isJust 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. UnicodeCharacter a => Char -> Maybe a
fromUnicodeChar Char
c
    | Bool
otherwise = 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' = forall a. HasCallStack => Maybe a -> a
fromJust forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 = forall a. Maybe a -> Bool
isJust 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 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 forall a. Ord a => a -> a -> Bool
>= Int
o Bool -> Bool -> Bool
&& Int
n forall a. Ord a => a -> a -> Bool
<= Int
m = forall a. a -> Maybe a
Just (Int -> Char
chr (Int
d' forall a. Num a => a -> a -> a
+ Int
n))
      | Bool
otherwise = forall a. Maybe a
Nothing
    !d' :: Int
d' = Int
d 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' forall a. Num a => a -> a -> a
+)
  where
    !d' :: Int
d' = Int
d 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d 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 = forall a. a -> Maybe a
Just (Int -> Char
chr (Int
d' forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c))
      | Bool
otherwise = forall a. Maybe a
Nothing
    !d' :: Int
d' = Int
d 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  where
    !d' :: Int
d' = Int
d 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 = forall a. a -> Maybe a
Just (Int -> Char
chr (Int
d' forall a. Num a => a -> a -> a
+ Char -> Int
ord Char
c))
      | Bool
otherwise = forall a. Maybe a
Nothing
    !d' :: Int
d' = Int
d 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 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' forall a. Num a => a -> a -> a
+) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
  where
    !d' :: Int
d' = Int
d 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 = forall a. a -> Maybe a
Just (Int -> Char
chr (Int
dl' forall a. Num a => a -> a -> a
+ Int
c'))
      | Char -> Bool
isAsciiUpper Char
c = forall a. a -> Maybe a
Just (Int -> Char
chr (Int
du' forall a. Num a => a -> a -> a
+ Int
c'))
      | Bool
otherwise = forall a. Maybe a
Nothing
      where
        c' :: Int
c' = Char -> Int
ord Char
c
    !du' :: Int
du' = Int
du forall a. Num a => a -> a -> a
- Int
65
    !dl' :: Int
dl' = Int
dl 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' forall a. Num a => a -> a -> a
+ Int
c')
      | Bool
otherwise = Int -> Char
chr (Int
dl' forall a. Num a => a -> a -> a
+ Int
c')
      where
        c' :: Int
c' = Char -> Int
ord Char
c
    du' :: Int
du' = Int
du forall a. Num a => a -> a -> a
- Int
65
    dl' :: Int
dl' = Int
dl forall a. Num a => a -> a -> a
- Int
97

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

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

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

instance Arbitrary a => Arbitrary (Rotated a) where
  arbitrary :: Gen (Rotated a)
arbitrary = 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 = forall a. a -> Orientation -> Oriented a
Oriented forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
arb forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary

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

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

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

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

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

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

instance Arbitrary FontStyle where
  arbitrary :: Gen FontStyle
arbitrary = 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 = forall a. a -> a
id
  fromUnicodeChar :: Char -> Maybe Char
fromUnicodeChar = forall a. a -> Maybe a
Just
  fromUnicodeChar' :: Char -> Char
fromUnicodeChar' = forall a. a -> a
id
  isInCharRange :: Char -> Bool
isInCharRange = 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 = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack
  fromUnicodeText' :: Text -> String
fromUnicodeText' = Text -> String
unpack
  isInTextRange :: Text -> Bool
isInTextRange = 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 = forall a. a -> a
id
  fromUnicodeText :: Text -> Maybe Text
fromUnicodeText = forall a. a -> Maybe a
Just
  fromUnicodeText' :: Text -> Text
fromUnicodeText' = forall a. a -> a
id
  isInTextRange :: Text -> Bool
isInTextRange = forall a b. a -> b -> a
const Bool
True