--------------------------------------------------------------------
--
-- Module      :  Strings
-- Copyright   :
--
-- | a module with a class for strings, such that the normal functions are
--  all polymorphic for string and text (and total)
-- the string (i.e. [Char]) functions are the semantic definitions,
-- the other implementation are tested against these.
-- except intercalate, which returns Maybe
-- (the corresponding restrictions for the unlines and unwords functions are not enforced)
--
-- performance can be improved by using the "native" functions
-- could be expanded

-- class niceStrings can be replaced or integrated in the generic strings
-- it may be useful to have more than one show like operation
----------------------------------------------------------------------
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE OverloadedStrings  #-}
{-# LANGUAGE UndecidableInstances  #-}
{-# LANGUAGE PackageImports  #-}

{-# OPTIONS_GHC -fno-warn-missing-methods #-}
{-# OPTIONS_GHC -w #-}

module Uniform.Strings.Utilities
    (module Uniform.Zero
    , module Uniform.ListForm
    , CharChains (..)
    , CharChains2 (..)
    , NiceStrings (..)
    , unlinesT, unwordsT
    , wordsT,  concatT, showT, readNoteT, readNoteTs
    , sortCaseInsensitive, cmpCaseInsensitive
    , maybe2string
    , showList'
    , putIOwords, debugPrint 
    , T.toTitle
    , toLowerStart, toUpperStart   
    , prop_filterChar
    , isSpace, isLower
    , PrettyStrings (..)
    -- to generalize
    , dropWhile, takeWhile, span, break
    , formatInt
    , showAsLines
    )
    where

import Uniform.Zero (Zeros(..))
import Uniform.ListForm ( ListForms(..) )


import           Data.Char                (isSpace, isLower, toLower, toUpper)
import           Text.Printf              (PrintfArg, PrintfType, printf)

import Data.List as L
    ( sortBy, intercalate, isInfixOf, isPrefixOf, nub, stripPrefix, intersperse )
import           GHC.Exts                 (IsString (..))

import qualified Data.List.Split         as S (splitOn)
import Data.Maybe ( catMaybes )
-- import           Data.Monoid
import           Data.Text                (Text)
import qualified Data.Text                as T (head, cons, tail, append, singleton, unwords, words, unlines, lines, empty, toUpper, toLower, concat, isPrefixOf, isInfixOf, stripPrefix, stripSuffix, intercalate, splitOn, strip, dropEnd, reverse, length, filter, take, drop, replace, null, toTitle)
import qualified Data.List.Utils       as LU (replace)
import Safe ( readNote )
import Uniform.Strings.Conversion
    ( Text,
      BSUTF,
      LazyByteString,
      s2t,
      t2s,
      t2bu,
      bu2t,
      bu2s,
      t2b,
      s2bu,
      b2bl )
import qualified Data.ByteString.Lazy as Lazy (append, length, take, drop)
import          Text.Read (readMaybe)
import Text.Show.Pretty ( ppShow ) 
import "monads-tf" Control.Monad.State      (MonadIO, liftIO)
import Control.Monad (when)
import Data.ByteString (intersperse)


readNoteTs :: (Show a, Read a) =>  [Text] -> Text -> a   -- TODO
-- ^ read a Text into a specific format
readNoteTs :: forall a. (Show a, Read a) => [Text] -> Text -> a
readNoteTs [Text]
msg Text
a = forall a. (HasCallStack, Read a) => String -> String -> a
readNote  ([String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
t2s [Text]
msg) forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
a

readNoteT :: Read a =>  Text -> Text -> a   -- TODO
-- ^ read a Text into a specific format
readNoteT :: forall a. Read a => Text -> Text -> a
readNoteT Text
msg = forall a. (HasCallStack, Read a) => String -> String -> a
readNote (Text -> String
t2s Text
msg) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s

showList' :: Show a =>  [a] -> Text
-- ^ show a collection of lines
showList' :: forall a. Show a => [a] -> Text
showList' = forall a. CharChains a => [a] -> a
unlines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> Text
showT

toLowerStart :: Text -> Text
-- ^ convert the first character to lowercase - for Properties in RDF
toLowerStart :: Text -> Text
toLowerStart Text
t = (Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head forall a b. (a -> b) -> a -> b
$ Text
t) Char -> Text -> Text
`T.cons` Text -> Text
T.tail Text
t

toUpperStart :: Text -> Text
-- ^ convert the first character to Uppercase - for  PosTags in Spanish
toUpperStart :: Text -> Text
toUpperStart Text
t = (Char -> Char
toUpper forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Char
T.head forall a b. (a -> b) -> a -> b
$ Text
t) Char -> Text -> Text
`T.cons` Text -> Text
T.tail Text
t

dropLast :: Int -> [a] -> [a]
dropLast :: forall a. Int -> [a] -> [a]
dropLast Int
n = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
drop Int
n forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

putIOwords :: MonadIO m =>  [Text] -> m ()
putIOwords :: forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> IO ()
putStrLn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unwords'

debugPrint :: (MonadIO m) => Bool -> [Text] -> m ()
-- ^ print the texts when the bool is true (flag debug)
debugPrint :: forall (m :: * -> *). MonadIO m => Bool -> [Text] -> m ()
debugPrint Bool
flag [Text]
texts = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
flag forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadIO m => [Text] -> m ()
putIOwords [Text]
texts 


--instance Zeros String where zero = (""::String)
instance Zeros Text where zero :: Text
zero = Text
"" :: Text

instance ListForms Text where
    type LF Text = Char
    appendTwo :: Text -> Text -> Text
appendTwo = Text -> Text -> Text
T.append
    mkOne :: LF Text -> Text
mkOne = Char -> Text
T.singleton

instance ListForms String where
    type LF String = Char
    appendTwo :: String -> String -> String
appendTwo = forall a. [a] -> [a] -> [a]
(++)
    mkOne :: LF String -> String
mkOne = forall a. Show a => a -> String
show

instance ListForms LazyByteString where
    type LF LazyByteString = Char
--    appendTwo = Lazy.append
    mkOne :: LF LazyByteString -> LazyByteString
mkOne = ByteString -> LazyByteString
b2bl forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
t2b forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

instance ListForms BSUTF where
    type LF BSUTF = Char
--    appendTwo a b =  t2bu . appendTwo  (bu2t a) $ bu2t b
    mkOne :: LF BSUTF -> BSUTF
mkOne =  Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Text
T.singleton

--instance Zeros BSUTF where   -- derived in Conversion
--    zero = t2bu ""

class (Zeros a, ListForms a, Eq a) => CharChains a where
--    {-# MINIMAL   #-}

    toString ::  a -> String
    toText :: Show a => a -> Text
    -- ^ conversion


    unwords' :: [a] -> a
    words' :: a -> [a]
    unlines' :: [a] -> a
    lines' :: a -> [a]
--    punwords :: [a] -> s
    toText = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
    append', append   :: a -> a -> a  -- duplication?
    append = forall l. ListForms l => l -> l -> l
appendTwo
    append' = forall l. ListForms l => l -> l -> l
appendTwo

    null' :: a -> Bool
    null' = forall z. (Zeros z, Eq z) => z -> Bool
isZero
    mknull :: a
    toLower' :: a -> a
    -- ^ convert the string to  lowercase, idempotent
    -- is not inverse of toUpper
    toUpper':: a -> a
    -- ^ is not idempotent and gives different results for string and text (sz and similar ligatures)

    isPrefixOf', isInfixOf', isPostfixOf' :: a -> a -> Bool
    isPostfixOf' a
a = forall a. CharChains a => a -> a -> Bool
isPrefixOf' (forall a. CharChains a => a -> a
reverseString a
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a
reverseString
    stripPrefix' :: a -> a -> Maybe a
    -- ^ takes the prefix away, if present (and return rest). nothing if no prefix
    stripSuffix' :: a -> a -> Maybe a
    concat' :: [a] -> a
    trim' :: a -> a
    -- ^ removes all spaces front and back, idempotent
    reverseString, reverse' :: a -> a
    reverse' = forall a. CharChains a => a -> a
reverseString
    removeLast :: a -> a
    -- ^ remove last char
    removeChar ::Char -> a -> a
    -- ^ remove a character from a string
    filterChar:: (Char -> Bool)  -> a -> a
    -- filter lets pass what is true
    lengthChar :: a -> Int
    nubChar :: a -> a
    drop' :: Int -> a -> a
    -- drop n char from input start
    take' :: Int -> a -> a
    -- ^ add a splitAt or dropN function
    intercalate' :: a -> [a] -> Maybe a
    -- ^ splitOn' and intercalate' are inverses (see Data.SplitList)
    -- returns Nothing if second  is empty and intercalate "x" "" gives Just ""
    -- return Nothing if first is empty or contained in second to achievee inverse with splitOn
    splitOn' :: a -> a -> Maybe [a]
    -- ^ splits the first by all occurences of the second 
    -- the second is removed from results
    -- returns Nothing if second is empty

    printf' :: (PrintfArg r) => String -> r -> a
    -- ^ formats a string accoding to a pattern - restricted to a single string (perhaps)
    -- requires type of argument fixed!

--    length' :: a -> Int
    replace' :: a -> a -> a -> a
    -- replace the first string with the second string in the third string
    readMaybe' :: Read b => a -> Maybe b
    -- read something... needs type hints

    prop_filterChar :: a -> Bool
    -- test with fixed set of chars to filter out

class CharChains2 x a where
    show' ::  x -> a
-- replaced with toString or toText

instance CharChains2 Int String where
    show' :: Int -> String
show' = forall a. Show a => a -> String
show
instance CharChains2 Bool String where
    show' :: Bool -> String
show' = forall a. Show a => a -> String
show
instance CharChains2 () String where
    show' :: () -> String
show' = forall a. Show a => a -> String
show
instance CharChains2 Int Text where
    show' :: Int -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance CharChains2 Bool Text where
    show' :: Bool -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance CharChains2 () Text where
    show' :: () -> Text
show' = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance CharChains2 Float String where
    show' :: Float -> String
show'  = forall a. Show a => a -> String
show
instance CharChains2 Float  Text where
    show' :: Float -> Text
show'  = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

instance CharChains2 Double String where
    show' :: Double -> String
show'  = forall a. Show a => a -> String
show
instance CharChains2 Double Text where
    show' :: Double -> Text
show'  = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show
instance CharChains2 Text Text where
    -- avoid the "" surrounding show text
    show' :: Text -> Text
show'  = forall a. a -> a
id
instance CharChains2 String Text where
    show' :: String -> Text
show'  = String -> Text
s2t
instance CharChains2 Text String where
    -- avoid the "" surrounding show text
    show' :: Text -> String
show'  = Text -> String
t2s
instance CharChains2 String String where
    show' :: String -> String
show'  = forall a. a -> a
id

instance (Show a, Show b) => CharChains2 (a,b) String where
    show' :: (a, b) -> String
show' (a
a,b
b) = forall a. Show a => a -> String
show (a
a,b
b)
instance (Show a, Show b) => CharChains2 (a,b) Text where
    show' :: (a, b) -> Text
show' (a
a,b
b) = String -> Text
s2t forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show (a
a,b
b)

instance (Show a) => CharChains2 [a] String where
    show' :: [a] -> String
show' [a]
s = forall a. Show a => a -> String
show [a]
s
instance (Show a) => CharChains2 [a] Text where
    show' :: [a] -> Text
show' [a]
s = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ [a]
s

instance CharChains String where
    toString :: String -> String
toString = forall a. a -> a
id
    toText :: Show String => String -> Text
toText = String -> Text
s2t

    unwords' :: [String] -> String
unwords' = [String] -> String
unwords
    words' :: String -> [String]
words' = String -> [String]
words
    unlines' :: [String] -> String
unlines' = [String] -> String
unlines
    lines' :: String -> [String]
lines' = String -> [String]
lines
    null' :: String -> Bool
null' = forall (t :: * -> *) a. Foldable t => t a -> Bool
null
    mknull :: String
mknull = String
""
    toUpper' :: String -> String
toUpper' = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper
    toLower' :: String -> String
toLower' = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower
    concat' :: [String] -> String
concat' = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
    isPrefixOf' :: String -> String -> Bool
isPrefixOf'  = forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf
    isInfixOf' :: String -> String -> Bool
isInfixOf' = forall a. Eq a => [a] -> [a] -> Bool
isInfixOf
    stripPrefix' :: String -> String -> Maybe String
stripPrefix'  = forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix
    stripSuffix' :: String -> String -> Maybe String
stripSuffix' String
a  = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (forall a. [a] -> [a]
reverse String
a) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

    intercalate' :: String -> [String] -> Maybe String
intercalate' String
s [String]
a
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
a = forall a. Maybe a
Nothing
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
s = forall a. Maybe a
Nothing
        | String
s forall a. Eq a => [a] -> [a] -> Bool
`isInfixOf` forall a. CharChains a => [a] -> a
concat' [String]
a = forall a. Maybe a
Nothing
        | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [[a]] -> [a]
L.intercalate String
s [String]
a

    splitOn' :: String -> String -> Maybe [String]
splitOn' String
o String
s
        | forall a. CharChains a => a -> Bool
null' String
o = forall a. a -> Maybe a
Just []
        | forall a. CharChains a => a -> Bool
null' String
s = forall a. a -> Maybe a
Just [String
""]
        | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Eq a => [a] -> [a] -> [[a]]
S.splitOn String
o String
s
    trim' :: String -> String
trim' = String -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
        where f :: String -> String
f = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace
    removeLast :: String -> String
removeLast String
a =  if forall a. CharChains a => a -> Bool
null' String
a
        then forall a. CharChains a => a
mknull
        else forall a. CharChains a => a -> a
reverseString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
tail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a
reverseString forall a b. (a -> b) -> a -> b
$ String
a
    reverseString :: String -> String
reverseString = forall a. [a] -> [a]
reverse
    printf' :: forall r. PrintfArg r => String -> r -> String
printf' = forall r. PrintfType r => String -> r
printf
    lengthChar :: String -> Int
lengthChar = forall (t :: * -> *) a. Foldable t => t a -> Int
length
    removeChar :: Char -> String -> String
removeChar Char
c = forall a. (a -> Bool) -> [a] -> [a]
filter (Char
c forall a. Eq a => a -> a -> Bool
/=)
    filterChar :: (Char -> Bool) -> String -> String
filterChar = forall a. (a -> Bool) -> [a] -> [a]
filter

    nubChar :: String -> String
nubChar = forall a. Eq a => [a] -> [a]
nub
    take' :: Int -> String -> String
take'  = forall a. Int -> [a] -> [a]
take
    drop' :: Int -> String -> String
drop' = forall a. Int -> [a] -> [a]
drop
    replace' :: String -> String -> String -> String
replace' = forall a. Eq a => [a] -> [a] -> [a] -> [a]
LU.replace
    readMaybe' :: forall b. Read b => String -> Maybe b
readMaybe' = forall b. Read b => String -> Maybe b
readMaybe

instance CharChains Text where
    toString :: Text -> String
toString = Text -> String
t2s
    toText :: Show Text => Text -> Text
toText = forall a. a -> a
id

    unwords' :: [Text] -> Text
unwords' = [Text] -> Text
T.unwords
    words' :: Text -> [Text]
words' =  Text -> [Text]
T.words
    lines' :: Text -> [Text]
lines' = Text -> [Text]
T.lines
    unlines' :: [Text] -> Text
unlines' = [Text] -> Text
T.unlines
    mknull :: Text
mknull = Text
T.empty
    toUpper' :: Text -> Text
toUpper' = Text -> Text
T.toUpper
    toLower' :: Text -> Text
toLower' = Text -> Text
T.toLower
    concat' :: [Text] -> Text
concat' = [Text] -> Text
T.concat
    isPrefixOf' :: Text -> Text -> Bool
isPrefixOf' = Text -> Text -> Bool
T.isPrefixOf
    isInfixOf' :: Text -> Text -> Bool
isInfixOf' = Text -> Text -> Bool
T.isInfixOf
    stripPrefix' :: Text -> Text -> Maybe Text
stripPrefix' = Text -> Text -> Maybe Text
T.stripPrefix
    stripSuffix' :: Text -> Text -> Maybe Text
stripSuffix' = Text -> Text -> Maybe Text
T.stripSuffix

    intercalate' :: Text -> [Text] -> Maybe Text
intercalate' Text
s [Text]
a
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
a = forall a. Maybe a
Nothing :: Maybe Text
      | forall a. CharChains a => a -> Bool
null' Text
s = forall a. Maybe a
Nothing
      | Text
s forall a. CharChains a => a -> a -> Bool
`isInfixOf'` forall a. CharChains a => [a] -> a
concat' [Text]
a = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
s [Text]
a

    splitOn' :: Text -> Text -> Maybe [Text]
splitOn' Text
o Text
s
      | forall a. CharChains a => a -> Bool
null' Text
o = forall a. a -> Maybe a
Just []
      | forall a. CharChains a => a -> Bool
null' Text
s = forall a. a -> Maybe a
Just [Text
""]
      | Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text -> Text -> [Text]
T.splitOn Text
o Text
s

    trim' :: Text -> Text
trim' = Text -> Text
T.strip 
    removeLast :: Text -> Text
removeLast Text
a = Int -> Text -> Text
T.dropEnd Int
1 Text
a

    reverseString :: Text -> Text
reverseString = Text -> Text
T.reverse  

    printf' :: forall r. PrintfArg r => String -> r -> Text
printf' String
p   = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
p
    lengthChar :: Text -> Int
lengthChar = Text -> Int
T.length
    removeChar :: Char -> Text -> Text
removeChar Char
c = (Char -> Bool) -> Text -> Text
T.filter (Char
c forall a. Eq a => a -> a -> Bool
/=)
    filterChar :: (Char -> Bool) -> Text -> Text
filterChar = (Char -> Bool) -> Text -> Text
T.filter
    nubChar :: Text -> Text
nubChar = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub forall b c a. (b -> c) -> (a -> b) -> a -> c
.Text -> String
t2s
    take' :: Int -> Text -> Text
take' = Int -> Text -> Text
T.take
    drop' :: Int -> Text -> Text
drop' = Int -> Text -> Text
T.drop

    prop_filterChar :: Text -> Bool
prop_filterChar Text
a = Text -> String
t2s Text
af forall a. Eq a => a -> a -> Bool
== (forall a. CharChains a => (Char -> Bool) -> a -> a
filterChar Char -> Bool
cond forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s forall a b. (a -> b) -> a -> b
$ Text
a)
      where
          cond :: Char -> Bool
cond Char
x = Char
x forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Char
'a', Char
'\r', Char
'1']
          af :: Text
af = forall a. CharChains a => (Char -> Bool) -> a -> a
filterChar Char -> Bool
cond Text
a :: Text
    replace' :: Text -> Text -> Text -> Text
replace' = Text -> Text -> Text -> Text
T.replace
    readMaybe' :: forall b. Read b => Text -> Maybe b
readMaybe' = forall a b. (CharChains a, Read b) => a -> Maybe b
readMaybe' forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
t2s

instance CharChains LazyByteString where
    append' :: LazyByteString -> LazyByteString -> LazyByteString
append' = LazyByteString -> LazyByteString -> LazyByteString
Lazy.append
    lengthChar :: LazyByteString -> Int
lengthChar LazyByteString
a = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> Int64
Lazy.length forall a b. (a -> b) -> a -> b
$ LazyByteString
a  
        --  gives not exact value??
    take' :: Int -> LazyByteString -> LazyByteString
take' = Int64 -> LazyByteString -> LazyByteString
Lazy.take forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral 
    drop' :: Int -> LazyByteString -> LazyByteString
drop' = Int64 -> LazyByteString -> LazyByteString
Lazy.drop forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral  

unwordsT :: [Text] -> Text
unwordsT :: [Text] -> Text
unwordsT = [Text] -> Text
T.unwords  
-- ^ to fix types for overloaded strings

wordsT :: Text -> [Text]
wordsT :: Text -> [Text]
wordsT = forall a. CharChains a => a -> [a]
words'

concatT ::  [Text] -> Text
concatT :: [Text] -> Text
concatT = forall a. CharChains a => [a] -> a
concat'

showT :: a -> Text
showT a
t = String -> Text
s2t String
c
    where c :: String
c = forall a. Show a => a -> String
show a
t :: String

instance CharChains BSUTF  where
-- works on utf8 encoded bytestring, convert with b2bu and bu2b

    toString :: BSUTF -> String
toString = BSUTF -> String
bu2s
    toText :: Show BSUTF => BSUTF -> Text
toText = BSUTF -> Text
bu2t

    unwords' :: [BSUTF] -> BSUTF
unwords' = Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unwords' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map BSUTF -> Text
bu2t
    words' :: BSUTF -> [BSUTF]
words' =  forall a b. (a -> b) -> [a] -> [b]
map Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
.  forall a. CharChains a => a -> [a]
words' forall b c a. (b -> c) -> (a -> b) -> a -> c
. BSUTF -> Text
bu2t
    lines' :: BSUTF -> [BSUTF]
lines' = forall a b. (a -> b) -> [a] -> [b]
map Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> [a]
lines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. BSUTF -> Text
bu2t
    unlines' :: [BSUTF] -> BSUTF
unlines' =  Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
unlines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map BSUTF -> Text
bu2t

--    append' a b = t2bu . append' (bu2t a) $ bu2t b
    null' :: BSUTF -> Bool
null' = Text -> Bool
T.null forall b c a. (b -> c) -> (a -> b) -> a -> c
. BSUTF -> Text
bu2t
    toUpper' :: BSUTF -> BSUTF
toUpper' = Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a
toUpper' forall b c a. (b -> c) -> (a -> b) -> a -> c
. BSUTF -> Text
bu2t
    toLower' :: BSUTF -> BSUTF
toLower' = Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a
toLower' forall b c a. (b -> c) -> (a -> b) -> a -> c
. BSUTF -> Text
bu2t
    concat' :: [BSUTF] -> BSUTF
concat' = Text -> BSUTF
t2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => [a] -> a
concat' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map BSUTF -> Text
bu2t
    isPrefixOf' :: BSUTF -> BSUTF -> Bool
isPrefixOf' BSUTF
t BSUTF
s  = forall a. CharChains a => a -> a -> Bool
isPrefixOf' (BSUTF -> Text
bu2t BSUTF
s) (BSUTF -> Text
bu2t BSUTF
t)
    isInfixOf' :: BSUTF -> BSUTF -> Bool
isInfixOf' BSUTF
t BSUTF
s  = forall a. CharChains a => a -> a -> Bool
isInfixOf' (BSUTF -> Text
bu2t BSUTF
s) (BSUTF -> Text
bu2t BSUTF
t)
    stripPrefix' :: BSUTF -> BSUTF -> Maybe BSUTF
stripPrefix' BSUTF
p BSUTF
s = Text -> BSUTF
t2bu forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CharChains a => a -> a -> Maybe a
stripPrefix' (BSUTF -> Text
bu2t BSUTF
p)  (BSUTF -> Text
bu2t BSUTF
s)
    intercalate' :: BSUTF -> [BSUTF] -> Maybe BSUTF
