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"