module Funcons.Operations.Characters where

import Funcons.Operations.Internal

import Data.Char (ord,chr,isAscii)

library :: (HasValues t, Ord t) => Library t
library :: Library t
library = [(OP, ValueOp t)] -> Library t
forall t. [(OP, ValueOp t)] -> Library t
libFromList [
    (OP
"ascii-characters", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
ascii_characters)
  , (OP
"ascii-character", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
ascii_character)
  , (OP
"unicode-character", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
unicode_character)
  , (OP
"unicode-point", UnaryExpr t -> ValueOp t
forall t. UnaryExpr t -> ValueOp t
UnaryExpr UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
unicode_point)
  , (OP
"characters", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
characters)
  , (OP
"unicode-characters", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
unicode_characters)
  , (OP
"iso-latin-1-characters", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
iso_latin_characters)
  , (OP
"latin-1-chars", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
iso_latin_characters)
  , (OP
"basic-plane-multilingual-characters", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
bmp_characters)
  , (OP
"bmp-chars", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
bmp_characters)
  , (OP
"unicode-chars", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
unicode_characters)
  , (OP
"unicode-points", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
unicode_points)
  , (OP
"basic-multilingual-plane-points", NullaryExpr t -> ValueOp t
forall t. NullaryExpr t -> ValueOp t
NullaryExpr NullaryExpr t
forall t. HasValues t => OpExpr t
bmp_points)
  ]

characters_ :: HasValues t => [OpExpr t] -> OpExpr t
characters_ :: [OpExpr t] -> OpExpr t
characters_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
characters
characters :: HasValues t => OpExpr t
characters :: OpExpr t
characters = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"characters" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Types t
forall t. Types t
Characters)

unicode_characters_ :: HasValues t => [OpExpr t] -> OpExpr t
unicode_characters_ :: [OpExpr t] -> OpExpr t
unicode_characters_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
unicode_characters
unicode_characters :: HasValues t => OpExpr t
unicode_characters :: OpExpr t
unicode_characters = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"unicode-characters" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Types t
forall t. Types t
UnicodeCharacters)

unicode_points_ :: HasValues t => [OpExpr t] -> OpExpr t
unicode_points_ :: [OpExpr t] -> OpExpr t
unicode_points_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
unicode_points
unicode_points :: HasValues t => OpExpr t
unicode_points :: OpExpr t
unicode_points = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"unicode-points" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> Types t -> Types t
forall t. Types t -> Types t -> Types t
Intersection (Integer -> Types t
forall t. Integer -> Types t
IntegersFrom Integer
0) (Integer -> Types t
forall t. Integer -> Types t
IntegersUpTo Integer
numUnicodeCodes)))

bmp_points_ :: HasValues t => [OpExpr t] -> OpExpr t
bmp_points_ :: [OpExpr t] -> OpExpr t
bmp_points_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
bmp_points
bmp_points :: HasValues t => OpExpr t
bmp_points :: OpExpr t
bmp_points = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"basic-multilingual-plane-points" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> Types t -> Types t
forall t. Types t -> Types t -> Types t
Intersection (Integer -> Types t
forall t. Integer -> Types t
IntegersFrom Integer
0) (Integer -> Types t
forall t. Integer -> Types t
IntegersUpTo Integer
numBMPCodes)))

ascii_characters_ :: HasValues t => [OpExpr t] -> OpExpr t
ascii_characters_ :: [OpExpr t] -> OpExpr t
ascii_characters_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
ascii_characters
ascii_characters :: HasValues t => OpExpr t
ascii_characters :: OpExpr t
ascii_characters = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"ascii-characters" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Types t
forall t. Types t
AsciiCharacters)

iso_latin_characters_ :: HasValues t => [OpExpr t] -> OpExpr t
iso_latin_characters_ :: [OpExpr t] -> OpExpr t
iso_latin_characters_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
iso_latin_characters
iso_latin_characters :: HasValues t => OpExpr t
iso_latin_characters :: OpExpr t
iso_latin_characters = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"iso-latin-1-characters" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Types t
forall t. Types t
ISOLatinCharacters)