intercalate' BSUTF
x [BSUTF]
a  =  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BSUTF
t2bu  (forall a. CharChains a => a -> [a] -> Maybe a
intercalate' (BSUTF -> Text
bu2t BSUTF
x) (forall a b. (a -> b) -> [a] -> [b]
map BSUTF -> Text
bu2t [BSUTF]
a))
    splitOn' :: BSUTF -> BSUTF -> Maybe [BSUTF]
splitOn' BSUTF
o BSUTF
s = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> BSUTF
t2bu forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. CharChains a => a -> a -> Maybe [a]
splitOn' (BSUTF -> Text
bu2t BSUTF
o) (BSUTF -> Text
bu2t BSUTF
s)
    trim' :: BSUTF -> BSUTF
trim' = String -> BSUTF
s2bu forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. CharChains a => a -> a
trim' forall b c a. (b -> c) -> (a -> b) -> a -> c
. BSUTF -> String
bu2s

formatInt :: Int -> Int -> Text
formatInt :: Int -> Int -> Text
formatInt Int
n  = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. case Int
n of
        Int
6 -> forall r. PrintfType r => String -> r
printf  [Char
'%', Char
'0', Char
'6', Char
'd']
        Int
5 ->  forall r. PrintfType r => String -> r
printf  [Char
'%', Char
'0', Char
'5', Char
'd']
        Int
