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

{-|
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'), UnicodeChar
  , UnicodeText(toUnicodeText, fromUnicodeText, fromUnicodeText')
    -- * 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, ord)
import Data.Data(Data)
import Data.Default(Default(def))
import Data.Functor.Classes(Eq1(liftEq), Ord1(liftCompare))
import Data.Hashable(Hashable)
import Data.Hashable.Lifted(Hashable1)
import Data.Maybe(fromJust)
#if __GLASGOW_HASKELL__ < 803
import Data.Semigroup((<>))
#endif
import Data.Text(Text, cons, pack, singleton, snoc, unpack)

import GHC.Generics(Generic, Generic1)

import Test.QuickCheck.Arbitrary(Arbitrary(arbitrary), Arbitrary1(liftArbitrary), arbitrary1, arbitraryBoundedEnum)

-- | 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
  = UpperCase  -- ^ The /upper case/ formatting.
  | LowerCase  -- ^ The /lower case/ formatting.
  deriving (LetterCase
LetterCase -> LetterCase -> Bounded LetterCase
forall a. a -> a -> Bounded a
maxBound :: LetterCase
$cmaxBound :: LetterCase
minBound :: LetterCase
$cminBound :: LetterCase
Bounded, Typeable LetterCase
DataType
Constr
Typeable LetterCase
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> LetterCase -> c LetterCase)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LetterCase)
-> (LetterCase -> Constr)
-> (LetterCase -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LetterCase))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LetterCase))
-> ((forall b. Data b => b -> b) -> LetterCase -> LetterCase)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LetterCase -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LetterCase -> r)
-> (forall u. (forall d. Data d => d -> u) -> LetterCase -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LetterCase -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> LetterCase -> m LetterCase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetterCase -> m LetterCase)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> LetterCase -> m LetterCase)
-> Data LetterCase
LetterCase -> DataType
LetterCase -> Constr
(forall b. Data b => b -> b) -> LetterCase -> LetterCase
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> LetterCase -> c LetterCase
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cLowerCase :: Constr
$cUpperCase :: Constr
$tLetterCase :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> LetterCase -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> LetterCase -> u
gmapQ :: (forall d. Data d => d -> u) -> LetterCase -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LetterCase -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable LetterCase
Data, Int -> LetterCase
LetterCase -> Int
LetterCase -> [LetterCase]
LetterCase -> LetterCase
LetterCase -> LetterCase -> [LetterCase]
LetterCase -> LetterCase -> LetterCase -> [LetterCase]
(LetterCase -> LetterCase)
-> (LetterCase -> LetterCase)
-> (Int -> LetterCase)
-> (LetterCase -> Int)
-> (LetterCase -> [LetterCase])
-> (LetterCase -> LetterCase -> [LetterCase])
-> (LetterCase -> LetterCase -> [LetterCase])
-> (LetterCase -> LetterCase -> LetterCase -> [LetterCase])
-> Enum LetterCase
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool) -> Eq LetterCase
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. LetterCase -> Rep LetterCase x)
-> (forall x. Rep LetterCase x -> LetterCase) -> Generic LetterCase
forall x. Rep LetterCase x -> LetterCase
forall x. LetterCase -> Rep LetterCase x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LetterCase x -> LetterCase
$cfrom :: forall x. LetterCase -> Rep LetterCase x
Generic, Eq LetterCase
Eq LetterCase
-> (LetterCase -> LetterCase -> Ordering)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> Bool)
-> (LetterCase -> LetterCase -> LetterCase)
-> (LetterCase -> LetterCase -> LetterCase)
-> Ord LetterCase
LetterCase -> LetterCase -> Bool
LetterCase -> LetterCase -> Ordering
LetterCase -> LetterCase -> LetterCase
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq LetterCase
Ord, ReadPrec [LetterCase]
ReadPrec LetterCase
Int -> ReadS LetterCase
ReadS [LetterCase]
(Int -> ReadS LetterCase)
-> ReadS [LetterCase]
-> ReadPrec LetterCase
-> ReadPrec [LetterCase]
-> Read LetterCase
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> LetterCase -> ShowS)
-> (LetterCase -> String)
-> ([LetterCase] -> ShowS)
-> Show LetterCase
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
  :: a  -- ^ The value to return in case of 'UpperCase'.
  -> a  -- ^ The value to return in case of 'LowerCase'.
  -> LetterCase  -- ^ The given /letter case/.
  -> a  -- ^ One of the two given values, depending on the 'LetterCase' value.
splitLetterCase :: 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
  = WithoutPlus  -- ^ Write positive numbers /without/ using a plus sign.
  | WithPlus  -- ^ Write positive numbers /with/ a plus sign.
  deriving (PlusStyle
PlusStyle -> PlusStyle -> Bounded PlusStyle
forall a. a -> a -> Bounded a
maxBound :: PlusStyle
$cmaxBound :: PlusStyle
minBound :: PlusStyle
$cminBound :: PlusStyle
Bounded, Typeable PlusStyle
DataType
Constr
Typeable PlusStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> PlusStyle -> c PlusStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c PlusStyle)
-> (PlusStyle -> Constr)
-> (PlusStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c PlusStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c PlusStyle))
-> ((forall b. Data b => b -> b) -> PlusStyle -> PlusStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> PlusStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> PlusStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> PlusStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> PlusStyle -> m PlusStyle)
-> Data PlusStyle
PlusStyle -> DataType
PlusStyle -> Constr
(forall b. Data b => b -> b) -> PlusStyle -> PlusStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> PlusStyle -> c PlusStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cWithPlus :: Constr
$cWithoutPlus :: Constr
$tPlusStyle :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> PlusStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> PlusStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> PlusStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> PlusStyle -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable PlusStyle
Data, Int -> PlusStyle
PlusStyle -> Int
PlusStyle -> [PlusStyle]
PlusStyle -> PlusStyle
PlusStyle -> PlusStyle -> [PlusStyle]
PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle]
(PlusStyle -> PlusStyle)
-> (PlusStyle -> PlusStyle)
-> (Int -> PlusStyle)
-> (PlusStyle -> Int)
-> (PlusStyle -> [PlusStyle])
-> (PlusStyle -> PlusStyle -> [PlusStyle])
-> (PlusStyle -> PlusStyle -> [PlusStyle])
-> (PlusStyle -> PlusStyle -> PlusStyle -> [PlusStyle])
-> Enum PlusStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool) -> Eq PlusStyle
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. PlusStyle -> Rep PlusStyle x)
-> (forall x. Rep PlusStyle x -> PlusStyle) -> Generic PlusStyle
forall x. Rep PlusStyle x -> PlusStyle
forall x. PlusStyle -> Rep PlusStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PlusStyle x -> PlusStyle
$cfrom :: forall x. PlusStyle -> Rep PlusStyle x
Generic, Eq PlusStyle
Eq PlusStyle
-> (PlusStyle -> PlusStyle -> Ordering)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> Bool)
-> (PlusStyle -> PlusStyle -> PlusStyle)
-> (PlusStyle -> PlusStyle -> PlusStyle)
-> Ord PlusStyle
PlusStyle -> PlusStyle -> Bool
PlusStyle -> PlusStyle -> Ordering
PlusStyle -> PlusStyle -> PlusStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq PlusStyle
Ord, ReadPrec [PlusStyle]
ReadPrec PlusStyle
Int -> ReadS PlusStyle
ReadS [PlusStyle]
(Int -> ReadS PlusStyle)
-> ReadS [PlusStyle]
-> ReadPrec PlusStyle
-> ReadPrec [PlusStyle]
-> Read PlusStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> PlusStyle -> ShowS)
-> (PlusStyle -> String)
-> ([PlusStyle] -> ShowS)
-> Show PlusStyle
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
  :: a  -- ^ The value to return in case of 'WithoutPlus'.
  -> a  -- ^ The value to return in case of 'WithPlus'.
  -> PlusStyle  -- ^ The plus style.
  -> a  -- ^ One of the two given values, based on the 't:PlusStyle' value.
