module MPS.UTF8 where

import MPS hiding (split, gsub, match, sub, strip)
import Prelude hiding ((.), (^), readFile, writeFile, (>))
import System.Directory
import System.IO.UTF8 (readFile, writeFile)
import qualified MPS as MPS

-- io
read_file :: String -> IO String
read_file  = readFile

write_file :: String -> String -> IO ()
write_file = writeFile

ls :: String -> IO [String]
ls x = MPS.ls (x.u2b) ^ map b2u

mkdir_p :: String -> IO ()
mkdir_p = u2b > createDirectoryIfMissing True

file_exist :: String -> IO Bool
file_exist = u2b > doesFileExist

dir_exist :: String -> IO Bool
dir_exist = u2b > doesDirectoryExist

split :: String -> String -> [String]
split x y  = MPS.split (x.u2b) (y.u2b) .map b2u

gsub :: String -> String -> String -> String
gsub x y z = MPS.gsub (x.u2b) (y.u2b) (z.u2b) .b2u

sub :: String -> String -> String -> String
sub x y z  = MPS.sub (x.u2b) (y.u2b) (z.u2b) .b2u

match :: String -> String -> Maybe (RegexResult, MatchList)
match x y  = MPS.match (x.u2b) (y.u2b)

strip :: String -> String
strip x = MPS.strip (x.u2b) .b2u

rm :: String -> IO ()
rm = u2b > removeFile

rm_rf :: String -> IO ()
rm_rf = u2b > removeDirectoryRecursive