3 -> forall r. PrintfType r => String -> r
printf  [Char
'%', Char
'0', Char
'3', Char
'd']
        Int
2 ->  forall r. PrintfType r => String -> r
printf  [Char
'%', Char
'0', Char
'2', Char
'd']
        Int
a -> forall a. HasCallStack => String -> a
error (String
"formatInt not expected int" forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Int
a)

unlinesT :: [Text] -> Text
unlinesT :: [Text] -> Text
unlinesT = forall a. CharChains a => [a] -> a
unlines'

showAsLines :: Show a => [a] -> Text
-- ^ show on a line, does not propagate, inside is shown normally
showAsLines :: forall a. Show a => [a] -> Text
showAsLines = forall a. CharChains a => [a] -> a
unlines' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall {a}. Show a => a -> Text
showT 
 
sortCaseInsensitive :: (Ord a, CharChains a) => [a] -> [a]
sortCaseInsensitive :: forall a. (Ord a, CharChains a) => [a] -> [a]
sortCaseInsensitive = forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy forall a. (Ord a, CharChains a) => a -> a -> Ordering
cmpCaseInsensitive

cmpCaseInsensitive :: (Ord a, CharChains a) => a -> a -> Ordering
cmpCaseInsensitive :: forall a. (Ord a, CharChains a) => a -> a -> Ordering
cmpCaseInsensitive a
s1 a
s2 =  forall a. Ord a => a -> a -> Ordering
compare  (  forall a. CharChains a => a -> a
toLower' a
s1) (  forall a. CharChains a => a -> a
toLower' a
s2)

