module Funcons.Operations.Characters where

import Funcons.Operations.Booleans (tobool)
import Funcons.Operations.Internal

import Data.Char (ord,chr)

library :: (HasValues t, Ord t) => Library t
library = libFromList [
    ("ascii-characters", NullaryExpr ascii_characters)
  , ("ascii-character", UnaryExpr ascii_character)
  , ("unicode", UnaryExpr unicode)
  , ("unicode-character-code", UnaryExpr unicode_character_code)
  , ("characters", NullaryExpr characters)
  ]

characters_ :: HasValues t => [OpExpr t] -> OpExpr t
characters_ = nullaryOp characters
characters :: HasValues t => OpExpr t
characters = vNullaryOp "characters" (Normal $ injectT $ Characters)

ascii_characters_ :: HasValues t => [OpExpr t] -> OpExpr t
ascii_characters_ = nullaryOp ascii_characters
ascii_characters :: HasValues t => OpExpr t
ascii_characters = vNullaryOp "ascii-characters" (Normal $ injectT $ AsciiCharacters)

ascii_character_ :: HasValues t => [OpExpr t] -> OpExpr t
ascii_character_ = unaryOp ascii_character
ascii_character :: HasValues t => OpExpr t -> OpExpr t
ascii_character = vUnaryOp "ascii-character" op
  where op v | isString_ v, s <- unString v, length s == 1
                = Normal $ inject $ Ascii $ head s
             | otherwise = SortErr "ascii-character not applied to a string (of 1 ascii character long)"

unicode_ :: HasValues t => [OpExpr t] -> OpExpr t
unicode_ = unaryOp unicode
unicode :: HasValues t => OpExpr t -> OpExpr t
unicode = vUnaryOp "unicode" op
  where op v | Int i <- upcastIntegers v, i < numUnicodeCodes =
                Normal $ inject $ mk_unicode_characters (chr $ fromInteger i)
             | otherwise = SortErr "unicode not applied to an integer in the range 0..(2^32)-1"

numUnicodeCodes :: Integer
numUnicodeCodes = (2^32)-1

unicode_character_code_ :: HasValues t => [OpExpr t] -> OpExpr t
unicode_character_code_ = unaryOp unicode_character_code
unicode_character_code :: HasValues t => OpExpr t -> OpExpr t
unicode_character_code = vUnaryOp "unicode-character-code" op
  where op v | Char c <- upcastUnicode v =
                  Normal $ inject $ mk_integers (toInteger $ ord c)
             | otherwise = SortErr "unicode-character-code not applied to a unicode-character"