module MPS where
import Prelude hiding ((.), sum, product, maximum, minimum,
foldl, foldr, foldl1, foldr1, concat, concatMap, and, or, any, all, elem, (^), (>), (/))
import qualified Prelude as Prelude
import Control.Arrow ((&&&), (>>>), (<<<))
import Control.Monad hiding (join)
import Control.Parallel
import Data.Char
import Data.Maybe
import Data.Foldable
import Data.Time.Clock.POSIX
import Data.Time
import Data.List (transpose, group, (\\), sortBy, isPrefixOf, isSuffixOf)
import qualified Data.Array as A
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Map as M
import qualified Data.ByteString.Lazy.Char8 as B
import System.Locale
import System.Posix.Files
import System.IO
import System.Directory
import qualified System.IO.Unsafe as Unsafe
import Text.RegexPR
import Text.InterpolatedString.QQ
import Text.ParserCombinators.Parsec (many, char, many1, digit, (<|>), Parser, anyChar, try)
import qualified Text.ParserCombinators.Parsec as P
import Codec.Binary.Base64.String as C
import qualified Codec.Binary.UTF8.String as Codec
import qualified Codec.Compression.GZip as GZip
import System.FilePath ((</>))
import Debug.Trace
import Numeric
(.) :: a -> (a -> b) -> b
a . f = f a
infixl 9 .
(>) = (>>>)
infixl 8 >
(^) = flip fmap
infixl 8 ^
(/) :: FilePath -> FilePath -> FilePath
(/) = (</>)
infixl 5 /
join = L.intercalate
join' = concat
first = head
second = at 1
third = at 2
forth = at 3
fifth = at 4
sixth = at 5
seventh = at 6
eighth = at 7
ninth = at 8
tenth = at 10
unique = to_set > to_list
is_unique xs = xs.unique.length == xs.length
same = unique > length > is 1
times = flip replicate
upto = flip enumFromTo
downto m n = [n, n1.. m]
remove_at n xs = xs.take n ++ xs.drop (n+1)
insert_at n x xs = splitted.fst ++ [x] ++ splitted.snd where splitted = xs.splitAt n
replace_at n x xs = xs.take n ++ [x] ++ xs.drop (n+1)
at = flip (!!)
slice l r xs = xs.take r.drop l
cherry_pick ids xs = ids.map(xs !!)
reduce = foldl1
reduce' f (x:xs) = inject' x f xs
reduce' _ _ = error "reduce' takes a list of at least 2 elements"
inject init f = foldl f init
inject' init f = foldl' f init
none_of f = any f > not
select = filter
reject f = filter(f > not)
lookup' i xs = xs.lookup i .fromJust
inner_map f = map (map f)
inner_reduce f = map(reduce f)
inner_inject init f = map(inject init f)
label_by f = map(f &&& id)
labeling f = map(id &&& f)
in_group_of _ [] = []
in_group_of n xs = h : t.in_group_of(n) where (h, t) = xs.splitAt(n)
split_to n xs = xs.in_group_of(size) where
l = xs.length
size = if l < n then 1 else l `div` n
apply x f = f x
send_to = apply
let_receive f = flip f
map_send_to x = map(send_to(x))
belongs_to = flip elem
has = flip belongs_to
indexed = zip([0..])
map_with_index f = indexed > map f
ljust n x xs
| n < xs.length = xs
| otherwise = ( n.times x ++ xs ).reverse.take n.reverse
rjust n x xs
| n < xs.length = xs
| otherwise = ( xs ++ n.times x ).take n
ub = takeWhile
lb f = dropWhile ( not <<< f )
between a b xs = xs.lb a .ub b
not_null = null > not
powerslice xs = [ xs.slice j (j+i) |
i <- l.downto 1,
j <- [0..l i]
]
where l = xs.length
common _ [] = []
common [] _ = []
common a@(x:xs) b@(y:ys)
| x .is y = y : common xs b
| x < y = common xs b
| otherwise = common a ys
rsort xs = xs.L.sortBy(\a b -> b `compare` a)
encode xs = xs.group.map (length &&& head)
decode xs = xs.map(\(l,x) -> l.times x).join'
only_one [_] = True
only_one _ = False
concat_map f xs = concatMap f xs
to_h xs = xs.M.fromList
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
(*) `on` f = \x y -> f x * f y
compare_by = on compare
eq = flip (==)
is = eq
is_not a b = not (is a b)
isn't = is_not
aren't = is_not
swap (x,y) = (y,x)
tuple2 = first &&& last
tuple3 xs = (xs.first, xs.second, xs.third)
list2 (x,y) = [x,y]
list3 (x,y,z) = [x,y,z]
filter_fst f = filter(fst > f)
filter_snd f = filter(snd > f)
only_fst = map fst
only_snd = map snd
map_fst f = map(\(a,b) -> (f a, b))
map_snd f = map(\(a,b) -> (a, f b))
pair f a b = f (a,b)
triple f a b c = f (a,b,c)
splash f (a,b) = f a b
splash3 f (a,b,c) = f a b c
twin x = (x,x)
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 = fromGregorian
splash_date = toGregorian
split re xs
| xs.match re .isJust = splitRegexPR re xs .reject empty
| otherwise = [xs]
split' s = s.lines.reject empty
sub = subRegexPR
gsub = gsubRegexPR
match = matchRegexPR
strip s = s.sub "^\\s*" "" .reverse .sub "^\\s*" "" .reverse
empty s = case s.match("\\S") of
Just _ -> False
Nothing -> True
to_s x = x.show
is_palindrom s = s.reverse.is s
collapse' [] _ r = r
collapse' (x:xs) q r = collapse' xs (q+1) (r + x * 10 Prelude.^ q)
collapse xs = collapse' (xs.reverse.map from_i) 0 0 .fromIntegral
explode n = n.show.map digitToInt
base p n = showIntAtBase p intToDigit n ""
from_i = fromIntegral
int_square n = n.fromIntegral.sqrt.round :: Integer
to_list = toList
to_set = S.fromList
to_a xs = A.listArray (0, xs.length 1) xs
to_a' i xs = A.listArray i xs
hist bnds ns = A.accumArray (+) 0 bnds [(n, 1) | n <- ns, A.inRange bnds n]
parse p s = case (P.parse p "" s) of
Left err -> err.show.error
Right x -> x
trace' x = trace (x.show) x
lower = map toLower
upper = map toUpper
starts_with = isPrefixOf
ends_with = isSuffixOf
capitalize [] = []
capitalize (x:xs) = [x].upper ++ xs.lower
camel_case = split "_" > map capitalize > join'
snake_case = gsub "\\B[A-Z]" "_\\&" > lower
unescape_unicode_xml s = parse unescape_parser s
where
unicode_char :: Parser Char
unicode_char = do
char '&'
char '#'
word <- many1 digit
char ';'
return $ chr (read word)
unescape_parser :: Parser String
unescape_parser = many (try unicode_char <|> anyChar)
escape_unicode_xml :: String -> String
escape_unicode_xml = concatMap fixChar
where
fixChar '<' = "<"
fixChar '>' = ">"
fixChar '&' = "&"
fixChar '"' = "\""
fixChar c | ord c < 0x80 = [c]
fixChar c = "&#" ++ show (ord c) ++ ";"
purify = Unsafe.unsafePerformIO
read_pure x = x.readFile.purify
write_pure file c = writeFile file c
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 = getFileStatus (path.u2b)
^ modificationTime ^ realToFrac ^ posixSecondsToUTCTime
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
filter_comment =
lines > map strip > reject null > reject (head > (== '#')) > unlines
now :: IO UTCTime
now = getCurrentTime
format_time :: String -> UTCTime -> String
format_time = formatTime defaultTimeLocale
b2u = Codec.decodeString
u2b = Codec.encodeString
here = istr
zip64, unzip64 :: String -> String
zip64 = B.pack > GZip.compress > B.unpack > C.encode
unzip64 = C.decode > B.pack > GZip.decompress > B.unpack