module Pandora.IO.ASCII where

import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))
import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))

data ASCII = Control Control | Sign Sign | Letter Case Letter | Number Number

instance Setoid ASCII where
	Control Control
c == :: ASCII -> ASCII -> Boolean
== Control Control
c' = Control
c Control -> Control -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Control
c'
	Sign Sign
s == Sign Sign
s' = Sign
s Sign -> Sign -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Sign
s'
	Letter Case
с Letter
l == Letter Case
с' Letter
l' = (Case
с Case -> Case -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Case
с') Boolean -> Boolean -> Boolean
forall a. Ringoid a => a -> a -> a
* (Letter
l Letter -> Letter -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Letter
l')
	Number Number
n == Number Number
n' = Number
n Number -> Number -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Number
n'
	ASCII
_ == ASCII
_ = Boolean
False

data Control = NUL | SOH | STX | ETX | EOT | ENQ
	| ACK | BEL | BS | HT | LF | VT | FF | CR | SO | SI
	| DLE | DC1 | DC2 | DC3 | DC4 | NAK | SYN | ETB | CAN
	| EM | SUB | ESC | FS | GS | RS | US | SP | DEL

instance Setoid Control where
	Control
NUL == :: Control -> Control -> Boolean
== Control
NUL = Boolean
True
	Control
SOH == Control
SOH = Boolean
True
	Control
STX == Control
STX = Boolean
True
	Control
ETX == Control
ETX = Boolean
True
	Control
EOT == Control
EOT = Boolean
True
	Control
ENQ == Control
ENQ = Boolean
True
	Control
ACK == Control
ACK = Boolean
True
	Control
BEL == Control
BEL = Boolean
True
	Control
BS == Control
BS = Boolean
True
	Control
HT == Control
HT = Boolean
True
	Control
LF == Control
LF = Boolean
True
	Control
VT == Control
VT = Boolean
True
	Control
FF == Control
FF = Boolean
True
	Control
CR == Control
CR = Boolean
True
	Control
SO == Control
SO = Boolean
True
	Control
SI == Control
SI = Boolean
True
	Control
DLE == Control
DLE = Boolean
True
	Control
DC1 == Control
DC1 = Boolean
True
	Control
DC2 == Control
DC2 = Boolean
True
	Control
DC3 == Control
DC3 = Boolean
True
	Control
DC4 == Control
DC4 = Boolean
True
	Control
NAK == Control
NAK = Boolean
True
	Control
SYN == Control
SYN = Boolean
True
	Control
ETB == Control
ETB = Boolean
True
	Control
CAN == Control
CAN = Boolean
True
	Control
EM == Control
EM = Boolean
True
	Control
SUB == Control
SUB = Boolean
True
	Control
ESC == Control
ESC = Boolean
True
	Control
FS == Control
FS = Boolean
True
	Control
GS == Control
GS = Boolean
True
	Control
RS == Control
RS = Boolean
True
	Control
US == Control
US = Boolean
True
	Control
SP == Control
SP = Boolean
True
	Control
DEL == Control
DEL = Boolean
True
	Control
_ == Control
_ = Boolean
False

data Sign = Exclamation | Question | Quote Quote | Hash | Dollar | Percent | Ampersand | Apostrophe
	| Asterisk | Plus | Comma | Minus | Period | Slash Slash | Bracket Position Bracket
	| Colon | Semicolon | At | Caret | Underscore | Accent | Bar | Tilde | Equality

instance Setoid Sign where
	Sign
Exclamation == :: Sign -> Sign -> Boolean
== Sign
Exclamation = Boolean
True
	Quote Quote
q == Quote Quote
q' = Quote
q Quote -> Quote -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Quote
q'
	Sign
Hash == Sign
Hash = Boolean
True
	Sign
Dollar == Sign
Dollar = Boolean
True
	Sign
Percent == Sign
Percent = Boolean
True
	Sign
Ampersand == Sign
Ampersand = Boolean
True
	Sign
Apostrophe == Sign
Apostrophe = Boolean
True
	Sign
Asterisk == Sign
Asterisk = Boolean
True
	Sign
Plus == Sign
Plus = Boolean
True
	Sign
Comma == Sign
Comma = Boolean
True
	Sign
Minus == Sign
Minus = Boolean
True
	Sign
Period == Sign
Period = Boolean
True
	Slash Slash
s == Slash Slash
s' = Slash
s Slash -> Slash -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Slash
s'
	Bracket Position
p Bracket
b == Bracket Position
p' Bracket
b' = (Position
p Position -> Position -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Position
p') Boolean -> Boolean -> Boolean
forall a. Ringoid a => a -> a -> a
* (Bracket
b Bracket -> Bracket -> Boolean
forall a. Setoid a => a -> a -> Boolean
== Bracket
b')
	Sign
Colon == Sign
Colon = Boolean
True
	Sign
Semicolon == Sign
Semicolon = Boolean
True
	Sign
At == Sign
At = Boolean
True
	Sign
Caret == Sign
Caret = Boolean
True
	Sign
Underscore == Sign
Underscore = Boolean
True
	Sign
Accent == Sign
Accent = Boolean
True
	Sign
Bar == Sign
Bar = Boolean
True
	Sign
Tilde == Sign
Tilde = Boolean
True
	Sign
_ == Sign
_ = Boolean
False

data Bracket = Round | Square | Angle | Curly

instance Setoid Bracket where
	Bracket
Round == :: Bracket -> Bracket -> Boolean
== Bracket
Round = Boolean
True
	Bracket
Square == Bracket
Square = Boolean
True
	Bracket
Angle == Bracket
Angle = Boolean
True
	Bracket
Curly == Bracket
Curly = Boolean
True
	Bracket
_ == Bracket
_ = Boolean
False

data Position = Opened | Closed

instance Setoid Position where
	Position
Opened == :: Position -> Position -> Boolean
== Position
Opened = Boolean
True
	Position
Closed == Position
Closed = Boolean
True
	Position
_ == Position
_ = Boolean
False

data Slash = Forward | Back

instance Setoid Slash where
	Slash
Forward == :: Slash -> Slash -> Boolean
== Slash
Forward = Boolean
True
	Slash
Back == Slash
Back = Boolean
True
	Slash
_ == Slash
_ = Boolean
False

data Quote = Double | Single

instance Setoid Quote where
	Quote
Double == :: Quote -> Quote -> Boolean
== Quote
Double = Boolean
True
	Quote
Single == Quote
Single = Boolean
True
	Quote
_ == Quote
_ = Boolean
False

data Letter = A | B | C | D | E | F | G | H | I | J | K | L
	| M | N | O | P | Q | R | S | T | U | V | W | X | Y | Z

instance Setoid Letter where
	Letter
A == :: Letter -> Letter -> Boolean
== Letter
A = Boolean
True
	Letter
B == Letter
B = Boolean
True
	Letter
C == Letter
C = Boolean
True
	Letter
D == Letter
D = Boolean
True
	Letter
E == Letter
E = Boolean
True
	Letter
F == Letter
F = Boolean
True
	Letter
G == Letter
G = Boolean
True
	Letter
H == Letter
H = Boolean
True
	Letter
I == Letter
I = Boolean
True
	Letter
J == Letter
J = Boolean
True
	Letter
K == Letter
K = Boolean
True
	Letter
L == Letter
L = Boolean
True
	Letter
M == Letter
M = Boolean
True
	Letter
N == Letter
N = Boolean
True
	Letter
O == Letter
O = Boolean
True
	Letter
P == Letter
P = Boolean
True
	Letter
Q == Letter
Q = Boolean
True
	Letter
R == Letter
R = Boolean
True
	Letter
S == Letter
S = Boolean
True
	Letter
T == Letter
T = Boolean
True
	Letter
U == Letter
U = Boolean
True
	Letter
V == Letter
V = Boolean
True
	Letter
W == Letter
W = Boolean
True
	Letter
X == Letter
X = Boolean
True
	Letter
Y == Letter
Y = Boolean
True
	Letter
Z == Letter
Z = Boolean
True
	Letter
_ == Letter
_ = Boolean
False

data Case = Upper | Lower

instance Setoid Case where
	Case
Upper == :: Case -> Case -> Boolean
== Case
Upper = Boolean
True
	Case
Lower == Case
Lower = Boolean
True
	Case
_ == Case
_ = Boolean
False

data Number = N0 | N1 | N2 | N3 | N4 | N5 | N6 | N7 | N8 | N9

instance Setoid Number where
	Number
N0 == :: Number -> Number -> Boolean
== Number
N0 = Boolean
True
	Number
N1 == Number
N1 = Boolean
True
	Number
N2 == Number
N2 = Boolean
True
	Number
N3 == Number
N3 = Boolean
True
	Number
N4 == Number
N4 = Boolean
True
	Number
N5 == Number
N5 = Boolean
True
	Number
N6 == Number
N6 = Boolean
True
	Number
N7 == Number
N7 = Boolean
True
	Number
N8 == Number
N8 = Boolean
True
	Number
N9 == Number
N9 = Boolean
True
	Number
_ == Number
_ = Boolean
False