bmp_characters_ :: HasValues t => [OpExpr t] -> OpExpr t
bmp_characters_ :: [OpExpr t] -> OpExpr t
bmp_characters_ = OpExpr t -> [OpExpr t] -> OpExpr t
forall t. NullaryExpr t -> [NullaryExpr t] -> NullaryExpr t
nullaryOp OpExpr t
forall t. HasValues t => OpExpr t
bmp_characters 
bmp_characters :: HasValues t => OpExpr t
bmp_characters :: OpExpr t
bmp_characters = OP -> NullaryVOp t -> OpExpr t
forall t. OP -> NullaryVOp t -> OpExpr t
vNullaryOp OP
"basic-multilingual-plane-characters" (t -> NullaryVOp t
forall t. t -> Result t
Normal (t -> NullaryVOp t) -> t -> NullaryVOp t
forall a b. (a -> b) -> a -> b
$ Types t -> t
forall t. HasTypes t => Types t -> t
injectT (Types t -> t) -> Types t -> t
forall a b. (a -> b) -> a -> b
$ Types t
forall t. Types t
BMPCharacters)

ascii_character_ :: HasValues t => [OpExpr t] -> OpExpr t
ascii_character_ :: [OpExpr t] -> OpExpr t
ascii_character_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
ascii_character 
ascii_character :: HasValues t => OpExpr t -> OpExpr t
ascii_character :: OpExpr t -> OpExpr t
ascii_character = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"ascii-character" UnaryVOp t
forall t t. (HasValues t, HasValues t) => Values t -> Result t
op
  where op :: Values t -> Result t
op Values t
v | Values t -> Bool
forall t. HasValues t => Values t -> Bool
isString_ Values t
v, [Char
c] <- Values t -> OP
forall t. HasValues t => Values t -> OP
unString Values t
v, Char -> Bool
isAscii Char
c
                = t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ Char -> Values t
forall t. HasValues t => Char -> Values t
downcast_unicode_characters Char
c
             | Bool
otherwise = OP -> Result t
forall t. OP -> Result t
SortErr OP
"ascii-character not applied to a string (of 1 ascii character long)"

unicode_character_ :: HasValues t => [OpExpr t] -> OpExpr t
unicode_character_ :: [OpExpr t] -> OpExpr t
unicode_character_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
unicode_character
unicode_character :: HasValues t => OpExpr t -> OpExpr t
unicode_character :: OpExpr t -> OpExpr t
unicode_character = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"unicode-character" UnaryVOp t
forall t t. HasValues t => Values t -> Result t
op
  where op :: Values t -> Result t
op Values t
v | Int Integer
i <- Values t -> Values t
forall t. Values t -> Values t
upcastIntegers Values t
v, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
numUnicodeCodes, Integer
i Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
>= Integer
0 = 
                t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ Char -> Values t
forall t. HasValues t => Char -> Values t
mk_unicode_characters (Int -> Char
chr (Int -> Char) -> Int -> Char
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
i)
             | Bool
otherwise = OP -> Result t
forall t. OP -> Result t
SortErr OP
"unicode-character not applied to an integer in the right range"

numUnicodeCodes,numBMPCodes :: Integer
numUnicodeCodes :: Integer
numUnicodeCodes = (Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
21)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1
numBMPCodes :: Integer
numBMPCodes = (Integer
2Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
17)Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
-Integer
1


unicode_point_ :: HasValues t => [OpExpr t] -> OpExpr t
unicode_point_ :: [OpExpr t] -> OpExpr t
unicode_point_ = UnaryExpr t -> [OpExpr t] -> OpExpr t
forall t. UnaryExpr t -> [OpExpr t] -> OpExpr t
unaryOp UnaryExpr t
forall t. HasValues t => OpExpr t -> OpExpr t
unicode_point 
unicode_point :: HasValues t => OpExpr t -> OpExpr t
unicode_point :: OpExpr t -> OpExpr t
unicode_point = OP -> UnaryVOp t -> OpExpr t -> OpExpr t
forall t. HasValues t => OP -> UnaryVOp t -> OpExpr t -> OpExpr t
vUnaryOp OP
"unicode-point" UnaryVOp t
forall t t. (HasValues t, HasValues t) => Values t -> Result t
op
  where op :: Values t -> Result t
op Values t
v | Just Char
c <- Values t -> Maybe Char
forall t. HasValues t => Values t -> Maybe Char
upcastCharacter Values t
v = 
                  t -> Result t
forall t. t -> Result t
Normal (t -> Result t) -> t -> Result t
forall a b. (a -> b) -> a -> b
$ Values t -> t
forall t. HasValues t => Values t -> t
inject (Values t -> t) -> Values t -> t
forall a b. (a -> b) -> a -> b
$ Integer -> Values t
forall t. Integer -> Values t
mk_integers (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c)
             | Bool
otherwise = OP -> Result t
forall t. OP -> Result t
SortErr OP
"unicode-point not applied to a unicode-character"