maybe2string :: (IsString s) =>  Maybe s -> s
maybe2string :: forall s. IsString s => Maybe s -> s
maybe2string Maybe s
Nothing  = s
""  -- TODO
maybe2string (Just s
s) = s
s

string2maybe :: (Eq a, IsString a) => a -> Maybe a
string2maybe :: forall a. (Eq a, IsString a) => a -> Maybe a
string2maybe a
x = if a
x forall a. Eq a => a -> a -> Bool
== a
"" then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
x

class  (Show a) =>  NiceStrings a where
    shownice, showNice :: a -> Text
    -- showNice = shownice
    shownice = forall {a}. Show a => a -> Text
showT  -- as default 
    showlong :: a -> Text
    showlong = forall a. NiceStrings a => a -> Text
shownice  -- a default
class Show a => PrettyStrings a where 
    showPretty :: a -> Text
instance  {-# OVERLAPPABLE #-} Show a => PrettyStrings a where
    showPretty :: a -> Text
showPretty = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
ppShow

instance NiceStrings Text where
    shownice :: Text -> Text
shownice = forall a. a -> a
id
    showlong :: Text -> Text
showlong = forall a. a -> a
id

instance NiceStrings Int where
    shownice :: Int -> Text
shownice = forall x a. CharChains2 x a => x -> a
show'
    showlong :: Int -> Text
showlong = forall x a. CharChains2 x a => x -> a
show'

-- instance NiceStrings Float where shownice = s2t . showDP 4

-- for printf https://hackage.haskell.org/package/base-4.17.0.0/docs/Text-Printf.html
instance NiceStrings Float where shownice :: Float -> Text
shownice Float
f = String -> Text
s2t forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%.3f" Float
f

instance NiceStrings Double where
    shownice :: Double -> Text
shownice Double
s = String -> Text
s2t forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r. PrintfType r => String -> r
printf String
"%.3f" forall a b. (a -> b) -> a -> b
$ Double
s
    showlong :: Double -> Text
showlong = forall x a. CharChains2 x a => x -> a
show'

instance (NiceStrings a, NiceStrings b) => NiceStrings (a,b) where
    shownice :: (a, b) -> Text
shownice (a
a,b
b) = forall a. CharChains a => [a] -> a
unwords' [forall a. NiceStrings a => a -> Text
shownice a
a, forall a. NiceStrings a => a -> Text
shownice b
b]
    showlong :: (a, b) -> Text
