packages feed

mps 2009.5.13 → 2009.6.25

raw patch · 12 files changed

+658/−488 lines, 12 filesdep +old-timedep +template-haskelldep −unixdep ~base

Dependencies added: old-time, template-haskell

Dependencies removed: unix

Dependency ranges changed: base

Files

− README.markdown 
@@ -1,18 +0,0 @@-Message Passing Style Haskell Toolkit-=====================================--Example-----------### OO (duck) Syntax--    euler_1 = ( [3,6..999] ++ [5,10..999] ).unique.sum---### Parallel map reduce --    p_eval' xs                  = xs.pseq( xs.reduce par )-    p_reduce' op xs             = xs.p_eval'.reduce op-    -    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
+ README.md view
@@ -0,0 +1,9 @@+Message Passing Style Haskell Toolkit+=====================================++Example+--------++### OO (duck) Syntax++    euler_1 = ( [3,6..999] ++ [5,10..999] ).unique.sum
− changelog.markdown 
@@ -1,90 +0,0 @@-2009.5.13------------### Fix--* Minimal dependency--2009.4.50-------------### Feature--* xml helper, io helper--### fix--* unescape unicode parser use (try)--2009.4.21------------### Fix--* starts_with returns true for the same string--2009.4.20------------### Feature--* require interpolatedstring-qq-* Add here as alias of istr ( Ruby like string using QQ ).--2008.11.15-------------### Fix--* Replace `from_utf8` `to_utf8` to `b2u` `u2b`-* Comment on dynamic programming usage--2008.11.6-------------### Feature--* UTF8 wrapper-* Almost -Wall clean--2008.10.25-------------* More string helpers-* introducing ^--2008.10.15-------------* Fix (use sub, as regexpr works per line)--2008.10.14-------------* Fix strip bug--2008.9.20-------------* Relax GHC package dependencies--2008.9.19------------* Change version system-* Add unescape_unicode_xml helper--### Fix:--* relax directory version--0.0.0.1.1------------relax pandoc version--0.0.0.1-----------compatible with newest Pandoc-added more helpers
+ changelog.md view
@@ -0,0 +1,99 @@+2009.6.25+--------++### Feature++* new mps light with minimal dependency+* cross platform+* wall-all clean++2009.5.13+---------++### Fix++* Minimal dependency++2009.4.50+----------++### Feature++* xml helper, io helper++### fix++* unescape unicode parser use (try)++2009.4.21+---------++### Fix++* starts_with returns true for the same string++2009.4.20+---------++### Feature++* require interpolatedstring-qq+* Add here as alias of istr ( Ruby like string using QQ ).++2008.11.15+----------++### Fix++* Replace `from_utf8` `to_utf8` to `b2u` `u2b`+* Comment on dynamic programming usage++2008.11.6+----------++### Feature++* UTF8 wrapper+* Almost -Wall clean++2008.10.25+----------++* More string helpers+* introducing ^++2008.10.15+----------++* Fix (use sub, as regexpr works per line)++2008.10.14+----------++* Fix strip bug++2008.9.20+----------++* Relax GHC package dependencies++2008.9.19+---------++* Change version system+* Add unescape_unicode_xml helper++### Fix:++* relax directory version++0.0.0.1.1+---------++relax pandoc version++0.0.0.1+--------++compatible with newest Pandoc+added more helpers
mps.cabal view
@@ -1,5 +1,5 @@ Name:                 mps-Version:              2009.5.13+Version:              2009.6.25 Build-type:           Simple Synopsis:             message passing style helpers Description:          message passing style helpers@@ -8,14 +8,14 @@ Maintainer:           Wang, Jinjing <nfjinjing@gmail.com> Build-Depends:        base Cabal-version:        >= 1.2-data-files:           README.markdown, changelog.markdown+data-files:           README.md, changelog.md category:             Development license-file:         LICENSE homepage:             http://github.com/nfjinjing/mps/  library-  ghc-options: -Wall -fno-warn-missing-signatures -fno-warn-name-shadowing -fno-warn-orphans -fno-warn-type-defaults-  build-depends: base, containers, array, parallel, time, bytestring >= 0.9, regexpr >= 0.3.4, parsec >= 2, utf8-string >= 0.3.3, directory, interpolatedstring-qq, base64-string, zlib, old-locale, unix, filepath+  ghc-options: -Wall+  build-depends: base >= 4 && < 5, containers, array, parallel, old-time, time, bytestring >= 0.9, regexpr >= 0.3.4, parsec >= 2, utf8-string >= 0.3.3, directory, interpolatedstring-qq, base64-string, zlib, old-locale, filepath, template-haskell   hs-source-dirs: src/-  exposed-modules:  MPS, MPSUTF8+  exposed-modules:  MPS, MPSUTF8, MPS.Light, MPS.Extra, MPS.Heavy, MPS.TH   other-modules:    MPS.UTF8
src/MPS.hs view
@@ -1,368 +1,7 @@-{-# LANGUAGE NoMonomorphismRestriction #-}--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----- base DSL-(.) :: a -> (a -> b) -> b-a . f = f a-infixl 9 .--(>) = (>>>)-infixl 8 >--(^) = flip fmap-infixl 8 ^--(/) :: FilePath -> FilePath -> FilePath-(/) = (</>)-infixl 5 /---- List-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---- Set requires Ord instance, so use nub when--- xs is not comparable-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, n-1.. 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----- only works for sorted list--- but could be infinite --- e.g. a `common` b `common` c-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----- faster reverse sort-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------ Map-to_h xs = xs.M.fromList---- BackPorts-on :: (b -> b -> c) -> (a -> b) -> a -> a -> c-(*) `on` f = \x y -> f x * f y---- Ord-compare_by = on compare-eq         = flip (==)-is         = eq-is_not a b = not (is a b)-isn't      = is_not-aren't     = is_not---- Tuple-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)------ Parallel-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        = fromGregorian-splash_date = toGregorian---- String-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---- Var-is_palindrom s = s.reverse.is s----- Integer-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----- Fold-to_list = toList---- Set-to_set  = S.fromList---- Array-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]-  ---- Parser-parse p s = case (P.parse p "" s) of-  Left err -> err.show.error-  Right x  -> x----- Debug-trace' x = trace (x.show) x----- String-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---- XML-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) ++ ";"---- IO-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---- Text-filter_comment = -  lines > map strip > reject null > reject (head > (== '#')) > unlines---- Time-now :: IO UTCTime-now = getCurrentTime--format_time :: String -> UTCTime -> String-format_time = formatTime defaultTimeLocale----- UTF8-b2u = Codec.decodeString-u2b = Codec.encodeString---- QQ--here = istr---- compress+module MPS (+    module MPS.Light+  , module MPS.Extra+) where -zip64, unzip64 :: String -> String-zip64 = B.pack > GZip.compress > B.unpack > C.encode-unzip64 = C.decode > B.pack > GZip.decompress > B.unpack+import MPS.Light+import MPS.Extra
+ src/MPS/Extra.hs view
@@ -0,0 +1,135 @@+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 :: String -> String -> [String]+split re xs+  | xs.match re .isJust = splitRegexPR re xs .reject empty+  | otherwise           = [xs]++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++-- 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
+ src/MPS/Heavy.hs view
@@ -0,0 +1,49 @@+module MPS.Heavy where++import Codec.Binary.Base64.String as C+import Data.Char+import MPS.Light+import Prelude hiding ((.), (^), (>), (/), elem, foldl)+import Text.ParserCombinators.Parsec (many, char, many1, digit, (<|>), Parser, anyChar, try)+import qualified Codec.Compression.GZip as GZip+import qualified Data.ByteString.Lazy.Char8 as B+import qualified Text.ParserCombinators.Parsec as P+++-- compress++zip64, unzip64 :: String -> String+zip64 = B.pack > GZip.compress > B.unpack > C.encode+unzip64 = C.decode > B.pack > GZip.decompress > B.unpack+  +-- Parser+parse :: P.GenParser tok () a -> [tok] -> a+parse p s = case (P.parse p "" s) of+  Left err -> err.show.error+  Right x  -> x+++-- XML+unescape_unicode_xml :: String -> String+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) ++ ";"
+ src/MPS/Light.hs view
@@ -0,0 +1,322 @@+module MPS.Light where++import Control.Arrow ((&&&), (>>>))+import Control.Category (Category)+import Data.Char+import Data.Foldable (elem, foldl, foldl', toList, Foldable)+import Data.Function (on)+import Debug.Trace+import Prelude hiding ((.), (^), (>), (/), elem, foldl, foldl1)+import System.FilePath ((</>))+import qualified Data.Array as A+import qualified Data.List as L+import qualified Data.Map as M+import qualified Data.Set as S++-- base DSL+(.) :: a -> (a -> b) -> b+a . f = f a+infixl 9 .++(>) :: (Category cat) => cat a b -> cat b c -> cat a c+(>) = (>>>)+infixl 8 >++(^) :: (Functor f) => f a -> (a -> b) -> f b+(^) = flip fmap+infixl 8 ^++(/) :: FilePath -> FilePath -> FilePath+(/) = (</>)+infixl 5 /++-- List+join :: [a] -> [[a]] -> [a]+join = L.intercalate++join' :: [[a]] -> [a]+join' = concat++first, second, third, forth, fifth :: [a] -> a+sixth, seventh, eighth, ninth, tenth :: [a] -> a+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++-- Set requires Ord instance, so use nub when+-- xs is not comparable+unique :: (Ord a) => [a] -> [a]+unique = to_set > to_list++is_unique :: (Ord a) => [a] -> Bool+is_unique xs = xs.unique.length == xs.length++same :: (Ord a) => [a] -> Bool+same = unique > length > is 1++times :: b -> Int -> [b]+times = flip replicate++upto :: (Enum a) => a -> a -> [a]+upto = flip enumFromTo++downto :: (Num t, Enum t) => t -> t -> [t]+downto m n = [n, n-1.. m]++remove_at :: Int -> [a] -> [a]+remove_at n xs = xs.take n ++ xs.drop (n+1)++insert_at, replace_at :: Int -> a -> [a] -> [a]+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 :: Int -> [a] -> a+at = flip (!!)++slice :: Int -> Int -> [a] -> [a]+slice l r = take r > drop l++cherry_pick :: [Int] -> [a] -> [a]+cherry_pick ids xs  = ids.map(xs !!)++reduce, reduce' :: (a -> a -> a) -> [a] -> a+reduce = L.foldl1+reduce' = L.foldl1'++inject, inject' :: (Foldable t) => a -> (a -> b -> a) -> t b -> a+inject  = flip foldl+inject' = flip foldl'++none_of :: (a -> Bool) -> [a] -> Bool+none_of f = any f > not++select, reject :: (a -> Bool) -> [a] -> [a]+select   = filter+reject f = filter (f > not)++inner_map :: (a -> b) -> [[a]] -> [[b]]+inner_map f         = map (map f)++inner_reduce :: (a -> a -> a) -> [[a]] -> [a]+inner_reduce f = map (reduce f)++inner_inject :: (Foldable t) => a -> (a -> b -> a) -> [t b] -> [a]+inner_inject x f = map (inject x f)++label_by :: (a -> c) -> [a] -> [(c, a)]+label_by f = map (f &&& id)++labeling :: (a -> c') -> [a] -> [(a, c')]+labeling f = map(id &&& f)++in_group_of :: Int -> [t] -> [[t]]+in_group_of _ [] = []+in_group_of n xs = h : t.in_group_of(n) where (h, t) = xs.splitAt(n)++split_to :: Int -> [a] -> [[a]]+split_to n xs = xs.in_group_of(size) where+  l = xs.length+  size = if l < n then 1 else l `div` n++apply, send_to :: a -> (a -> b) -> b+apply x f = f x+send_to   = apply++let_receive :: (a -> b -> c) -> b -> a -> c+let_receive f = flip f++map_send_to :: a -> [a -> b] -> [b]+map_send_to x = map (send_to(x))++belongs_to :: (Foldable t, Eq a) => t a -> a -> Bool+belongs_to = flip elem++has :: (Foldable t, Eq b) => b -> t b -> Bool+has = flip belongs_to++indexed :: (Num t, Enum t) => [b] -> [(t, b)]+indexed = zip([0..])++map_with_index :: (Num t, Enum t) => ((t, b) -> b1) -> [b] -> [b1]+map_with_index f = indexed > map f++ljust, rjust :: Int -> a -> [a] -> [a]+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, lb :: (a -> Bool) -> [a] -> [a]+ub   = takeWhile+lb f = dropWhile ( f > not )++between :: (a -> Bool) -> (a -> Bool) -> [a] -> [a]+between a b xs = xs.lb a .ub b++not_null :: [a] -> Bool+not_null = null > not++powerslice :: [a] -> [[a]]+powerslice xs = [ xs.slice j (j+i) |+  i <- l.downto 1,+  j <- [0..l - i]+  ]+  where l = xs.length++-- only works for sorted list+-- but could be infinite +-- e.g. a `common` b `common` c+common :: (Ord a) => [a] -> [a] -> [a]+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+++-- faster reverse sort+rsort :: (Ord a) => [a] -> [a]+rsort xs = xs.L.sortBy(\a b -> b `compare` a)++encode :: (Eq a) => [a] -> [(Int, a)]+encode xs = xs.L.group.map (length &&& head)++decode :: [(Int, a)] -> [a]+decode xs = xs.map(\(l,x) -> l.times x).join'+++only_one :: [a] -> Bool+only_one [_]    = True+only_one _      = False++concat_map :: (a -> [b]) -> [a] -> [b]+concat_map = concatMap++-- Fold+to_list :: (Foldable t) => t a -> [a]+to_list = toList++-- Set+to_set :: (Ord a) => [a] -> S.Set a+to_set = S.fromList++-- Map+to_h :: (Ord k) => [(k, a)] -> M.Map k a+to_h xs = xs.M.fromList++-- Array+to_a :: [a] -> A.Array Int a+to_a xs      = A.listArray (0, xs.length - 1) xs++to_a' :: (A.Ix i) => (i, i) -> [e] -> A.Array i e+to_a' i xs = A.listArray i xs++hist :: (Num e, A.Ix i) =>  (i, i) -> [i] -> A.Array i e+hist bnds ns = A.accumArray (+) 0 bnds [(n, 1) | n <- ns, A.inRange bnds n]+  ++-- Ord+compare_by :: (Ord b) => (a -> b) -> a -> a -> Ordering+compare_by = on compare++eq, is, is_not, isn't, aren't :: (Eq a) => a -> a -> Bool+eq         = flip (==)+is         = eq+is_not a b = not (is a b)+isn't      = is_not+aren't     = is_not++-- Tuple+swap :: (a, b) -> (b, a)+swap (x,y) = (y,x)++tuple2 :: [a] -> (a, a)+tuple2 = first &&& last++tuple3 :: [a] -> (a, a, a)+tuple3 xs = (xs.first, xs.second, xs.third)++list2 :: (a, a) -> [a]+list2 (x,y) = [x,y]++list3 :: (a, a, a) -> [a]+list3 (x,y,z) = [x,y,z]++filter_fst :: (a -> Bool) -> [(a, b)] -> [(a, b)]+filter_fst f = filter(fst > f)++filter_snd :: (b -> Bool) -> [(a, b)] -> [(a, b)]+filter_snd f = filter(snd > f)++only_fst :: [(a, b)] -> [a]+only_fst = map fst++only_snd :: [(a, b)] -> [b]+only_snd = map snd++map_fst :: (a -> b) -> [(a, c)] -> [(b, c)]+map_fst f = map(\(a,b) -> (f a, b))++map_snd :: (a -> b) -> [(c, a)] -> [(c, b)]+map_snd f = map(\(a,b) -> (a, f b))++pair :: ((a, b) -> c) -> a -> b -> c+pair f a b = f (a,b) ++triple :: ((a, b, c) -> d) -> a -> b -> c -> d+triple f a b c = f (a,b,c)++splash :: (a -> b -> c) -> (a, b) -> c+splash f (a,b) = f a b++splash3 :: (a -> b -> c -> d) -> (a, b, c) -> d+splash3 f (a,b,c) = f a b c++twin :: a -> (a, a)+twin x = (x,x)++-- Integer+from_i :: (Integral a, Num b) => a -> b+from_i = fromIntegral++explode :: (Show a) => a -> [Int]+explode n = n.show.map digitToInt++-- String+lower, upper :: String -> String+lower = map toLower+upper = map toUpper++starts_with, ends_with :: String -> String -> Bool+starts_with = L.isPrefixOf+ends_with   = L.isSuffixOf++capitalize :: String -> String+capitalize [] = []+capitalize (x:xs) = [x].upper ++ xs.lower++to_s :: (Show a) => a -> String+to_s x = x.show++++-- Simple Math+-- Var+is_palindrom :: (Eq a) => [a] -> Bool+is_palindrom s = s.reverse.is s++-- Debug+trace' :: (Show a) => a -> a+trace' x = trace (x.show) x
+ src/MPS/TH.hs view
@@ -0,0 +1,8 @@+module MPS.TH where++import Language.Haskell.TH.Quote (QuasiQuoter)+import Text.InterpolatedString.QQ++-- QQ+here :: QuasiQuoter+here = istr
src/MPS/UTF8.hs view
@@ -1,24 +1,41 @@ module MPS.UTF8 where -import System.IO.UTF8 (readFile, writeFile)-import qualified MPS as MPS-import Prelude hiding ((.), (^), readFile, writeFile, (>)) 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 x       = MPS.ls (x.u2b) ^ map b2u-mkdir_p    = u2b > createDirectoryIfMissing True +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
src/MPSUTF8.hs view
@@ -1,6 +1,6 @@ module MPSUTF8 (-  module MPS,-  module MPS.UTF8+    module MPS+  , module MPS.UTF8 ) where  import MPS hiding (split, gsub, sub, match, ls, strip)