splitPlusStyle :: 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  -- ^ /Horizontal/ orientation.
  | Vertical  -- ^ /Vertical/ orientation.
  deriving (Orientation
Orientation -> Orientation -> Bounded Orientation
forall a. a -> a -> Bounded a
maxBound :: Orientation
$cmaxBound :: Orientation
minBound :: Orientation
$cminBound :: Orientation
Bounded, Typeable Orientation
DataType
Constr
Typeable Orientation
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Orientation -> c Orientation)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Orientation)
-> (Orientation -> Constr)
-> (Orientation -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Orientation))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c Orientation))
-> ((forall b. Data b => b -> b) -> Orientation -> Orientation)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Orientation -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Orientation -> r)
-> (forall u. (forall d. Data d => d -> u) -> Orientation -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Orientation -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Orientation -> m Orientation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Orientation -> m Orientation)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Orientation -> m Orientation)
-> Data Orientation
Orientation -> DataType
Orientation -> Constr
(forall b. Data b => b -> b) -> Orientation -> Orientation
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Orientation -> c Orientation
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cVertical :: Constr
$cHorizontal :: Constr
$tOrientation :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Orientation -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Orientation -> u
gmapQ :: (forall d. Data d => d -> u) -> Orientation -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Orientation -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Orientation
Data, Int -> Orientation
Orientation -> Int
Orientation -> [Orientation]
Orientation -> Orientation
Orientation -> Orientation -> [Orientation]
Orientation -> Orientation -> Orientation -> [Orientation]
(Orientation -> Orientation)
-> (Orientation -> Orientation)
-> (Int -> Orientation)
-> (Orientation -> Int)
-> (Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> [Orientation])
-> (Orientation -> Orientation -> Orientation -> [Orientation])
-> Enum Orientation
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool) -> Eq Orientation
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. Orientation -> Rep Orientation x)
-> (forall x. Rep Orientation x -> Orientation)
-> Generic Orientation
forall x. Rep Orientation x -> Orientation
forall x. Orientation -> Rep Orientation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Orientation x -> Orientation
$cfrom :: forall x. Orientation -> Rep Orientation x
Generic, Eq Orientation
Eq Orientation
-> (Orientation -> Orientation -> Ordering)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Bool)
-> (Orientation -> Orientation -> Orientation)
-> (Orientation -> Orientation -> Orientation)
-> Ord Orientation
Orientation -> Orientation -> Bool
Orientation -> Orientation -> Ordering
Orientation -> Orientation -> Orientation
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq Orientation
Ord, ReadPrec [Orientation]
ReadPrec Orientation
Int -> ReadS Orientation
ReadS [Orientation]
(Int -> ReadS Orientation)
-> ReadS [Orientation]
-> ReadPrec Orientation
-> ReadPrec [Orientation]
-> Read Orientation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> Orientation -> ShowS)
-> (Orientation -> String)
-> ([Orientation] -> ShowS)
-> Show Orientation
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 {
    Oriented a -> a
oobject :: a  -- ^ The object that is oriented.
  , Oriented a -> Orientation
orientation :: Orientation  -- ^ The oriented of the oriented object.
  } deriving (Oriented a
Oriented a -> Oriented a -> Bounded (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, Typeable (Oriented a)
DataType
Constr
Typeable (Oriented a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Oriented a -> c (Oriented a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Oriented a))
-> (Oriented a -> Constr)
-> (Oriented a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Oriented a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Oriented a)))
-> ((forall b. Data b => b -> b) -> Oriented a -> Oriented a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Oriented a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Oriented a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Oriented a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Oriented a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a))
-> Data (Oriented a)
Oriented a -> DataType
Oriented a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
(forall b. Data b => b -> b) -> Oriented a -> Oriented a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> c (Oriented a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Oriented a)
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 u. Int -> (forall d. Data d => d -> u) -> Oriented a -> u
forall u. (forall d. Data d => d -> u) -> Oriented a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Oriented a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Oriented a -> m (Oriented a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Oriented a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Oriented a -> c (Oriented a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Oriented a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Oriented a))
$cOriented :: Constr
$tOriented :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> Oriented a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Oriented a -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall a. Data a => Typeable (Oriented a)
Data, Oriented a -> Oriented a -> Bool
(Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool) -> Eq (Oriented a)
forall a. Eq a => Oriented a -> Oriented a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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, Oriented a -> Bool
(a -> m) -> Oriented a -> m
(a -> b -> b) -> b -> Oriented a -> b
(forall m. Monoid m => Oriented m -> m)
-> (forall m a. Monoid m => (a -> m) -> Oriented a -> m)
-> (forall m a. Monoid m => (a -> m) -> Oriented a -> m)
-> (forall a b. (a -> b -> b) -> b -> Oriented a -> b)
-> (forall a b. (a -> b -> b) -> b -> Oriented a -> b)
-> (forall b a. (b -> a -> b) -> b -> Oriented a -> b)
-> (forall b a. (b -> a -> b) -> b -> Oriented a -> b)
-> (forall a. (a -> a -> a) -> Oriented a -> a)
-> (forall a. (a -> a -> a) -> Oriented a -> a)
-> (forall a. Oriented a -> [a])
-> (forall a. Oriented a -> Bool)
-> (forall a. Oriented a -> Int)
-> (forall a. Eq a => a -> Oriented a -> Bool)
-> (forall a. Ord a => Oriented a -> a)
-> (forall a. Ord a => Oriented a -> a)
-> (forall a. Num a => Oriented a -> a)
-> (forall a. Num a => Oriented a -> a)
-> Foldable Oriented
forall a. Eq a => a -> Oriented a -> Bool
forall a. Num a => Oriented a -> a
forall a. Ord a => Oriented a -> a
forall m. Monoid m => Oriented m -> m
forall a. Oriented a -> Bool
forall a. Oriented a -> Int
forall a. Oriented a -> [a]
forall a. (a -> a -> a) -> Oriented a -> a
forall m a. Monoid m => (a -> m) -> Oriented a -> m
forall b a. (b -> a -> b) -> b -> Oriented a -> b
forall a b. (a -> b -> b) -> b -> Oriented a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Oriented a -> a
$cproduct :: forall a. Num a => Oriented a -> a
sum :: Oriented a -> a
$csum :: forall a. Num a => Oriented a -> a
minimum :: Oriented a -> a
$cminimum :: forall a. Ord a => Oriented a -> a
maximum :: Oriented a -> a
$cmaximum :: forall a. Ord a => Oriented a -> a
elem :: a -> Oriented a -> Bool
$celem :: forall a. Eq a => a -> Oriented a -> Bool
length :: Oriented a -> Int
$clength :: forall a. Oriented a -> Int
null :: Oriented a -> Bool
$cnull :: forall a. Oriented a -> Bool
toList :: Oriented a -> [a]
$ctoList :: forall a. Oriented a -> [a]
foldl1 :: (a -> a -> a) -> Oriented a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Oriented a -> a
foldr1 :: (a -> a -> a) -> Oriented a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Oriented a -> a
foldl' :: (b -> a -> b) -> b -> Oriented a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Oriented a -> b
foldl :: (b -> a -> b) -> b -> Oriented a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Oriented a -> b
foldr' :: (a -> b -> b) -> b -> Oriented a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
foldr :: (a -> b -> b) -> b -> Oriented a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Oriented a -> b
foldMap' :: (a -> m) -> Oriented a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
foldMap :: (a -> m) -> Oriented a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Oriented a -> m
fold :: Oriented m -> m
$cfold :: forall m. Monoid m => Oriented m -> m
Foldable, a -> Oriented b -> Oriented a
(a -> b) -> Oriented a -> Oriented b
(forall a b. (a -> b) -> Oriented a -> Oriented b)
-> (forall a b. a -> Oriented b -> Oriented a) -> Functor Oriented
forall a b. a -> Oriented b -> Oriented a
forall a b. (a -> b) -> Oriented a -> Oriented b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Oriented b -> Oriented a
$c<$ :: forall a b. a -> Oriented b -> Oriented a
fmap :: (a -> b) -> Oriented a -> Oriented b
$cfmap :: forall a b. (a -> b) -> Oriented a -> Oriented b
Functor, (forall x. Oriented a -> Rep (Oriented a) x)
-> (forall x. Rep (Oriented a) x -> Oriented a)
-> Generic (Oriented a)
forall x. Rep (Oriented a) x -> Oriented a
forall x. Oriented a -> Rep (Oriented a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Oriented a) x -> Oriented a
forall a x. Oriented a -> Rep (Oriented a) x
$cto :: forall a x. Rep (Oriented a) x -> Oriented a
$cfrom :: forall a x. Oriented a -> Rep (Oriented a) x
Generic, (forall a. Oriented a -> Rep1 Oriented a)
-> (forall a. Rep1 Oriented a -> Oriented a) -> Generic1 Oriented
forall a. Rep1 Oriented a -> Oriented a
forall a. Oriented a -> Rep1 Oriented a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Oriented a -> Oriented a
$cfrom1 :: forall a. Oriented a -> Rep1 Oriented a
Generic1, Eq (Oriented a)
Eq (Oriented a)
-> (Oriented a -> Oriented a -> Ordering)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Bool)
-> (Oriented a -> Oriented a -> Oriented a)
-> (Oriented a -> Oriented a -> Oriented a)
-> Ord (Oriented a)
Oriented a -> Oriented a -> Bool
Oriented a -> Oriented a -> Ordering
Oriented a -> Oriented a -> Oriented a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Oriented a)
forall a. Ord a => Oriented a -> Oriented a -> Bool
forall a. Ord a => Oriented a -> Oriented a -> Ordering
forall a. Ord a => Oriented a -> Oriented a -> Oriented a
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
$cp1Ord :: forall a. Ord a => Eq (Oriented a)
Ord, ReadPrec [Oriented a]
ReadPrec (Oriented a)
Int -> ReadS (Oriented a)
ReadS [Oriented a]
(Int -> ReadS (Oriented a))
-> ReadS [Oriented a]
-> ReadPrec (Oriented a)
-> ReadPrec [Oriented a]
-> Read (Oriented a)
forall a. Read a => ReadPrec [Oriented a]
forall a. Read a => ReadPrec (Oriented a)
forall a. Read a => Int -> ReadS (Oriented a)
forall a. Read a => ReadS [Oriented a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
[Oriented a] -> ShowS
Oriented a -> String
(Int -> Oriented a -> ShowS)
-> (Oriented a -> String)
-> ([Oriented a] -> ShowS)
-> Show (Oriented a)
forall a. Show a => Int -> Oriented a -> ShowS
forall a. Show a => [Oriented a] -> ShowS
forall a. Show a => Oriented a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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
Functor Oriented
-> Foldable Oriented
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Oriented a -> f (Oriented b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Oriented (f a) -> f (Oriented a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Oriented a -> m (Oriented b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Oriented (m a) -> m (Oriented a))
-> Traversable Oriented
(a -> f b) -> Oriented a -> f (Oriented b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (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 :: Oriented (m a) -> m (Oriented a)
$csequence :: forall (m :: * -> *) a. Monad m => Oriented (m a) -> m (Oriented a)
mapM :: (a -> m b) -> Oriented a -> m (Oriented b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Oriented a -> m (Oriented b)
sequenceA :: Oriented (f a) -> f (Oriented a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Oriented (f a) -> f (Oriented a)
traverse :: (a -> f b) -> Oriented a -> f (Oriented b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Oriented a -> f (Oriented b)
$cp2Traversable :: Foldable Oriented
$cp1Traversable :: Functor Oriented
Traversable)

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

instance Hashable1 Oriented

instance Hashable a => Hashable (Oriented a)

instance NFData a => NFData (Oriented a)

instance NFData1 Oriented

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

-- | Possible rotations of a unicode character if that character can be rotated
-- over 0, 90, 180, and 270 degrees.
data Rotate90
  = R0  -- ^ No rotation.
  | R90  -- ^ Rotation over /90/ degrees.
  | R180  -- ^ Rotation over /180/ degrees.
  | R270  -- ^ Rotation over /270/ degrees.
  deriving (Rotate90
Rotate90 -> Rotate90 -> Bounded Rotate90
forall a. a -> a -> Bounded a
maxBound :: Rotate90
$cmaxBound :: Rotate90
minBound :: Rotate90
$cminBound :: Rotate90
Bounded, Typeable Rotate90
DataType
Constr
Typeable Rotate90
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Rotate90 -> c Rotate90)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Rotate90)
-> (Rotate90 -> Constr)
-> (Rotate90 -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Rotate90))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Rotate90))
-> ((forall b. Data b => b -> b) -> Rotate90 -> Rotate90)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotate90 -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotate90 -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotate90 -> m Rotate90)
-> Data Rotate90
Rotate90 -> DataType
Rotate90 -> Constr
(forall b. Data b => b -> b) -> Rotate90 -> Rotate90
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotate90 -> c Rotate90
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cR270 :: Constr
$cR180 :: Constr
$cR90 :: Constr
$cR0 :: Constr
$tRotate90 :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Rotate90 -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Rotate90 -> u
gmapQ :: (forall d. Data d => d -> u) -> Rotate90 -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Rotate90 -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Rotate90
Data, Int -> Rotate90
Rotate90 -> Int
Rotate90 -> [Rotate90]
Rotate90 -> Rotate90
Rotate90 -> Rotate90 -> [Rotate90]
Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90]
(Rotate90 -> Rotate90)
-> (Rotate90 -> Rotate90)
-> (Int -> Rotate90)
-> (Rotate90 -> Int)
-> (Rotate90 -> [Rotate90])
-> (Rotate90 -> Rotate90 -> [Rotate90])
-> (Rotate90 -> Rotate90 -> [Rotate90])
-> (Rotate90 -> Rotate90 -> Rotate90 -> [Rotate90])
-> Enum Rotate90
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool) -> Eq Rotate90
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. Rotate90 -> Rep Rotate90 x)
-> (forall x. Rep Rotate90 x -> Rotate90) -> Generic Rotate90
forall x. Rep Rotate90 x -> Rotate90
forall x. Rotate90 -> Rep Rotate90 x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rotate90 x -> Rotate90
$cfrom :: forall x. Rotate90 -> Rep Rotate90 x
Generic, Eq Rotate90
Eq Rotate90
-> (Rotate90 -> Rotate90 -> Ordering)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Bool)
-> (Rotate90 -> Rotate90 -> Rotate90)
-> (Rotate90 -> Rotate90 -> Rotate90)
-> Ord Rotate90
Rotate90 -> Rotate90 -> Bool
Rotate90 -> Rotate90 -> Ordering
Rotate90 -> Rotate90 -> Rotate90
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq Rotate90
Ord, ReadPrec [Rotate90]
ReadPrec Rotate90
Int -> ReadS Rotate90
ReadS [Rotate90]
(Int -> ReadS Rotate90)
-> ReadS [Rotate90]
-> ReadPrec Rotate90
-> ReadPrec [Rotate90]
-> Read Rotate90
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> Rotate90 -> ShowS)
-> (Rotate90 -> String) -> ([Rotate90] -> ShowS) -> Show Rotate90
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 {
    Rotated a -> a
robject :: a  -- ^ The object that is rotated.
  , Rotated a -> Rotate90
rotation :: Rotate90  -- ^ The rotation of the rotated object.
  } deriving (Rotated a
Rotated a -> Rotated a -> Bounded (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, Typeable (Rotated a)
DataType
Constr
Typeable (Rotated a)
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Rotated a -> c (Rotated a))
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c (Rotated a))
-> (Rotated a -> Constr)
-> (Rotated a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c (Rotated a)))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c (Rotated a)))
-> ((forall b. Data b => b -> b) -> Rotated a -> Rotated a)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotated a -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Rotated a -> r)
-> (forall u. (forall d. Data d => d -> u) -> Rotated a -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> Rotated a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a))
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a))
-> Data (Rotated a)
Rotated a -> DataType
Rotated a -> Constr
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
(forall b. Data b => b -> b) -> Rotated a -> Rotated a
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> c (Rotated a)
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rotated a)
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 u. Int -> (forall d. Data d => d -> u) -> Rotated a -> u
forall u. (forall d. Data d => d -> u) -> Rotated a -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Rotated a -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Rotated a -> m (Rotated a)
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c (Rotated a)
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Rotated a -> c (Rotated a)
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c (Rotated a))
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c (Rotated a))
$cRotated :: Constr
$tRotated :: DataType
gmapMo :: (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 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 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 :: 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 d. Data d => d -> u) -> Rotated a -> [u]
$cgmapQ :: forall a u.
Data a =>
(forall d. Data d => d -> u) -> Rotated a -> [u]
gmapQr :: (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 :: (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 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 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 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 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)
$cp1Data :: forall a. Data a => Typeable (Rotated a)
Data, Rotated a -> Rotated a -> Bool
(Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool) -> Eq (Rotated a)
forall a. Eq a => Rotated a -> Rotated a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: 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, Rotated a -> Bool
(a -> m) -> Rotated a -> m
(a -> b -> b) -> b -> Rotated a -> b
(forall m. Monoid m => Rotated m -> m)
-> (forall m a. Monoid m => (a -> m) -> Rotated a -> m)
-> (forall m a. Monoid m => (a -> m) -> Rotated a -> m)
-> (forall a b. (a -> b -> b) -> b -> Rotated a -> b)
-> (forall a b. (a -> b -> b) -> b -> Rotated a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rotated a -> b)
-> (forall b a. (b -> a -> b) -> b -> Rotated a -> b)
-> (forall a. (a -> a -> a) -> Rotated a -> a)
-> (forall a. (a -> a -> a) -> Rotated a -> a)
-> (forall a. Rotated a -> [a])
-> (forall a. Rotated a -> Bool)
-> (forall a. Rotated a -> Int)
-> (forall a. Eq a => a -> Rotated a -> Bool)
-> (forall a. Ord a => Rotated a -> a)
-> (forall a. Ord a => Rotated a -> a)
-> (forall a. Num a => Rotated a -> a)
-> (forall a. Num a => Rotated a -> a)
-> Foldable Rotated
forall a. Eq a => a -> Rotated a -> Bool
forall a. Num a => Rotated a -> a
forall a. Ord a => Rotated a -> a
forall m. Monoid m => Rotated m -> m
forall a. Rotated a -> Bool
forall a. Rotated a -> Int
forall a. Rotated a -> [a]
forall a. (a -> a -> a) -> Rotated a -> a
forall m a. Monoid m => (a -> m) -> Rotated a -> m
forall b a. (b -> a -> b) -> b -> Rotated a -> b
forall a b. (a -> b -> b) -> b -> Rotated a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
product :: Rotated a -> a
$cproduct :: forall a. Num a => Rotated a -> a
sum :: Rotated a -> a
$csum :: forall a. Num a => Rotated a -> a
minimum :: Rotated a -> a
$cminimum :: forall a. Ord a => Rotated a -> a
maximum :: Rotated a -> a
$cmaximum :: forall a. Ord a => Rotated a -> a
elem :: a -> Rotated a -> Bool
$celem :: forall a. Eq a => a -> Rotated a -> Bool
length :: Rotated a -> Int
$clength :: forall a. Rotated a -> Int
null :: Rotated a -> Bool
$cnull :: forall a. Rotated a -> Bool
toList :: Rotated a -> [a]
$ctoList :: forall a. Rotated a -> [a]
foldl1 :: (a -> a -> a) -> Rotated a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Rotated a -> a
foldr1 :: (a -> a -> a) -> Rotated a -> a
$cfoldr1 :: forall a. (a -> a -> a) -> Rotated a -> a
foldl' :: (b -> a -> b) -> b -> Rotated a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Rotated a -> b
foldl :: (b -> a -> b) -> b -> Rotated a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Rotated a -> b
foldr' :: (a -> b -> b) -> b -> Rotated a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
foldr :: (a -> b -> b) -> b -> Rotated a -> b
$cfoldr :: forall a b. (a -> b -> b) -> b -> Rotated a -> b
foldMap' :: (a -> m) -> Rotated a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
foldMap :: (a -> m) -> Rotated a -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Rotated a -> m
fold :: Rotated m -> m
$cfold :: forall m. Monoid m => Rotated m -> m
Foldable, a -> Rotated b -> Rotated a
(a -> b) -> Rotated a -> Rotated b
(forall a b. (a -> b) -> Rotated a -> Rotated b)
-> (forall a b. a -> Rotated b -> Rotated a) -> Functor Rotated
forall a b. a -> Rotated b -> Rotated a
forall a b. (a -> b) -> Rotated a -> Rotated b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Rotated b -> Rotated a
$c<$ :: forall a b. a -> Rotated b -> Rotated a
fmap :: (a -> b) -> Rotated a -> Rotated b
$cfmap :: forall a b. (a -> b) -> Rotated a -> Rotated b
Functor, (forall x. Rotated a -> Rep (Rotated a) x)
-> (forall x. Rep (Rotated a) x -> Rotated a)
-> Generic (Rotated a)
forall x. Rep (Rotated a) x -> Rotated a
forall x. Rotated a -> Rep (Rotated a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Rotated a) x -> Rotated a
forall a x. Rotated a -> Rep (Rotated a) x
$cto :: forall a x. Rep (Rotated a) x -> Rotated a
$cfrom :: forall a x. Rotated a -> Rep (Rotated a) x
Generic, (forall a. Rotated a -> Rep1 Rotated a)
-> (forall a. Rep1 Rotated a -> Rotated a) -> Generic1 Rotated
forall a. Rep1 Rotated a -> Rotated a
forall a. Rotated a -> Rep1 Rotated a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall a. Rep1 Rotated a -> Rotated a
$cfrom1 :: forall a. Rotated a -> Rep1 Rotated a
Generic1, Eq (Rotated a)
Eq (Rotated a)
-> (Rotated a -> Rotated a -> Ordering)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Bool)
-> (Rotated a -> Rotated a -> Rotated a)
-> (Rotated a -> Rotated a -> Rotated a)
-> Ord (Rotated a)
Rotated a -> Rotated a -> Bool
Rotated a -> Rotated a -> Ordering
Rotated a -> Rotated a -> Rotated a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Rotated a)
forall a. Ord a => Rotated a -> Rotated a -> Bool
forall a. Ord a => Rotated a -> Rotated a -> Ordering
forall a. Ord a => Rotated a -> Rotated a -> Rotated a
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
$cp1Ord :: forall a. Ord a => Eq (Rotated a)
Ord, ReadPrec [Rotated a]
ReadPrec (Rotated a)
Int -> ReadS (Rotated a)
ReadS [Rotated a]
(Int -> ReadS (Rotated a))
-> ReadS [Rotated a]
-> ReadPrec (Rotated a)
-> ReadPrec [Rotated a]
-> Read (Rotated a)
forall a. Read a => ReadPrec [Rotated a]
forall a. Read a => ReadPrec (Rotated a)
forall a. Read a => Int -> ReadS (Rotated a)
forall a. Read a => ReadS [Rotated a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
[Rotated a] -> ShowS
Rotated a -> String
(Int -> Rotated a -> ShowS)
-> (Rotated a -> String)
-> ([Rotated a] -> ShowS)
-> Show (Rotated a)
forall a. Show a => Int -> Rotated a -> ShowS
forall a. Show a => [Rotated a] -> ShowS
forall a. Show a => Rotated a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
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
Functor Rotated
-> Foldable Rotated
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> Rotated a -> f (Rotated b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    Rotated (f a) -> f (Rotated a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Rotated a -> m (Rotated b))
-> (forall (m :: * -> *) a.
    Monad m =>
    Rotated (m a) -> m (Rotated a))
-> Traversable Rotated
(a -> f b) -> Rotated a -> f (Rotated b)
forall (t :: * -> *).
Functor t
-> Foldable t
-> (forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (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 :: Rotated (m a) -> m (Rotated a)
$csequence :: forall (m :: * -> *) a. Monad m => Rotated (m a) -> m (Rotated a)
mapM :: (a -> m b) -> Rotated a -> m (Rotated b)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Rotated a -> m (Rotated b)
sequenceA :: Rotated (f a) -> f (Rotated a)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Rotated (f a) -> f (Rotated a)
traverse :: (a -> f b) -> Rotated a -> f (Rotated b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Rotated a -> f (Rotated b)
$cp2Traversable :: Foldable Rotated
$cp1Traversable :: Functor Rotated
Traversable)

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

instance Hashable1 Rotated

instance Hashable a => Hashable (Rotated a)

instance NFData a => NFData (Rotated a)

instance NFData1 Rotated

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

-- | A data type that lists the possible emphasis of a font. This can be 'Bold'
-- or 'NoBold' the 'Default' is 'NoBold'.
data Emphasis
  = NoBold  -- ^ The characters are not stressed with boldface.
  | Bold  -- ^ The characters are stressed in boldface.
  deriving (Emphasis
Emphasis -> Emphasis -> Bounded Emphasis
forall a. a -> a -> Bounded a
maxBound :: Emphasis
$cmaxBound :: Emphasis
minBound :: Emphasis
$cminBound :: Emphasis
Bounded, Typeable Emphasis
DataType
Constr
Typeable Emphasis
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Emphasis -> c Emphasis)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Emphasis)
-> (Emphasis -> Constr)
-> (Emphasis -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Emphasis))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Emphasis))
-> ((forall b. Data b => b -> b) -> Emphasis -> Emphasis)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Emphasis -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Emphasis -> r)
-> (forall u. (forall d. Data d => d -> u) -> Emphasis -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Emphasis -> m Emphasis)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Emphasis -> m Emphasis)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Emphasis -> m Emphasis)
-> Data Emphasis
Emphasis -> DataType
Emphasis -> Constr
(forall b. Data b => b -> b) -> Emphasis -> Emphasis
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Emphasis -> c Emphasis
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cBold :: Constr
$cNoBold :: Constr
$tEmphasis :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Emphasis -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Emphasis -> u
gmapQ :: (forall d. Data d => d -> u) -> Emphasis -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Emphasis -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Emphasis
Data, Int -> Emphasis
Emphasis -> Int
Emphasis -> [Emphasis]
Emphasis -> Emphasis
Emphasis -> Emphasis -> [Emphasis]
Emphasis -> Emphasis -> Emphasis -> [Emphasis]
(Emphasis -> Emphasis)
-> (Emphasis -> Emphasis)
-> (Int -> Emphasis)
-> (Emphasis -> Int)
-> (Emphasis -> [Emphasis])
-> (Emphasis -> Emphasis -> [Emphasis])
-> (Emphasis -> Emphasis -> [Emphasis])
-> (Emphasis -> Emphasis -> Emphasis -> [Emphasis])
-> Enum Emphasis
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool) -> Eq Emphasis
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. Emphasis -> Rep Emphasis x)
-> (forall x. Rep Emphasis x -> Emphasis) -> Generic Emphasis
forall x. Rep Emphasis x -> Emphasis
forall x. Emphasis -> Rep Emphasis x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Emphasis x -> Emphasis
$cfrom :: forall x. Emphasis -> Rep Emphasis x
Generic, Eq Emphasis
Eq Emphasis
-> (Emphasis -> Emphasis -> Ordering)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Bool)
-> (Emphasis -> Emphasis -> Emphasis)
-> (Emphasis -> Emphasis -> Emphasis)
-> Ord Emphasis
Emphasis -> Emphasis -> Bool
Emphasis -> Emphasis -> Ordering
Emphasis -> Emphasis -> Emphasis
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq Emphasis
Ord, ReadPrec [Emphasis]
ReadPrec Emphasis
Int -> ReadS Emphasis
ReadS [Emphasis]
(Int -> ReadS Emphasis)
-> ReadS [Emphasis]
-> ReadPrec Emphasis
-> ReadPrec [Emphasis]
-> Read Emphasis
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> Emphasis -> ShowS)
-> (Emphasis -> String) -> ([Emphasis] -> ShowS) -> Show Emphasis
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
  :: a  -- ^ The value to return in case of 'NoBold'.
  -> a  -- ^ The value to return in case of 'Bold'.
  -> Emphasis  -- ^ The emphasis type.
  -> a  -- ^ One of the two given values, based on the 't:Emphasis' value.
