StringUtils by Luca Ciciriello
2011-2016
> module StringUtils where
> import Data.Char
> import Data.List
Replace a single char in the specified position
> replace :: Int -> String -> String -> String
> replace _ _ "" = ""
> replace n ch str = (take n str) ++ ch ++ (drop (n+1) str)
Replace a single char with a new one when occurs in a string
> replace_all :: String -> String -> String -> String
> replace_all old new str | p == (1) = s
> | otherwise = (take p str) ++ new ++ (replace_all old new s)
> where p = find_first old str
> s = drop (p+1) str
Replace a substring wit a new one when occurs in a string
> replace_all_str :: String -> String -> String -> String
> replace_all_str old new str | p == (1) = s
> | otherwise = (take p str) ++ new ++ (drop (len 1) (replace_all_str old new s))
> where p = find_str old str
> s = drop (p+1) str
> len | length old == 0 = 0
> | otherwise = length old
Restituisce la posizione della prima occorrenza della stringa specificata in una stringa
> find_first :: (Eq a) => [a] -> [a] -> Int
> find_first _ [] = 1
> find_first [] _ = 1
> find_first (x:ys) xs | (x `elem` xs) == False = 1
> | otherwise = head (positions x xs)
Replace first occurrence of a substring in a string starting from a specified position
> find_fst_from :: (Eq a) => [a] -> [a] -> Int -> Int
> find_fst_from _ [] _ = 1
> find_fst_from [] _ _ = 1
> find_fst_from x xs off | (x `isIn` str) == False = 1
> | otherwise = (find_first x str) + off
> where str = (drop off xs)
As find_first but using String type
> find_str :: String -> String -> Int
> find_str "" _ = 1
> find_str _ [] = 1
> find_str sub xs | null lst = 1
> | otherwise = head lst
> where lst = matching_lst sub xs (fst_pos_lst sub xs)
As find_fst_from but using String type
> find_str_from :: String -> String -> Int -> Int
> find_str_from _ [] _ = 1
> find_str_from [] _ _ = 1
> find_str_from sub xs off | (pos == 1) = 1
> | otherwise = pos + off
> where str = (drop off xs)
> pos = find_str sub str
Returns a substring of a string starting from a specified position and for a pecified num of char
> substr :: Int -> Int -> String -> String
> substr _ _ "" = ""
> substr pos num str = take num (drop pos str)
Returns the char in a specified position in a string
> get_ch_at :: String -> Int -> Char
> get_ch_at [] _ = '_'
> get_ch_at str n = str !! n
Returns the position of the first occurrence of a specified char in a string
> positions :: (Eq a) => a -> [a] -> [Int]
> positions _ [] = []
> positions x xs = [i | (x', i) <- zip xs [0 .. n], x == x']
> where n = length xs 1
str_positions :: String -> String -> [Int]
str_positions _ "" = []
str_positions x xs | pos == -1 = []
| otherwise = (find_str x xs) : [find_str x sss]
where sss = drop (pos+1) xs
pos = find_str x xs
Returns the positions list of all occurrence of a substring in a string
> indicesOfSubStr :: String -> String -> [Int]
> indicesOfSubStr [] _ = []
> indicesOfSubStr sub str = filter (\i -> sub `isPrefixOf` drop i str) $ head sub `elemIndices` str
Cunts the occurences of a specified char in a string
> count :: (Eq a) => a -> [a] -> Int
> count _ [] = 0
> count x xs = length $ positions x xs
Checks if a specified substring is present in a string
> isIn :: (Eq a) => [a] -> [a] -> Bool
> isIn (x:xs) str = x `elem` str
Removes the char in a specified position in a string
> delete_at :: Int -> String -> String
> delete_at 0 xs = xs
> delete_at _ "" = ""
> delete_at pos xs = (take pos xs) ++ (drop (pos+1) xs)
Removes all the occurrences of a char in a string
> delete_all :: String -> String -> String
> delete_all _ "" = ""
> delete_all "" xs = xs
> delete_all el xs = replace_all el "" xs
Inserts a substring in a specified position in a string
> insert_at :: Int -> String -> String -> String
> insert_at _ "" xs = xs
> insert_at _ el "" = el
> insert_at pos el xs | (pos > (length xs) || pos < 0) == True = xs
> | otherwise = (take pos xs) ++ el ++ (drop pos xs)
Transform all lowercase chars in a string in uppercase chars
> to_upper :: String -> String
> to_upper "" = ""
> to_upper xs = map toUpper xs
Transform all uppercase chars in a string in lowercase chars
> to_lower :: String -> String
> to_lower "" = ""
> to_lower xs = map toLower xs
Returns a positions list of a specified char in a string
> fst_pos_lst :: String -> String -> [Int]
> fst_pos_lst sub xs = positions (sub `get_ch_at` 0) xs
Just for internal use
> matching_lst :: String -> String -> [Int] -> [Int]
> matching_lst sub xs ps = [p | p <- ps, mtc p]
> where mtc p = (sub == (substr p (length sub) xs))
Removes starting spaces in a string
> trim_left :: String -> String
> trim_left "" = ""
> trim_left (x:xs) | (x /= ' ') = x : xs
> | otherwise = trim_left xs
Removes starting spaces, tabs, and newlines in a string
> trim_left_complete :: String -> String
> trim_left_complete "" = ""
> trim_left_complete (x:xs) | (x /= ' ' && x /= '\t' && x /= '\r' && x /= '\n') = x : xs
> | otherwise = trim_left_complete xs
Removes ending spaces in a string
> trim_right :: String -> String
> trim_right str = (reverse . trim_left . reverse) str
Removes ending spaces, tabs, and newlines in a string
> trim_right_complete :: String -> String
> trim_right_complete str = (reverse . trim_left_complete . reverse) str
Removes all starting and ending spaces in a string
> trim :: String -> String
> trim str = (trim_right . trim_left) str
Removes all starting and ending spaces, tabs and newlines in a string
> trim_complete :: String -> String
> trim_complete str = (trim_right_complete . trim_left_complete) str