-- | UTF8 text helpers
module Network.IPFS.Internal.UTF8
  ( Textable (..)
  , stripN
  , textToLazyBS
  , textShow
  ) where

import           RIO
import qualified RIO.ByteString.Lazy as Lazy
import qualified RIO.Text            as Text

class Textable a where
  encode :: a -> Either UnicodeException Text

instance Textable ByteString where
  encode :: ByteString -> Either UnicodeException Text
encode = ByteString -> Either UnicodeException Text
decodeUtf8'

instance Textable Lazy.ByteString where
  encode :: ByteString -> Either UnicodeException Text
encode = forall a. Textable a => a -> Either UnicodeException Text
encode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
Lazy.toStrict

textToLazyBS :: Text -> Lazy.ByteString
textToLazyBS :: Text -> ByteString
textToLazyBS = ByteString -> ByteString
Lazy.fromStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
Text.encodeUtf8

textShow :: Show a => a -> Text
textShow :: forall a. Show a => a -> Text
textShow = forall a. Display a => a -> Text
textDisplay forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> Utf8Builder
displayShow

stripN :: Natural -> Text -> Text
stripN :: Natural -> Text -> Text
stripN Natural
n = Int -> Text -> Text
Text.dropEnd Int
i forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Text -> Text
Text.drop Int
i
  where
    i :: Int
    i :: Int
i = forall a b. (Integral a, Num b) => a -> b
fromIntegral Natural
n