diff options
Diffstat (limited to 'src/Blessings')
-rw-r--r-- | src/Blessings/ByteString.hs | 1 | ||||
-rw-r--r-- | src/Blessings/ByteString/Lazy.hs | 1 | ||||
-rw-r--r-- | src/Blessings/Internal.hs | 1 | ||||
-rw-r--r-- | src/Blessings/String.hs | 1 | ||||
-rw-r--r-- | src/Blessings/String/WCWidth.hs | 64 | ||||
-rw-r--r-- | src/Blessings/Text.hs | 1 | ||||
-rw-r--r-- | src/Blessings/Text/WCWidth.hs | 64 |
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 |