module Text.Regex.Do.Trim where

import Data.Char(isSpace)
import qualified Data.ByteString as B
import qualified Data.Text as T
import Text.Regex.Do.Type.Convert
import Text.Regex.Do.Replace.Latin
import Text.Regex.Do.Type.MatchHint
import Text.Regex.Do.Match.Regex
import Text.Regex.Do.Match.Option


{- | removes leading and trailing spaces and tabs   -}

class Trim a where
    trim::a -> a


instance Trim B.ByteString where
    trim :: ByteString -> ByteString
trim bs1 :: ByteString
bs1 = All Regex -> ByteString -> ByteString -> ByteString
forall (hint :: * -> *) pattern repl body out.
(Replace hint pattern repl body out, Extract' body,
 RegexLike Regex body) =>
hint pattern -> repl -> body -> out
replace (Regex -> All Regex
forall a. a -> All a
All Regex
rx3) ByteString
repl1 ByteString
bs1
       where repl1 :: ByteString
repl1 = ByteString
B.empty
             rx1 :: String
rx1 = "(^[\\s\\t]+)|([\\s\\t]+$)"
             rx2 :: ByteString
rx2 = String -> ByteString
toByteString String
rx1
             Right rx3 :: Regex
rx3 = ByteString -> [Comp] -> [Exec] -> Either String Regex
forall a. Regex a => a -> [Comp] -> [Exec] -> Either String Regex
makeRegexOpt ByteString
rx2 [Comp
Blank] []  


instance Trim String where
    trim :: String -> String
trim = String -> String
f (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
       where f :: String -> String
f = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace


instance Trim T.Text where
    trim :: Text -> Text
trim = Text -> Text
T.strip
-- ^ see 'T.strip'