splitEmphasis :: 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
  = NoItalic  -- ^ No italic characters are used.
  | Italic  -- ^ Italic characters are used.
  deriving (ItalicType
ItalicType -> ItalicType -> Bounded ItalicType
forall a. a -> a -> Bounded a
maxBound :: ItalicType
$cmaxBound :: ItalicType
minBound :: ItalicType
$cminBound :: ItalicType
Bounded, Typeable ItalicType
DataType
Constr
Typeable ItalicType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ItalicType -> c ItalicType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ItalicType)
-> (ItalicType -> Constr)
-> (ItalicType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ItalicType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ItalicType))
-> ((forall b. Data b => b -> b) -> ItalicType -> ItalicType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ItalicType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ItalicType -> r)
-> (forall u. (forall d. Data d => d -> u) -> ItalicType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ItalicType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ItalicType -> m ItalicType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ItalicType -> m ItalicType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ItalicType -> m ItalicType)
-> Data ItalicType
ItalicType -> DataType
ItalicType -> Constr
(forall b. Data b => b -> b) -> ItalicType -> ItalicType
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ItalicType -> c ItalicType
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cItalic :: Constr
$cNoItalic :: Constr
$tItalicType :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> ItalicType -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ItalicType -> u
gmapQ :: (forall d. Data d => d -> u) -> ItalicType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ItalicType -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable ItalicType
Data, Int -> ItalicType
ItalicType -> Int
ItalicType -> [ItalicType]
ItalicType -> ItalicType
ItalicType -> ItalicType -> [ItalicType]
ItalicType -> ItalicType -> ItalicType -> [ItalicType]
(ItalicType -> ItalicType)
-> (ItalicType -> ItalicType)
-> (Int -> ItalicType)
-> (ItalicType -> Int)
-> (ItalicType -> [ItalicType])
-> (ItalicType -> ItalicType -> [ItalicType])
-> (ItalicType -> ItalicType -> [ItalicType])
-> (ItalicType -> ItalicType -> ItalicType -> [ItalicType])
-> Enum ItalicType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool) -> Eq ItalicType
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. ItalicType -> Rep ItalicType x)
-> (forall x. Rep ItalicType x -> ItalicType) -> Generic ItalicType
forall x. Rep ItalicType x -> ItalicType
forall x. ItalicType -> Rep ItalicType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItalicType x -> ItalicType
$cfrom :: forall x. ItalicType -> Rep ItalicType x
Generic, Eq ItalicType
Eq ItalicType
-> (ItalicType -> ItalicType -> Ordering)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> Bool)
-> (ItalicType -> ItalicType -> ItalicType)
-> (ItalicType -> ItalicType -> ItalicType)
-> Ord ItalicType
ItalicType -> ItalicType -> Bool
ItalicType -> ItalicType -> Ordering
ItalicType -> ItalicType -> ItalicType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq ItalicType
Ord, ReadPrec [ItalicType]
ReadPrec ItalicType
Int -> ReadS ItalicType
ReadS [ItalicType]
(Int -> ReadS ItalicType)
-> ReadS [ItalicType]
-> ReadPrec ItalicType
-> ReadPrec [ItalicType]
-> Read ItalicType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> ItalicType -> ShowS)
-> (ItalicType -> String)
-> ([ItalicType] -> ShowS)
-> Show ItalicType
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
  :: a  -- ^ The value to return in case of 'NoItalic'.
  -> a  -- ^ The value to return in case of 'Italic'.
  -> ItalicType  -- ^ The italic type.
  -> a  -- ^ One of the two given values, based on the 't:ItalicType' value.
