module MPS.Snippets where
import MPS.Hack.Dot
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.Graph.Inductive (Gr, mkGraph)
import Data.Foldable
import Data.Time.Clock.POSIX
import Data.Time
import Data.List (transpose, sort, group, (\\), sortBy)
import qualified Data.Array as A
import qualified Data.List as L
import qualified Data.Set as S
import qualified Data.Graph as G
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 Test.QuickCheck
import Text.RegexPR
import Text.Pandoc
import Text.Template
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 Debug.Trace
import Numeric
join x xs = L.intercalate x xs
join' xs = xs.concat
first = head
unique xs = xs.to_set.to_list
is_unique xs = xs.unique.length == xs.length
same xs = xs.unique.length == 1
times = flip replicate
upto m n = flip enumFromTo m n
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 i xs = xs !! i
slice l r xs = xs.take r.drop l
cherry_pick ids xs = ids.map(xs !!)
reduce f xs = foldl1 f xs
reduce' f (x:xs) = inject' x f xs
reduce' _ _ = error "reduce' takes a list of at least 2 elements"
inject init f xs = foldl f init xs
inject' init f xs = foldl' f init xs
none_of f xs = not $ any f xs
select = filter
reject f = filter(not ... f)
lookup' i xs = xs.lookup i .fromJust
inner_map f xs = xs.map(map f)
inner_reduce f xs = xs.map(reduce f)
inner_inject init f xs = xs.map(inject init f)
label_by f xs = xs.map(f &&& id)
labeling f xs = xs.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 s = flip f s
map_send_to x fs = fs.map(send_to(x))
belongs_to xs x = xs.elem x
has xs x = flip belongs_to xs x
indexed xs = xs.zip([0..])
map_with_index f xs = xs.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 xs = xs.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
quick_check prop = quickCheck prop
qc prop = quick_check prop
on :: (b -> b -> c) -> (a -> b) -> a -> a -> c
(*) `on` f = \x y -> f x * f y
compare_by f = on compare f
eq b a = (==) a b
is a b = eq a b
is_not a b = not (is a b)
swap (x,y) = (y,x)
tuple2 xs = (xs.first, xs.last)
tuple3 xs = (xs.first, xs.tail.first, xs.last)
list2 (x,y) = [x,y]
list3 (x,y,z) = [x,y,z]
filter_fst f = filter(\(a,_) -> a.f)
filter_snd f = filter(\(_,b) -> b.f)
only_fst = map(\(a,_) -> a)
only_snd = map(\(_,b) -> b)
map_fst f = map(\(a,b) -> (a.f, b))
map_snd f = map(\(a,b) -> (a, b.f))
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)
merge f = map (pair f)
purify = Unsafe.unsafePerformIO
read_pure x = x.readFile.purify
write_pure file c = writeFile file c
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
row n i = i `div` n
col n i = i `mod` n
m !!! i = m.at(row n i) .at(col n i)
where n = m.first.length
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 <^> 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 n = fromIntegral n
int_square n = n.fromIntegral.sqrt.round :: Integer
to_list xs = toList xs
to_set xs = xs.S.fromList
to_a xs = xs.A.listArray (0, xs.length 1)
to_a' i xs = A.listArray i xs
hist bnds ns = A.accumArray (+) 0 bnds [(n, 1) | n <- ns, A.inRange bnds n]
to_g'' = G.buildG
type GType = Int
to_g_with :: Real a => (GType -> c) -> [(GType, GType, a)] -> Gr c a
to_g_with mapper xs = mkGraph (xs.label_nodes) xs where
node_pair x = (x, mapper x)
label_nodes xs = xs.map(\(a,b,_) -> [a,b]) .join' .unique .map node_pair
to_g xs = to_g_with id xs
graph_map xs = (edges, vertex_map) where
vertices = xs.map(\(a,b,_)-> [a,b]).join'.unique.sort
vertex_map = vertices.indexed
r_vertex_map = vertex_map.map(swap)
edges = xs.map(\(a,b,c) -> (r_vertex_map.lookup' a, r_vertex_map.lookup' b, c))
to_g' xs = let (edges, vertex_map) = graph_map xs in
edges.to_g_with (vertex_map.flip lookup')
parse p s = case (P.parse p "" s) of
Left err -> err.show.error
Right x -> x
cache f xs = a.to_list where
a = xs.g.to_a
g ys = f a ys
greedy_count x xs = greedy x xs .length
greedy x xs = greedy' x (xs.rsort) where
greedy' x _ | x < 0 = [[]]
greedy' 0 _ = [[]]
greedy' x [y] = if (x `mod` y) .is 0 then [ (x `div` y).from_i .times y ] else [[]]
greedy' s (a:as) = [ h ++ t |
n <- [0..(div s a)].reverse,
let h = n.from_i.times a,
t <- greedy' (s n * a) as,
let c = h ++ t,
c.sum == s
]
greedy' _ _ = error "argument type"
trace' x = trace (x.show) x
markdown = b2u >>> readMarkdown defaultParserState >>> writeHtml defaultWriterOptions
markdown' = b2u >>> readMarkdown defaultParserState >>> writeHtmlString defaultWriterOptions >>> u2b
a ^ b = a .liftM b
infixl 9 ^
(<^>) = (Prelude.^)
infixr 8 <^>
a <.> b = a .liftM b
infixl 9 <.>
lower = map toLower
upper = map toUpper
starts_with [] _ = True
starts_with _ [] = False
starts_with (x:xs) (y:ys) | x == y = starts_with xs ys
| otherwise = False
ends_with x y = starts_with (x.reverse) (y.reverse)
capitalize [] = []
capitalize (x:xs) = [x].upper ++ xs.lower
camel_case = split "_" >>> map capitalize >>> join'
snake_case = gsub "\\B[A-Z]" "_\\&" >>> lower
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)
unescape_unicode_xml s = parse unescape_parser s
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) ++ ";"
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
interpolate :: String -> [(String, String)] -> String
interpolate s params = B.unpack $ substitute (B.pack s) (context params)
where
context = map packPair >>> to_h
packPair (x, y) = (B.pack x, B.pack y)
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