module Air.Extra where

import Control.Parallel
import Data.Char
import Data.List ((\\))
import Data.Maybe
import Data.Time
import Data.Time.Clock.POSIX
import Air.Light hiding (reduce, reduce')
import Numeric
import Prelude hiding ((.), (^), (>), (<), (/), elem, foldl, (-))
import System.Directory
import System.IO
import System.Locale (defaultTimeLocale)
import Text.RegexPR

import qualified Data.List as L
import qualified Prelude as Prelude
import qualified System.IO.Unsafe as Unsafe
import Data.List (foldl1')

import qualified Data.Text as T
import qualified Data.Text.Encoding as E
import qualified Data.ByteString.Char8 as B



-- BEGIN !!!!!! partial, use with extra care
-- backport
reduce, reduce' :: (a -> a -> a) -> [a] -> a
reduce = foldl1
reduce' = foldl1'

-- 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


-- END !!!!!!



b2u, u2b :: String -> String
b2u = B.pack > E.decodeUtf8 > T.unpack
u2b = T.pack > E.encodeUtf8 > B.unpack

-- 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, Show a) => a -> a -> String
base p n = showIntAtBase p intToDigit n ""

-- String
camel_case, snake_case :: String -> String
camel_case = split "_" > map capitalize > concat
snake_case = gsub "\\B[A-Z]" "_\\&" > lower

-- IO

-- Should only be used to initialize IORefs, etc.
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 ReadMode hFileSize

file_mtime :: String -> IO UTCTime
file_mtime = getModificationTime


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

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"

now_in_zoned_time :: IO String
now_in_zoned_time = do
  timestamp <- now

  tz <- getCurrentTimeZone

  let zoned_time = utcToZonedTime tz timestamp

  let time_str = formatTime defaultTimeLocale simple_time_format zoned_time

  return time_str


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 (first > (== Just '#')) > unlines


-- IO
line_buffer :: IO ()
line_buffer = do
  hSetBuffering stdout LineBuffering
  hSetBuffering stderr LineBuffering