splitItalicType :: 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
  = SansSerif  -- ^ The character is a character rendered /without/ serifs.
  | Serif  -- ^ The character is a character rendered /with/ serifs.
  deriving (FontStyle
FontStyle -> FontStyle -> Bounded FontStyle
forall a. a -> a -> Bounded a
maxBound :: FontStyle
$cmaxBound :: FontStyle
minBound :: FontStyle
$cminBound :: FontStyle
Bounded, Typeable FontStyle
DataType
Constr
Typeable FontStyle
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> FontStyle -> c FontStyle)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c FontStyle)
-> (FontStyle -> Constr)
-> (FontStyle -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c FontStyle))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c FontStyle))
-> ((forall b. Data b => b -> b) -> FontStyle -> FontStyle)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> FontStyle -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> FontStyle -> r)
-> (forall u. (forall d. Data d => d -> u) -> FontStyle -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> FontStyle -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> FontStyle -> m FontStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FontStyle -> m FontStyle)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> FontStyle -> m FontStyle)
-> Data FontStyle
FontStyle -> DataType
FontStyle -> Constr
(forall b. Data b => b -> b) -> FontStyle -> FontStyle
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> FontStyle -> c FontStyle
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cSerif :: Constr
$cSansSerif :: Constr
$tFontStyle :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> FontStyle -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> FontStyle -> u
gmapQ :: (forall d. Data d => d -> u) -> FontStyle -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> FontStyle -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable FontStyle
Data, Int -> FontStyle
FontStyle -> Int
FontStyle -> [FontStyle]
FontStyle -> FontStyle
FontStyle -> FontStyle -> [FontStyle]
FontStyle -> FontStyle -> FontStyle -> [FontStyle]
(FontStyle -> FontStyle)
-> (FontStyle -> FontStyle)
-> (Int -> FontStyle)
-> (FontStyle -> Int)
-> (FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> [FontStyle])
-> (FontStyle -> FontStyle -> FontStyle -> [FontStyle])
-> Enum FontStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool) -> Eq FontStyle
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. FontStyle -> Rep FontStyle x)
-> (forall x. Rep FontStyle x -> FontStyle) -> Generic FontStyle
forall x. Rep FontStyle x -> FontStyle
forall x. FontStyle -> Rep FontStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FontStyle x -> FontStyle
$cfrom :: forall x. FontStyle -> Rep FontStyle x
Generic, Eq FontStyle
Eq FontStyle
-> (FontStyle -> FontStyle -> Ordering)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> Bool)
-> (FontStyle -> FontStyle -> FontStyle)
-> (FontStyle -> FontStyle -> FontStyle)
-> Ord FontStyle
FontStyle -> FontStyle -> Bool
FontStyle -> FontStyle -> Ordering
FontStyle -> FontStyle -> FontStyle
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq FontStyle
Ord, ReadPrec [FontStyle]
ReadPrec FontStyle
Int -> ReadS FontStyle
ReadS [FontStyle]
(Int -> ReadS FontStyle)
-> ReadS [FontStyle]
-> ReadPrec FontStyle
-> ReadPrec [FontStyle]
-> Read FontStyle
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> FontStyle -> ShowS)
-> (FontStyle -> String)
-> ([FontStyle] -> ShowS)
-> Show FontStyle
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
  :: a  -- ^ The value to return in case of 'SansSerif'.
  -> a  -- ^ The value to return in case of 'Serif'.
  -> FontStyle  -- ^ The font style.
  -> a  -- ^ One of the two given values, based on the 't:FontStyle' value.
