shithub: MicroHs

ref: d65bc804563c41d1be4a6620ccde395555cb6da9
dir: /lib/Data/Char.hs/

-- Copyright 2023 Lennart Augustsson
-- See LICENSE file for full license.
module Data.Char(
  module Data.Char,
  module Data.Char_Type   -- exports Char and String
  ) where
import Primitives
import Data.Bool
import Data.Char_Type
import Data.Eq
import Data.Function
import Data.Int
import Data.List_Type
import Data.Num
import Data.Ord
import Text.Show

instance Eq Char where
  (==) = primCharEQ
  (/=) = primCharNE

instance Ord Char where
  (<)  = primCharLT
  (<=) = primCharLE
  (>)  = primCharGT
  (>=) = primCharGE

instance Eq String where
  (==) = primStringEQ

instance Ord String where
  compare = primCompare
  x <  y  =  primCompare x y == LT
  x <= y  =  primCompare x y /= GT
  x >  y  =  primCompare x y == GT
  x >=  y =  primCompare x y /= GT

chr :: Int -> Char
chr = primChr

ord :: Char -> Int
ord = primOrd

isLower :: Char -> Bool
isLower c = (primCharLE 'a' c) && (primCharLE c 'z')

isUpper :: Char -> Bool
isUpper c = (primCharLE 'A' c) && (primCharLE c 'Z')

isAlpha :: Char -> Bool
isAlpha c = isLower c || isUpper c

isDigit :: Char -> Bool
isDigit c = (primCharLE '0' c) && (primCharLE c '9')

isAlphaNum :: Char -> Bool
isAlphaNum c = isAlpha c || isDigit c

isPrint :: Char -> Bool
isPrint c = primCharLE ' ' c && primCharLE c '~'

{-
eqChar :: Char -> Char -> Bool
eqChar = primCharEQ

neChar :: Char -> Char -> Bool
neChar = primCharNE

leChar :: Char -> Char -> Bool
leChar = primCharLE

ltChar :: Char -> Char -> Bool
ltChar = primCharLT
-}

isSpace :: Char -> Bool
isSpace c = c == ' ' || c == '\t' || c == '\n'

toLower :: Char -> Char
toLower c | primCharLE 'A' c && primCharLE c 'Z' = chr (ord c - ord 'A' + ord 'a')
          | True = c

toUpper :: Char -> Char
toUpper c | primCharLE 'a' c && primCharLE c 'a' = chr (ord c - ord 'a' + ord 'A')
          | True = c

instance Show Char where
  showsPrec _ '\'' = showString "'\\''"
  showsPrec _ c = showChar '\'' . showString (encodeChar c) . showChar '\''
  showList    s = showChar '"'  . f s
    where f [] = showChar '"'
          f (c:cs) =
            if c == '"' then showString "\\\"" . f cs
            else showString (encodeChar c) . f cs

-- XXX should not export this
encodeChar :: Char -> String
encodeChar c =
  let
    spec = [('\n', "\\n"), ('\r', "\\r"), ('\t', "\\t"), ('\b', "\\b"),
            ('\\', "\\\\")]
    look [] = if isPrint c then [c] else "'\\" ++ show (ord c) ++ "'"
    look ((d,s):xs) = if d == c then s else look xs
  in look spec