summaryrefslogtreecommitdiffstats
path: root/src/Blessings/String/WCWidth.hs
blob: 2160f99a6122bc2b0a134727cdd64a59d49c6136 (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
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ImportQualifiedPost #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE PatternGuards #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Blessings.String.WCWidth
    ( module Blessings
    ) where

import Blessings
import Blessings.Internal
import Data.Char.WCWidth qualified as WCWidth
import Data.List qualified as List


instance Blessable String where
  length      = length'
  drop        = drop'
  take        = take'
  splitAt     = splitAt'
  intercalate = List.intercalate
  fromWord8   = show


length' :: String -> Int
length' = foldr ((+) . wcwidth') 0

drop' :: Int -> String -> String
drop' k t =
    if k <= 0
      then t
      else
        case t of
          c : t' ->
            drop' (k - wcwidth' c) t'
          [] -> mempty

take' :: Int -> String -> String
take' k0 =
    rec k0
  where
    rec k t =
      if | (c : t') <- t, nc <- wcwidth' c, nc <= k ->
            c : rec (k - nc) t'

         | otherwise ->
            []

splitAt' :: Int -> String -> (String, String)
splitAt' k0 =
    rec k0 []
  where
    rec k a t =
      if | (c : t') <- t, nc <- wcwidth' c, nc <= k ->
            rec (k - nc) (c : a) t'

         | otherwise ->
            (reverse a, t)

-- TODO this breaks when WCWidth.wcwidth returns -1, which happens for
-- non-printable characters like '\n'.
-- Following wcwidth' isn't entirely correct because WCWidth.wcwidth '\0' == 0
wcwidth' :: Char -> Int
wcwidth' = max 1 . WCWidth.wcwidth