src/Codec/Binary/UTF8/Width.hs · vty

on da635bb help sign in

39 lines 1.1 kB history raw

2{-# OPTIONS_GHC -D_XOPEN_SOURCE -fno-cse #-}

3{-# LANGUAGE ForeignFunctionInterface, BangPatterns #-}

4module Codec.Binary.UTF8.Width ( wcwidth

5 , wcswidth

6 )

7 where

9import Foreign.C.Types

10import Foreign.C.String

11import Foreign.Storable

12import Foreign.Ptr

14-- import Numeric ( showHex )

16import System.IO.Unsafe

18wcwidth :: Char -> Int

19wcwidth c = unsafePerformIO (withCWString [c] $! \ws -> do

20 wc <- peek ws

21 -- putStr $ "wcwidth(0x" ++ showHex (fromEnum wc) "" ++ ")"

22 let !w = fromIntegral $! wcwidth' wc

23 -- putStrLn $ " -> " ++ show w

24 return w

25 )

26{-# NOINLINE wcwidth #-}

28foreign import ccall unsafe "mk_wcwidth" wcwidth' :: CWchar -> CInt

30wcswidth :: String -> Int

31wcswidth str = unsafePerformIO (withCWStringLen str $! \(ws, ws_len) -> do

32 -- putStr $ "wcswidth(...)"

33 let !w = fromIntegral $! wcswidth' ws (fromIntegral ws_len)

34 -- putStrLn $ " -> " ++ show w

35 return w

36 )

37{-# NOINLINE wcswidth #-}

39foreign import ccall unsafe "mk_wcswidth" wcswidth' :: Ptr CWchar -> CSize -> CInt