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