splitFontStyle :: 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
  = Ligate  -- ^ A ligate operation is performed on the characters, the 'def' for 't:Ligate'.
  | NoLigate  -- ^ No ligate operation is performed on the charaters.
  deriving (Ligate
Ligate -> Ligate -> Bounded Ligate
forall a. a -> a -> Bounded a
maxBound :: Ligate
$cmaxBound :: Ligate
minBound :: Ligate
$cminBound :: Ligate
Bounded, Typeable Ligate
DataType
Constr
Typeable Ligate
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Ligate -> c Ligate)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Ligate)
-> (Ligate -> Constr)
-> (Ligate -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Ligate))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Ligate))
-> ((forall b. Data b => b -> b) -> Ligate -> Ligate)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Ligate -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Ligate -> r)
-> (forall u. (forall d. Data d => d -> u) -> Ligate -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Ligate -> m Ligate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ligate -> m Ligate)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Ligate -> m Ligate)
-> Data Ligate
Ligate -> DataType
Ligate -> Constr
(forall b. Data b => b -> b) -> Ligate -> Ligate
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Ligate -> c Ligate
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c 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)
$cNoLigate :: Constr
$cLigate :: Constr
$tLigate :: DataType
gmapMo :: (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 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 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 :: Int -> (forall d. Data d => d -> u) -> Ligate -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Ligate -> u
gmapQ :: (forall d. Data d => d -> u) -> Ligate -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Ligate -> [u]
gmapQr :: (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 :: (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 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 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 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 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
$cp1Data :: Typeable Ligate
Data, Int -> Ligate
Ligate -> Int
Ligate -> [Ligate]
Ligate -> Ligate
Ligate -> Ligate -> [Ligate]
Ligate -> Ligate -> Ligate -> [Ligate]
(Ligate -> Ligate)
-> (Ligate -> Ligate)
-> (Int -> Ligate)
-> (Ligate -> Int)
-> (Ligate -> [Ligate])
-> (Ligate -> Ligate -> [Ligate])
-> (Ligate -> Ligate -> [Ligate])
-> (Ligate -> Ligate -> Ligate -> [Ligate])
-> Enum Ligate
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
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
(Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool) -> Eq Ligate
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. Ligate -> Rep Ligate x)
-> (forall x. Rep Ligate x -> Ligate) -> Generic Ligate
forall x. Rep Ligate x -> Ligate
forall x. Ligate -> Rep Ligate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Ligate x -> Ligate
$cfrom :: forall x. Ligate -> Rep Ligate x
Generic, Eq Ligate
Eq Ligate
-> (Ligate -> Ligate -> Ordering)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Bool)
-> (Ligate -> Ligate -> Ligate)
-> (Ligate -> Ligate -> Ligate)
-> Ord Ligate
Ligate -> Ligate -> Bool
Ligate -> Ligate -> Ordering
Ligate -> Ligate -> Ligate
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
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
$cp1Ord :: Eq Ligate
Ord, ReadPrec [Ligate]
ReadPrec Ligate
Int -> ReadS Ligate
ReadS [Ligate]
(Int -> ReadS Ligate)
-> ReadS [Ligate]
-> ReadPrec Ligate
-> ReadPrec [Ligate]
-> Read Ligate
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
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
(Int -> Ligate -> ShowS)
-> (Ligate -> String) -> ([Ligate] -> ShowS) -> Show Ligate
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
  :: a  -- ^ The value to return in case of 'v:Ligate'.
  -> a  -- ^ The value to return in case of 'NoLigate'.
  -> Ligate  -- ^ The ligation style.
  -> a  -- ^ One of the two given values, based on the 't:Ligate' value.
splitLigate :: 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 :: (a -> a) -> Ligate -> a -> a
ligate a -> a
f Ligate
Ligate = a -> a
f
ligate a -> a
_ Ligate
NoLigate = a -> a
forall a. a -> a
id

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    -- | 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'
      :: Char  -- ^ The given 'Char'acter to convert to an element.
      -> a  -- ^ The given element that is equivalent to the given 'Char'acter.
    fromUnicodeChar' = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> (Char -> Maybe a) -> Char -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Maybe a
forall a. UnicodeCharacter a => Char -> Maybe a
fromUnicodeChar
    {-# 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
      :: a  -- ^ The given object to convert to a 'Text' object.
      -> Text  -- ^ A 'Text' object that is the Unicode representation of the element.
    default toUnicodeText :: UnicodeCharacter a => a -> Text
    toUnicodeText = Char -> Text
singleton (Char -> Text) -> (a -> Char) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Char
forall a. UnicodeCharacter a => a -> Char
toUnicodeChar

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

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

-- | A type class that specifies that the items can be mirrored in the /horizontal/ direction (such that up is now down).
class MirrorHorizontal a where
  -- | Obtain the /horizontally/ mirrored variant of the given item. Applying the same function twice should
  -- return the original object.
  mirrorHorizontal
    :: a  -- ^ The given item to mirror /horizontally/.
    -> a  -- ^ The corresponding mirrored item.
  {-# MINIMAL mirrorHorizontal #-}

-- | A type class that specifies that the items can be mirrored in the /vertical/ direction (such that left is now right).
class MirrorVertical a where
  -- | Obtain the /vertically/ mirrored variant of the given item. Applying the same function twice should
  -- return the original object.
  mirrorVertical
    :: a  -- ^ The given item to mirror /vertically/.
    -> a  -- ^ The corresponding mirrored item.
  {-# MINIMAL mirrorVertical #-}

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

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

-- | Construct a function that maps digits to the character with the given value
-- for @0@.
liftNumber
  :: Int  -- ^ 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.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' if the number is between @0@ and @9@; 'Nothing' otherwise.
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'
  :: Int  -- ^ The  given Unicode value used for @0@.
  -> Int  -- ^ The given digit to convert.
  -> Char  -- ^ The corresponding 'Char'acter, for numbers outside the @0-9@ range, the result is unspecified.
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
  :: Int  -- ^ The given Unicode value used for @0@.
  -> Int  -- ^ The given digit to convert to a number between 0 and 9.
  -> Maybe Char  -- ^ The corresponding 'Char'acter wrapped in a 'Just' if the number is between @0@ and @9@; 'Nothing' otherwise.
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'
  :: Int  -- ^ The  given Unicode value used for @0@.
  -> Int  -- ^ The given digit to convert, must be between @0@ and @9@.
  -> Char  -- ^ The corresponding 'Char'acter, for numbers outside the @0-9@ range, the result is unspecified.
liftDigit' :: Int -> Int -> Char
liftDigit' Int
d = Int -> Char
chr (Int -> Char) -> (Int -> Int) -> Int -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
dInt -> Int -> Int
forall a. Num a => a -> a -> a
+)

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

-- | Construct a function that maps upper case alphabetic characters with the
-- given value for @A@.
liftUppercase'
  :: Int  -- ^ The given Unicode value for @A@.
  -> Char  -- ^ 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.
liftUppercase' :: Int -> Char -> Char
liftUppercase' Int
d = Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
    where !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
65

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

-- | Construct a function that maps lower case alphabetic characters with the
-- given value for @a@.
liftLowercase'
  :: Int  -- ^ The given Unicode value for @a@.
  -> Char  -- ^ 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.
liftLowercase' :: Int -> Char -> Char
liftLowercase' Int
d = Int -> Char
chr (Int -> Char) -> (Char -> Int) -> Char -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int
d' Int -> Int -> Int
forall a. Num a => a -> a -> a
+) (Int -> Int) -> (Char -> Int) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord
    where !d' :: Int
d' = Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
97

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

instance UnicodeCharacter Char where
    toUnicodeChar :: Char -> Char
toUnicodeChar = Char -> Char
forall a. a -> a
id
    fromUnicodeChar :: Char -> Maybe Char
fromUnicodeChar = Char -> Maybe Char
forall a. a -> Maybe a
Just
    fromUnicodeChar' :: Char -> Char
fromUnicodeChar' = Char -> Char
forall a. a -> a
id

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

instance UnicodeText Char

instance UnicodeText Text where
    toUnicodeText :: Text -> Text
toUnicodeText = Text -> Text
forall a. a -> a
id
    fromUnicodeText :: Text -> Maybe Text
fromUnicodeText = Text -> Maybe Text
forall a. a -> Maybe a
Just
    fromUnicodeText' :: Text -> Text
fromUnicodeText' = Text -> Text
forall a. a -> a
id