summaryrefslogtreecommitdiff
path: root/libraries/base/tests/unicode002.hs
blob: f7b9187971d0dd18311ed3d1333f5c85f7803ab4 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
module Main where


import Data.Char
import Numeric

header = "Code C P S U L A D"

preds = [
  isControl,
  isPrint,
  isSpace,
  isUpper,
  isLower,
  isAlpha,
  isDigit]

prtBool :: Bool -> String

prtBool True  = "T "
prtBool False = "F "

showCode :: Char -> Int -> String

showCode c w = code ++ pad
  where
    code = show (ord c)
    l = length code
    spaces = map anytospace [1..]
    anytospace _ = ' '
    pad  | l >= w = ""
         | otherwise = take (w - l) spaces

charCode :: Char -> String

rapply a b = b a

charCode c = (showCode c 5) ++ (foldr1 (++) $ map prtBool $ map (rapply c) preds)

main = do
    putStrLn header
    mapM (putStrLn . charCode) [ (chr 0) .. (chr 6553) ]