1 files changed, 64 insertions, 0 deletions
diff --git a/src/Blessings/String/WCWidth.hs b/src/Blessings/String/WCWidth.hs
new file mode 100644
index 0000000..2160f99
--- /dev/null
+++ b/src/Blessings/String/WCWidth.hs
@@ -0,0 +1,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