module MPS.Extra where

import Control.Parallel
import Data.Char
import Data.List (transpose, (\\))
import Data.Maybe
import Data.Time
import Data.Time.Clock.POSIX
import MPS.Light
import Numeric
import Prelude hiding ((.), (^), (>), (<), (/), elem, foldl)
import System.Directory
import System.IO
import System.Locale (defaultTimeLocale)
import System.Time
import Text.RegexPR
import qualified Codec.Binary.UTF8.String as Codec
import qualified Data.ByteString.Lazy.Char8 as B
import qualified Data.List as L
import qualified Prelude as Prelude
import qualified System.IO.Unsafe as Unsafe


-- Parallel
p_eval, p_eval' :: [a] -> [a]
p_reduce, p_reduce' :: (a -> a -> a) -> [a] -> a
p_map, p_map' :: (a -> b) -> [a] -> [b]
p_split_to :: Int -> [t] -> [[t]]
p_map_reduce_to :: Int -> ([a] -> b) -> (b -> b -> b) -> [a] -> b
p_map_reduce :: ([a] -> b) -> (b -> b -> b) -> [a] -> b

p_eval xs                = xs.par(xs.reduce(par))
p_reduce op xs           = xs.p_eval.reduce(op)
p_map op xs              = xs.map(op).p_eval

p_eval' xs               = xs.pseq( xs.reduce par )
p_reduce' op xs          = xs.p_eval'.reduce op
p_map' op xs             = xs.map op .p_eval'


p_split_to n xs          = xs.in_group_of(n).L.transpose
p_map_reduce_to n m r xs = xs.split_to n .map m .p_reduce' r
p_map_reduce m r xs      = p_map_reduce_to 16 m r xs

-- Date
date :: Integer -> Int -> Int -> Data.Time.Day
splash_date :: Data.Time.Day -> (Integer, Int, Int)
date        = fromGregorian
splash_date = toGregorian

-- String
split_raw :: String -> String -> [String]
split_raw re xs
  | xs.match re .isJust = splitRegexPR re xs
  | otherwise           = [xs]

split :: String -> String -> [String]
split re xs = split_raw re xs .reject empty

split' :: String -> [String]
split' s = s.lines.reject empty

sub :: String -> String -> String -> String
sub = subRegexPR

gsub :: String -> String -> String -> String
gsub = gsubRegexPR

type RegexResult = ( String, (String, String) )
type MatchList   = [ (Int, String) ]
match :: String -> String -> Maybe (RegexResult, MatchList)
match = matchRegexPR

strip :: String -> String
strip s = s.sub "^\\s*" "" .reverse .sub "^\\s*" "" .reverse

empty :: String -> Bool
empty s = case s.match("\\S") of
  Just _ -> False
  Nothing -> True
  

-- Integer
collapse :: (Integral a, Num b) => [a] -> b
collapse xs = collapse' (xs.reverse.map from_i) (0 :: Int) (0 :: Int) .fromIntegral
  where
    collapse' [] _ r     = r
    collapse' (x:xs') q r = collapse' xs' (q+1) (r + x * 10 Prelude.^ q)

base :: (Integral a) => a -> a -> String
base p n = showIntAtBase p intToDigit n ""
    
-- String
camel_case, snake_case :: String -> String
camel_case = split "_" > map capitalize > join'
snake_case = gsub "\\B[A-Z]" "_\\&" > lower

-- IO
purify :: IO a -> a
purify = Unsafe.unsafePerformIO

ls :: String -> IO [String]
ls s = getDirectoryContents s ^ (\\ [".", ".."])

file_size :: String -> IO Integer
file_size path = withFile (path.u2b) ReadMode hFileSize

file_mtime :: String -> IO UTCTime
file_mtime path = 
  getModificationTime (path.u2b) ^ seconds ^ from_i ^ posixSecondsToUTCTime
  where seconds (TOD s _) = s

read_binary_file :: String -> IO String
read_binary_file path = path.u2b.B.readFile ^ B.unpack

get_permissions :: String -> IO Permissions
get_permissions path = getPermissions (path.u2b) 

get_current_directory :: IO String
get_current_directory = getCurrentDirectory ^ b2u

-- Time
now :: IO UTCTime
now = getCurrentTime

format_time :: String -> UTCTime -> String
format_time = formatTime defaultTimeLocale

simple_time_format :: String
simple_time_format = "%Y-%m-%d %H:%M:%S %Z"

parse_time :: String -> String -> UTCTime
parse_time = readTime defaultTimeLocale

t2i :: UTCTime -> Integer
t2i = utcTimeToPOSIXSeconds > floor

t2f :: (Fractional a) => UTCTime -> a
t2f = utcTimeToPOSIXSeconds > toRational > fromRational

i2t :: Integer -> UTCTime
i2t = from_i > posixSecondsToUTCTime

f2t :: (Real a) => a -> UTCTime
f2t = toRational > fromRational > posixSecondsToUTCTime

-- Text
filter_comment :: String -> String
filter_comment = 
  lines > map strip > reject null > reject (head > (== '#')) > unlines

-- UTF8
b2u, u2b :: String -> String
b2u = Codec.decodeString
u2b = Codec.encodeString