summaryrefslogtreecommitdiffstats
path: root/src/Blessings
diff options
context:
space:
mode:
Diffstat (limited to 'src/Blessings')
-rw-r--r--src/Blessings/ByteString.hs1
-rw-r--r--src/Blessings/ByteString/Lazy.hs1
-rw-r--r--src/Blessings/Internal.hs1
-rw-r--r--src/Blessings/String.hs1
-rw-r--r--src/Blessings/String/WCWidth.hs64
-rw-r--r--src/Blessings/Text.hs1
-rw-r--r--src/Blessings/Text/WCWidth.hs64
7 files changed, 133 insertions, 0 deletions
diff --git a/src/Blessings/ByteString.hs b/src/Blessings/ByteString.hs
index d914818..42139fa 100644
--- a/src/Blessings/ByteString.hs
+++ b/src/Blessings/ByteString.hs
@@ -13,5 +13,6 @@ instance Blessable B.ByteString where
length = B.length
drop = B.drop
take = B.take
+ splitAt = B.splitAt
intercalate = B.intercalate
fromWord8 = B.pack . show
diff --git a/src/Blessings/ByteString/Lazy.hs b/src/Blessings/ByteString/Lazy.hs
index a32f29b..c0f521c 100644
--- a/src/Blessings/ByteString/Lazy.hs
+++ b/src/Blessings/ByteString/Lazy.hs
@@ -13,5 +13,6 @@ instance Blessable L.ByteString where
length = fromIntegral . L.length
drop = L.drop . fromIntegral
take = L.take . fromIntegral
+ splitAt = L.splitAt . fromIntegral
intercalate = L.intercalate
fromWord8 = L.pack . show
diff --git a/src/Blessings/Internal.hs b/src/Blessings/Internal.hs
index 0ed5556..38c9069 100644
--- a/src/Blessings/Internal.hs
+++ b/src/Blessings/Internal.hs
@@ -8,5 +8,6 @@ class (IsString a, Monoid a) => Blessable a where
length :: a -> Int
drop :: Int -> a -> a
take :: Int -> a -> a
+ splitAt :: Int -> a -> (a, a)
intercalate :: a -> [a] -> a
fromWord8 :: Word8 -> a
diff --git a/src/Blessings/String.hs b/src/Blessings/String.hs
index 005cd7b..bc3d8cc 100644
--- a/src/Blessings/String.hs
+++ b/src/Blessings/String.hs
@@ -14,5 +14,6 @@ instance Blessable String where
length = L.length
drop = L.drop
take = L.take
+ splitAt = L.splitAt
intercalate = L.intercalate
fromWord8 = show
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
diff --git a/src/Blessings/Text.hs b/src/Blessings/Text.hs
index 1f82c22..236b5d0 100644
--- a/src/Blessings/Text.hs
+++ b/src/Blessings/Text.hs
@@ -14,5 +14,6 @@ instance Blessable Text where
length = T.length
drop = T.drop
take = T.take
+ splitAt = T.splitAt
intercalate = T.intercalate
fromWord8 = T.pack . show
diff --git a/src/Blessings/Text/WCWidth.hs b/src/Blessings/Text/WCWidth.hs
new file mode 100644
index 0000000..277e1a1
--- /dev/null
+++ b/src/Blessings/Text/WCWidth.hs
@@ -0,0 +1,64 @@
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE MultiWayIf #-}
+{-# LANGUAGE PatternGuards #-}
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+module Blessings.Text.WCWidth
+ ( module Blessings
+ ) where
+
+import Blessings
+import Blessings.Internal
+import Data.Char.WCWidth qualified as WCWidth
+import Data.Text (Text)
+import Data.Text qualified as Text
+
+
+instance Blessable Text where
+ length = length'
+ drop = drop'
+ take = take'
+ splitAt = splitAt'
+ intercalate = Text.intercalate
+ fromWord8 = Text.pack . show
+
+
+length' :: Text -> Int
+length' = Text.foldr ((+) . wcwidth') 0
+
+drop' :: Int -> Text -> Text
+drop' k t =
+ if k <= 0
+ then t
+ else
+ case Text.uncons t of
+ Just (c, t') ->
+ drop' (k - wcwidth' c) t'
+ Nothing -> mempty
+
+take' :: Int -> Text -> Text
+take' k0 =
+ Text.pack . rec k0
+ where
+ rec k t =
+ if | Just (c, t') <- Text.uncons t, nc <- wcwidth' c, nc <= k ->
+ c : rec (k - nc) t'
+
+ | otherwise ->
+ []
+
+splitAt' :: Int -> Text -> (Text, Text)
+splitAt' k0 =
+ rec k0 mempty
+ where
+ rec k a t =
+ if | Just (c, t') <- Text.uncons t, nc <- wcwidth' c, nc <= k ->
+ rec (k - nc) (c : a) t'
+
+ | otherwise ->
+ (Text.pack $ 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