{-# LANGUAGE ForeignFunctionInterface
  #-}


{-| A binding for the native 'wcwidth'. It's important that you 'setLocale'
    before using it, like this:

 >  #!/usr/bin/env runhaskell
 >
 >  import Text.Printf
 >  
 >  import System.Locale.SetLocale
 >  import Data.Char.WCWidth
 >
 >  main                     =  do
 >    setLocale LC_ALL (Just "")
 >    sequence_ [ display c | c <- chars ]
 >   where
 >    chars                  =  [minBound..'A']
 >    display c = printf "%04x  %2d  %s\n" (fromEnum c) (wcwidth c) (show c)

    The program file @WCWidthTableaux.hs@ contains a more extensive example of
    using 'wcwidth'.

    Note that this binding to the native implementation gets certain
    characters wrong in obvious ways as well as ways that are problematic for
    indentation based languages. The ASCII tab should be assigned a width of
    8, not -1; and one is likely to find -1 assigned to  numerous obscure
    characters (for example, symbols from the Book of Changes).

 -}


module Data.Char.WCWidth
  ( wcwidth
  , widths
  , ranges
  ) where

import Foreign.C
import Data.List




{-| Widths of all characters. 
 -}
widths                      ::  [ (Char, Int) ]
widths :: [(Char, Int)]
widths                       =  [ (Char
c, Char -> Int
wcwidth Char
c) | Char
c <- [Char
forall a. Bounded a => a
minBound..Char
forall a. Bounded a => a
maxBound] ] 


{-| Characters broken into contiguous ranges with the same width.
 -}
ranges                      ::  [ ((Char, Char), Int) ]
ranges :: [((Char, Char), Int)]
ranges                       =  [((Char, Char), Int)] -> [((Char, Char), Int)]
forall a. [a] -> [a]
reverse (([((Char, Char), Int)] -> (Char, Int) -> [((Char, Char), Int)])
-> [((Char, Char), Int)] -> [(Char, Int)] -> [((Char, Char), Int)]
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' [((Char, Char), Int)] -> (Char, Int) -> [((Char, Char), Int)]
forall b b. Eq b => [((b, b), b)] -> (b, b) -> [((b, b), b)]
aggregate [((Char, Char), Int)]
start ([(Char, Int)] -> [(Char, Int)]
forall a. [a] -> [a]
tail [(Char, Int)]
widths))
 where
  start :: [((Char, Char), Int)]
start                      =  [((Char, Char), Int)] -> (Char, Int) -> [((Char, Char), Int)]
forall b b. Eq b => [((b, b), b)] -> (b, b) -> [((b, b), b)]
aggregate [] ([(Char, Int)] -> (Char, Int)
forall a. [a] -> a
head [(Char, Int)]
widths)
  aggregate :: [((b, b), b)] -> (b, b) -> [((b, b), b)]
aggregate [] (b
c, b
w)        =  [((b
c, b
c), b
w)]
  aggregate (((b
a, b
z), b
i) : [((b, b), b)]
t) (b
c, b
w)
    | b
i b -> b -> Bool
forall a. Eq a => a -> a -> Bool
== b
w                 =  ((b
a, b
c), b
i) ((b, b), b) -> [((b, b), b)] -> [((b, b), b)]
forall a. a -> [a] -> [a]
: [((b, b), b)]
t
    | Bool
otherwise              =  ((b
c, b
c), b
w) ((b, b), b) -> [((b, b), b)] -> [((b, b), b)]
forall a. a -> [a] -> [a]
: ((b
a, b
z), b
i) ((b, b), b) -> [((b, b), b)] -> [((b, b), b)]
forall a. a -> [a] -> [a]
: [((b, b), b)]
t


{-| Binding to the native 'wcwidth'. 
 -}
wcwidth                     ::  Char -> Int
wcwidth :: Char -> Int
wcwidth                      =  CInt -> Int
forall a. Enum a => a -> Int
fromEnum (CInt -> Int) -> (Char -> CInt) -> Char -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CWchar -> CInt
native (CWchar -> CInt) -> (Char -> CWchar) -> Char -> CInt
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> CWchar
forall a. Enum a => Int -> a
toEnum (Int -> CWchar) -> (Char -> Int) -> Char -> CWchar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
forall a. Enum a => a -> Int
fromEnum


foreign import ccall unsafe "wchar.h wcwidth" native :: CWchar -> CInt