diff options
Diffstat (limited to 'src/Blessings/Text/WCWidth.hs')
-rw-r--r-- | src/Blessings/Text/WCWidth.hs | 64 |
1 files changed, 64 insertions, 0 deletions
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 |