showlong (a
a,b
b) = forall a. CharChains a => [a] -> a
unwords' [forall a. NiceStrings a => a -> Text
showlong a
a, forall a. NiceStrings a => a -> Text
showlong b
b]
instance (Show a, NiceStrings a) => NiceStrings [a] where
    shownice :: [a] -> Text
shownice [a]
as = forall a. CharChains a => [a] -> a
concat' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
L.intersperse Text
",\t\t" forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map forall a. NiceStrings a => a -> Text
shownice [a]
as) 
    showlong :: [a] -> Text
showlong [a]
as = forall a. CharChains a => [a] -> a
concat' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
L.intersperse Text
",\n" forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> [a] -> [b]
map forall a. NiceStrings a => a -> Text
shownice [a]
as) 
    -- catMaybes $ [intercalate' "\n" .  map showlong $ as, Just "\n"]

instance (NiceStrings a) => NiceStrings (Maybe a) where
    shownice :: Maybe a -> Text
shownice (Just a
a)  = forall a. NiceStrings a => a -> Text
shownice a
a
    shownice Maybe a
Nothing = Text
"Nothing"

instance (Show a, Show b, Show c) => NiceStrings (a,b,c) where 
            showNice :: (a, b, c) -> Text
showNice (a, b, c)
a = forall {a}. Show a => a -> Text
showT (a, b, c)
a