module System.Console.Haskeline.Backend.WCWidth(
gsWidth,
splitAtWidth,
takeWidth,
) where
import System.Console.Haskeline.LineState
import Data.List
import Foreign.C.Types
foreign import ccall unsafe haskeline_mk_wcwidth :: CWchar -> CInt
wcwidth :: Char -> Int
wcwidth c = case haskeline_mk_wcwidth $ toEnum $ fromEnum c of
-1 -> 0
w -> fromIntegral w
gWidth :: Grapheme -> Int
gWidth g = wcwidth (baseChar g)
gsWidth :: [Grapheme] -> Int
gsWidth = foldl' (+) 0 . map gWidth
splitAtWidth :: Int -> [Grapheme] -> ([Grapheme],[Grapheme],Int)
splitAtWidth n xs = case splitAtWidth' n xs of
(this,rest,remaining) -> (this,rest,n-remaining)
splitAtWidth' :: Int -> [Grapheme] -> ([Grapheme],[Grapheme],Int)
splitAtWidth' w [] = ([],[],w)
splitAtWidth' w (g:gs)
| gw > w = ([],g:gs,w)
| otherwise = (g:gs',gs'',r)
where
gw = gWidth g
(gs',gs'',r) = splitAtWidth' (w-gw) gs
takeWidth :: Int -> [Grapheme] -> ([Grapheme],Int)
takeWidth n gs = case splitAtWidth n gs of
(gs',_,len) -> (gs',len)