module Pleac where
import Prelude hiding (($),(^),(.),(!!),map,take,lookup,drop,splitAt,reverse,filter,takeWhile,dropWhile,null,foldl)
import Common
str = "\\n"
str2 = "Jon 'Maddog' Orwant"
str3 = "\n"
str4 = "Jon \"Maddog\" Orwant"
str5 = "This is a multiline here document\n" ++
"terminated by on a line by itself\n"
s = "This is what you have"
first = s!![0]
start = s!![5,6]
rest = s!![13..]
las = s!![-1]
las2 = s.last
end = s!![-4 .. -1]
piece = s!![-8 .. -5]
[lead,ss1,ss2,trailing] = s.unpack [Grab 2, Forward 3, Grab 1, Grab 2, GrabAll]
[lead2,ss12,ss22,trailing2] = s.match "^(..)...(.)(..)(.*)"
[lead3,ss13,ss23,trailing3] = s.match "^(.{2}).{3}(.)(.{2})(.*)"
fivers = s.unpack ((Grab 5).replicate (s.length `div` 5))
characters = s
s' = s.substr 5 2 "wasn't"
s'' = s'.substr2 (-12) "ondrous"
s''' = s''.substr 0 1 ""
s'''' = s'''.substr2 (-10) ""
m = if s!![-10 .. -1] =~ "have"
then putStrLn "Pattern matches in last 10 characters"
else return ()
m' = putStrLn "Pattern matches in last 10 characters" `when` (s!![-10 .. -1] =~ "have" )
news = s!![0..5].(substS "is" "at" [Global_Match]) ++ s!![6..]
a1 = "make a hat"
a1' = a1!![-1] ++ a1!![1..(a1.length -2)] ++ a1!![0]
b1 = "to be or not to be"
b2 = b1.unpack [Forward 6, Grab 6]
[b3,c3] = b1.unpack [Forward 6, Grab 2, Backward 5, Grab 2]
cut2fmt xs = xs.foldl aux (1,[]).snd.(GrabAll:).reverse
where aux (n,l) i = (i,(Grab (i - n)) : l)
fmt = cut2fmt [8,14,20,26,30]
v3 = "a" ||| "b"
v4 = "" ||| "b"
v5 = (2::Int) &&& "ee"
v6 = (0::Int) &&& "ee"
v3' = v3 ||| v4
dir = argv >>> (\x -> (x ||| ["/tmp"]).head)
dir' = argv >>> ((||| ["/tmp"]) $ head)
i1 = ord 'a'
c1 = chr 97
ibm = "HAL".map next_char
s1 = "unique chars are: " ++ ("an apple a day".unique.sort)
sum1 = ("sum is " ^ s1.map ord.sum).putStrLn
s2 = s1.reverse
s3 = s1.words.reverse.unwords
s3' = s1.split " ".reverse.join " "
s3''= s1.split "\\s+".reverse.join " "
long_palindromes = cat "/usr/share/dict/words" >>> filter(\s -> s == s.reverse && s.length > 4)
expand_tabs = split "\t" $ (foldr1 (\a b -> a ++ (times (8 - a.length `mod` 8) ' ') ++ b))
s4 = "I am 17 years old".subst "\\d+" (\n -> show ((read n) * 2))
s5 = "bo beep".upcase
s6 = s5.downcase
s7 = s6.capitalize
s8 = "thIS is a loNG liNE".words.map capitalize
s9 = "I have "^10+1^" guanacos."
multi = (substS "^\\s+" "" [Global_Match,Multi_Line] ° unlines) [
" This is a multiline here document",
" terminated by nothing"
]
wrap width s = let (all, line) = (words s).foldl (\ (all, line) w ->
if (line++" "++w).length > width
then (all++[line], w)
else (all, line++" "++w)
) ([],"") in
join "\n" (all++[line])
escaping = "Mom Said, \"Don't do that.\""
esc1 = escaping.gsubst "['\"]" ("\\"++)
esc3 = escaping.gsubst "[^A-Z]" ("\\"++)
esc4 = escaping.gsubst "[^\\w]" ("\\"++)
s10 = " titi".substS "^\\s+" "" []
s11 = " titi ".substS "\\s+$" "" []
trim = substS "^\\s+" "" [] ° substS "\\s+$" "" []
parse_csv s = let re = ["\"([^\"\\\\]*(\\\\.[^\"\\\\]*)*)\",?"
,"([^,]+),?"
,","
].join "|"
xxs = s.gmatch re in
xxs.map (\xs -> (xs!(0::Int)) ||| (xs!(2::Int)))
testline = "XYZZY,\"\",\"O'Reilly, Inc\",\"Wall, Larry\",\"a \\\"glug\\\" bit,\",5,\"Error, Core Dumped\""
mparse = testline.parse_csv.foldM(\i x -> putStrLn (i^" : "^x) >>> (\_ -> i+1)) 0
soundex s = x:'-':((res++[0,0,0]).take 3.map show.concat)
where group = [("AEIOUYHW",0)
,("BFPV",1)
,("CGJKQSXZ",2)
,("DT",3)
,("L",4)
,("MN",5)
,("R",6)
]
code x = group.find (\(letters,_) -> x `elem` letters).just.snd
(x:xs) = s.upcase.substS "[^\\w]" "" [Global_Match]
xs' = if xs.length > 0 && xs.head.code == x.code && x.code > 0 then xs.tail else xs
trim xs = xs.dropWhile (\x -> x.code == 0)
next_code xs = xs.trim.(\xs -> if length xs > 0 then xs.head.code else 0)
aux xs = case trim xs of
[] -> []
(x:xs) -> if x.code == xs.next_code then aux xs else x.code:aux xs
res = aux xs'
soundexes = ["holmes"
,"adomomi"
,"vonderlehr"
,"ball"
,"shaw"
,"jackson"
,"scanlon"
,"saintjohn"
,"kingsmith"
,"booth-davis"
,"Knuth"
,"Kant"
,"Lloyd"
,"Ladd"
].map soundex
data Passwd_entry = Passwd_entry {pw_name,pw_passwd,pw_comment,pw_dir,pw_shell::String, pw_uid,pw_gid::Int}
deriving (Eq,Show)
getpwent s = let [name1,passwd1,uid1,gid1,comment1,dir1,shell1] = s.split ":" in
Passwd_entry {pw_name=name1,pw_passwd=passwd1,pw_uid=read uid1,pw_gid=read gid1,
pw_comment=comment1,pw_dir=dir1,pw_shell=shell1}
msoundex = do putStr "Lookup user: "
user <- getLine
cat "/etc/passwd" >>=
each (\l -> let Passwd_entry {pw_name=name,pw_comment=comment} = l.getpwent
[firstname,lastname] = comment.match "(\\w+)[^,]*\\b(\\w+)"
soundex' xs = if xs == [] then "" else xs.soundex in
if user.soundex' `elem` (map soundex' [name,firstname,lastname])
then putStrLn (name++": "++firstname++" "++lastname)
else return ()
)
is_integer s = if s =~ "^[+-]?\\d+$"
then putStrLn "is an integer"
else putStrLn "is not"
m0 s = do putStrLn "has non digits" `when` (s =~ "[^\\d]")
putStrLn "not a natural" `unless` (s =~ "^\\d+$")
putStrLn "not an integer" `unless` (s =~ "^-?\\d+$")
putStrLn "not an integer" `unless` (s =~ "^[+-]?\\d+$")
putStrLn "not a decimal" `unless` (s =~ "^-?\\d+\\.\\d*$")
putStrLn "not a float" `unless` (s =~ "^[+-]?\\d+((\\.\\d+([eE]-?\\d+)?)|([eE]-?\\d+))$")
m0' s = let sign = "-"
opt_sign = sign ++ "?"
dec_number = "\\d+"
integer = opt_sign ++ dec_number
exp = "eE" ++ opt_sign ++ dec_number
real = "(" ++ opt_sign ++ dec_number ++ "\\." ++ dec_number ++ exp ++"?" ++ ")" ++
"|" ++ "(" ++ opt_sign ++ dec_number ++ exp ++ ")" in
do putStrLn "not a natural" `unless` (s ==~ dec_number)
putStrLn "not an integer" `unless` (s ==~ integer)
putStrLn "not a decimal" `unless` (s ==~ (integer ++ "\\." ++ dec_number))
putStrLn "not a float" `unless` (s ==~ real)
m0test = m0 "124"
equal_num n1 n2 nbdecimal = (abs (n1 - n2)) < 1 / (10 ^^ nbdecimal)
eqnum = equal_num 10.001 10.002 4
wage = 536
week = 40 * wage
weekwage = putStrLn ("One week's wage is: $"++show_float 2 (tonum week/100.0))
i = 2.3.round
a2 = 0.255
sa2 = show_float 2 a2
mprinta = putStrLn ("Unrounded: "^a2^"\nRounded: "^sa2)
mprintfloat = do putStrLn "number\tint\tfloor\tceil"
[3.3 , 3.5 , 3.7, -3.3].each(\n -> putStrLn ((show_float 1 n)^"\t"^
(n.round)^"\t"^
(n.floor)^"\t"^
(n.ceiling)))
bin2i xs = aux 1 (reverse xs)
where aux power [] = 0
aux power (x:xs) = aux (2*power) xs+(if x == '0' then 0 else power)
bin2i' xs = xs.reverse.map (\c -> read [c]).zipWith (\a b -> b*(2^^a)) [0..].sum
i10 = bin2i' "0110110"
i2bin i = if i == 0 then "0" else aux i
where aux i = if i == 0 then "" else aux (i `div` 2) ++ show (i `mod` 2)
bin10 = i2bin 54
m1 = putStr "Infancy is: " >> [0..2].each(\e -> putStr (e^" "))
m2 = putStr "Infancy is: " >> [0..2].map show.unwords.putStr
inttorom n = (concat ° reverse) (zipWith roman sets digits) where
digits = reverse (map (\x -> fromInt (read [x])) (show n))
roman (i,v,x) n = case n of {
0 -> []; 1 -> [i]; 2 -> [i,i]; 3 -> [i,i,i]; 4 -> [i,v];
5 -> [v]; 6 -> [v,i]; 7 -> [v,i,i]; 8 -> [v,i,i,i]; 9 -> [i,x] }
sets = [('I','V','X'), ('X','L','C'), ('C','D','M'), ('M','?','?')]
mroman = putStrLn ("Roman for "^15^" is :"^inttorom 15)
ran = rand (25, 75)
chars = concat [['A'..'Z'],['a'..'z'],['0'..'9'],"!@$%^&*"]
password = [1..8].mapM (\_ -> rand (0, chars.length -1) >>> (chars!))
randfixed = do srand 2
rand(1,10)
gaussian_rand = do r1 <- stdrand
r2 <- stdrand
let u1 = 2 * r1 - 1
u2 = 2 * r2 - 1
w = u1*u1 + u2*u2 in
if w >= 1 then gaussian_rand
else let w2 = sqrt ((-2 * log w)/w) in
return [u2*w2, u1*w2]
mean = 25
sdev = 2
salary = gaussian_rand >>> (\l -> l.head * (tonum sdev) + (tonum mean))
msalary = do r <- salary
putStrLn ("You have been hired at $"^show_float 2 r)
deg2rad d = d * pi / 180
rad2deg r = r * 180 / pi
sin_val = sin pi
cos_val = cos pi
tan_val = tan pi
asin_val = asin 1
acos_val = acos 1
log_e = log 10
log_10 = log10 100
log10 = logBase 10
answer = logBase 10 10000
mlog = putStrLn ("log10(10,000)="^answer)
matrixa = Matrix[[3, 2, 3],
[5, 9, 8]]
matrixb = Matrix[[4, 7],
[9, 3],
[8, 1]]
matrixc = matrixa * matrixb
masize = matrixa.row_size
mbsize = matrixa.column_size
ca = 3 :+ 5
cb = 2 :+ -2
mcomplex = putStrLn ("c = "^(ca*cb))
cc = ca*cb
cd = 3 + 4*complex_i
mcomplex2 = putStrLn ("sqrt("^cd^") = "^sqrt cd)
i2 = hex "0x45"
i3 = oct "0o45"
m3 = do putStrLn "Gimme a number in decimal, octal, or hex: "
s <- getLine
let i = s.pattern_matches [("^0x", hex s),("^0o", oct s),("", read s)] in
putStrLn (concat [show i," ",tohex i," ", tooct i,"\n"])
m3' = do putStrLn "Enter file permission in octal: "
permissions <- getLine
putStrLn ("The decimal value is "^permissions.oct)
commify s = if s.length <= 3 then s else
let (a,b) = splitAt (s.length -3) s in commify a ++ "," ++ b
plurals i = if i > 1 then "s" else ""
pluralies i = (i > 1) ? ("ies","y")
hours = 2
century = 2
flies = 3
mplural = putStrLn ("It took "^hours^" hour"^(plurals hours))
mplural2 = putStrLn ("It took "^century^" centur"^(pluralies century))
single_level = [ "this", "that", "the", "other" ]
a = ["quick", "brown", "fox"]
a' = "Why are you teasing me?".words
big_array = cat "pleac.hs"
name1 = "toto"
banner_scalar = "Speak, "^name1^" and welcome!"
his_host = "www.haskell.org"
host_info = exec ("host "^his_host)
psinfo1 = exec ("ps $$")
banner_array1 = ["Costs","only","$4.95"]
banner_array2 = "Costs only $4.95".words
banner_array3 = "Costs only $4.95".split " "
commify_series :: [String] -> String
commify_series [] = ""
commify_series [x] = x
commify_series xs = join ", " (init xs) ++ " and " ++ (last xs)
array = ["red", "yellow", "green"]
s12 = "I have "++commify_series array++" marbles"
marray1 = putStrLn ("I have "^(concat array)^" marbles")
marray2 = putStrLn ("I have "^(unwords array)^" marbles")
change_size n xs = if n <= xs.length then take n xs
else xs++(null_val.replicate (n - xs.length))
change_val ix e xs = let xs' = if ix <= xs.length then xs else change_size ix xs in
xs'!![0..ix-1]++[e]++xs'!![ix+1..]
array2 = array.change_size 5
array3 = array.change_val 5 "toto"
array4 = "toto".replicate 5
what_about_that_array x =
"The array now has "^length x^"elements.\n"^
"The index of the last element is "^length x - 1^".\n"^
"Element .3 is`"^x!(3::Int)^"'.\n"
s13 = "Crosby Stills Nash Young".words.what_about_that_array
m4 = env >>= (\l -> l.keys.sort.each(\var -> (var ^"=" ^ (l!var)).putStrLn))
m5 = env >>= (\l -> l.each(\(var,val) -> (var^"="^val).putStrLn))
m6 = env >>= (\l -> l.toList.sortBy(\(a,_) (b,_) -> a <=> b).each(\(var,val) -> (var^"="^val).putStrLn))
users = exec "who" >>> map (words $ head) $ sort $ unique
users2 = exec "who" >>> map (match "(\\w+)" $ head) $ sort $ unique
m10 = do l <- users
putStrLn ("users logged in:"++(commify_series l))
l1 = [1..5] `difference` [2,5]
instance (Eq a,Show a) => Num ([a]) where
a + b = a `union` b
(-) a b = a `difference` b
(*) = intersect
l1' = [1..5] - [2,5]
l2 = [1..5]
l3 = [2,5,7]
l4 = l2 `union` l3
l4' = l2 + l3
l5 = l2 `intersect` l3
l5' = l2 * l3
l6 = difference (union l2 l3) (intersect l2 l3)
l6' = (l2 + l3) - (l2 * l3)
members = ["Times","Flies"]
initiates = ["An", "Arrow"]
newmembers = members ++ initiates
newmembers2 = members.insert_at 2 ("Like":initiates)
newmembers3 = members.replace [(0, "Fruit")]
newmembers4 = members.replace [(2, "Fruit"),(3,"Banana")]
reversed = [1..5].reverse
array5 = [3,2,5,1]
descending = array5.sort.reverse
descending' = array5.sortBy (\a b -> b <=> a)
descending2 = array5.sortBy (flip (<=>))
(front,newarray) = array5.splitAt 1
(newarray',end') = array5.splitAt (array5.length - 1)
shift2 (x:y:ys) = ((x,y),ys)
pop2 xs = let (a,[x,y]) = splitAt (xs.length -2) xs in ((x,y),a)
friends = "Peter Paul Mary Jim Tim".words
((this, that), newfriends) = friends.shift2
beverages = "Dew Jolt Cola Sprite Fresca".words
(pair,newbeverages) = beverages.pop2
data Employee = Employee {category,name:: String, income::Int} deriving (Show,Eq)
employees = [Employee {category="neuneu",name="ben",income=1000}
,Employee {category="neuneu",name="pixel",income=1000}
,Employee {category="engineer",name="pad",income=27000}
,Employee {category="engineer",name="guit",income=100000}
]
(Just highest_engineer) = employees.find(\employee -> employee.category == "engineer")
s14 = "Highest paid engineer is: "++ highest_engineer.name
bigs = [5..200].filter (>50)
matching = exec "who" >>> filter (=~ "^gnat")
engineers = [ x | x <- employees, category x == "engineer"]
engineers' = employees.filter (\x -> category x == "engineer")
secondary_assistance = employees.filter(\x -> x.income >= 26000 && x.income < 30000)
sorted1 = [11,5,2,8].sort
sorted2 = ["11","5","1","8"].sort
sorted2' = ["11","5","1","8"].sortBy (\a b -> ((read a)::Int) <=> read b)
pidsorted = do ps <- exec "ps ux"
myenv <- env
ps!![1..]
.filter (=~ (myenv!"USER"))
.map (words $ (!1))
.sortBy (\a b -> ((read a)::Int) <=> read b)
.each putStrLn
mkill = do putStr "Select a process ID to kill:"
pids <- getLine
(putStrLn "Exiting" >> exit 0) `unless` (pids =~ "\\d+")
_ <- exec ("kill "^pids)
_ <- exec ("sleep 2")
exec ("kill -9 "^pids)
unordered = [1,-3,2,6]
ordered = unordered.sort
precomputed = unordered.map (\e -> [abs e, e])
ordered_precomputed = precomputed.sortBy (\a b -> (a!0) <=> (b!0))
ordered' = ordered_precomputed.map (!1)
ordered'' = unordered.map (\e -> [abs e,e]).sortBy (\a b -> (a!0) <=> (b!0)).map (!1)
employee_sorted = employees.sortBy (\a b -> (a.name) <=> (b.name))
musers = cat "/etc/passwd" >>= (map (split ":" $ head) $ sort $ mapM putStrLn)
musers' = cat "/etc/passwd" >>= (\x -> x.map (\l -> l.split ":".head).sort.each putStrLn)
circular = [1,2,3,4,5]++circular
grab_and_rotate (x:xs) = (x, xs++[x])
mprocess1 = loop [1,2,3,4,5] where
loop processes = do putStrLn ("Handling process"^process)
system "sleep 1"
loop newprocess
return ()
where (process, newprocess) = grab_and_rotate processes
mprocess2 = loop circular where
loop (x:xs) = do putStrLn ("Handling process"^x)
system "sleep 1"
loop xs
return ()
permut [] = []
permut [x] = [[x]]
permut (x:xs) = xs.permut.map (insert x).concat
where insert x [] = [[x]]
insert x (y:ys) = (x:y:ys) : map (y:) (insert x ys)
fact 0 = 1
fact (n+1) = (n+1) * fact n
randomizing xs = rand (0, xs.length.fact -1) >>> ((xs.permut)!)
bigint = fact 500
permute = permut
#!/usr/bin/runhugs
module Main where
import Prelude hiding ((.))
permut [] = []
permut [x] = [[x]]
permut (x:xs) = xs.permut.map (insert x).concat
where insert x [] = [[x]]
insert x (y:ys) = (x:y:ys) : map (y:) (insert x ys)
fact 0 = 1
fact (n+1) = (n+1) * fact n
(.) o f = f o
(°) f g x = f (g x)
main = do line <- getLine
line.words.permut.mapM_(putStrLn ° unwords)
age = [ ("Nat",24)
,("Jules",25)
,("Josh",17)]
age':: Assoc String Int
age' = fromList [ ("Nat",24)
,("Jules",25)
,("Josh",17)]
age1:: Assoc String Int
age1 = empty
age2 = age1.insert ("Nat",24)
age3 = age2.insert ("Jules",25)
age4 = age3.insert ("Josh",17)
food_color :: Assoc String String
food_color = fromList [ "Apple" ==> "red"
,"Banana" ==> "yellow"
,"Lemon" ==> "yellow"
,"Carrot" ==> "orange"
]
food_color' = food_color.insert ("Raspberry" ==> "pink")
mfood_color = putStrLn ("Know foods: "^(unwords (food_color.keys)))
mhash = ["Banana", "Martini"].mapM(\name ->
putStrLn (name^" is a "^(food_color.has_key name ? ("food","drink")))
)
food_color2 = food_color.delete_key "Banana"
mhash2 = food_color.each (\(food,color) ->
putStrLn (food^" is "^color)
)
mhash3 = food_color.each_key(\food ->
putStrLn (food^" is "^(food_color!food))
)
mhash4 = food_color.keys.sort.each(\food ->
putStrLn (food^" is "^(food_color!food))
)
#!/usr/bin/runhugs -98
module Main where
import Prelude hiding (($),(^),(.),(!!),map,take,lookup,drop,splitAt,reverse,filter,takeWhile,dropWhile,null,foldl,length)
import Common
main = do lines <- (<>)
lines.foldl(\from l ->
if l =~ "^From: "
then let [name] = l.match "^From: (.*)" in from.update name (+1)
else from
) (empty::AssocDefault String Int)
.toList.sortBy (\(_,a) (_,b) -> b <=> a)
.each (\(a,b) -> putStrLn (b^": "^a))
mhash5 = putStrLn (age4.show)
mhash5' = age4.each (\(k,v) -> putStrLn (k^" => "^v))
mhash6 = age4.toList.sortBy (\a b -> (a.fst) <=> (b.fst)).each(\(k,v) -> putStrLn (k^" => "^v))
mhash7 = age4.toList.sortBy (\a b -> (a.snd) <=> (b.snd)).each(\(k,v) -> putStrLn (k^" => "^v))
mttys = do who <- exec "who"
who.foldl(\ttys l ->
let (user:tty:_)= l.words in
ttys.update tty (insert user)
) (empty::AssocDefault String (SetList String))
.toList.sortBy (\(a,_) (b,_) -> b <=> a)
.each (\(a,b) -> putStrLn (a^": "^commify_series (b.toList)))
surname:: Assoc String String
surname = fromList ["Mickey" ==> "Mantle", "Babe" ==> "Ruth"]
mhash8 = surname.keyss "Mantle".head.putStrLn
invert_surname:: Assoc String String
invert_surname = surname.toList.map (\(a,b) -> (b,a)).fromList
#!/usr/bin/runhugs -98
module Main where
import Prelude hiding (($),(^),(.),(!!),map,take,lookup,drop,splitAt,reverse,filter,takeWhile,dropWhile,null,foldl,length)
import Common
color :: Assoc String String
color = fromList [
"Apple" ==> "red",
"Banana" ==> "yellow",
"Lemon" ==> "yellow",
"Carrot" ==> "orange"
]
main = do args <- argv
usage "foodfind food_or_color" `when` (args.null)
let given = args.head in
do putStrLn (given^" is a good with color "^(color!given))
`when` (color.has_key given)
putStrLn (given^" is a color with food "^(color.keyss given.head))
`when` (color.has_value given)
mhash9 = age4.toList.sortBy (\a b -> (a.fst) <=> (b.fst)).each (\(k,v) ->
putStrLn (k^" is "^v))
mhash10 = age4.toList.sortBy (\a b -> (a.snd) <=> (b.snd)).each (\(k,v) ->
putStrLn (k^" is "^v))
mhash11 = food_color.toList.sortBy (\a b -> (a.snd.length) <=> (b.snd.length)).each (\(k,v) ->
putStrLn (k^" is "^v))
drink_color:: Assoc String String
drink_color = fromList ["Galliano" ==> "yellow", "Mai Tai" ==> "blue"]
ingested_color = drink_color `union` food_color
substance_color :: IO (Assoc String Int)
substance_color = [food_color, drink_color]
.foldM (\a i ->
i.keys.foldM (\a k ->
if a.has_key k
then putStrLn ("Warning: "^k^" seen twice") >> (return a)
else return (a.insert (k,1))
) a
) empty
common = food_color.keys * drink_color.keys
this_not_that = food_color.keys - drink_color.keys
count:: AssocDefault String Int
count = ["toto","toto","toto","tata","tata","tutu"].foldl (\a s -> a.update s (+1)) empty
father:: Assoc String String
father = fromList ["Cain" ==> "Adam",
"Abel" ==> "Adam",
"Seth" ==> "Adam",
"Enoch" ==> "Cain",
"Irad" ==> "Enoch",
"Mehujael" ==> "Irad",
"Methusael" ==> "Mehujael",
"Lamech" ==> "Methusael",
"Jabal" ==> "Lamech",
"Jubal" ==> "Lamech",
"Tubalcain" ==> "Lamech",
"Enos" ==> "Seth"
]
children :: AssocDefault String (SetList String)
children = father.foldl (\a (k,v) -> a.update v (insert k)) empty
module Common ( module Common
, module Regexp
, module System
, module Complex
, module Char
, module Numeric
, foldM
, elemIndex, elemIndices,
find, findIndex, findIndices,
nub, nubBy, delete, deleteBy, (\\), deleteFirstsBy,
union, unionBy, intersect, intersectBy,
intersperse, transpose, partition, group, groupBy,
inits, tails, isPrefixOf, isSuffixOf,
mapAccumL, mapAccumR,
sort, sortBy, insert, insertBy, maximumBy, minimumBy,
genericLength, genericTake, genericDrop,
genericSplitAt, genericIndex, genericReplicate,
zip4, zip5, zip6, zip7,
zipWith4, zipWith5, zipWith6, zipWith7,
unzip4, unzip5, unzip6, unzip7, unfoldr
) where
import Prelude hiding (($),(^),(.),(!!),map,take,lookup,drop,splitAt,reverse,filter,takeWhile,dropWhile,null,foldl)
import List hiding ((!!),map,take,lookup,drop,splitAt,reverse,filter,takeWhile,dropWhile,null,insert,union,intersect,delete,partition,foldl,length)
import Random hiding (split)
import Monad hiding (join,when,unless)
import Regexp
import System
import Complex
import Char
import Numeric
substr start len insert s =
if start >= 0 then s!![0..start-1] ++ insert ++ s!![start+len..]
else s!![0..(length s + start -1)] ++ insert ++ s!![start+len.. -1]
substr2 start insert s = substr start (if start >= 0 then (length s - start) else -start) insert s
data Unpack_option = Grab Int
| Forward Int
| Backward Int
| GrabAll
deriving Show
unpack :: [Unpack_option] -> [a] -> [[a]]
unpack opt s = opt.foldl aux (0,[]).snd.reverse
where aux (n,l) (Grab i) = (n+i, s!![n..n+i-1] : l)
aux (n,l) (Forward i) = (n+i, l)
aux (n,l) (Backward i) = (n-i, l)
aux (n,l) GrabAll = (length s + 1, s!![n..] : l)
subst re f s = let matchresult = searchS re [] s in
if matchedAny matchresult then
beforeMatch matchresult ++
f (wholeMatch matchresult) ++
afterMatch matchresult
else s
gsubst re f s = let matchresult = searchS re [] s in
if matchedAny matchresult then
beforeMatch matchresult ++
f (wholeMatch matchresult) ++
(gsubst re f (afterMatch matchresult))
else s
(=~) s re = let matchresult = searchS re [] s in
matchedAny matchresult
(==~) s re = s =~ ("^"++s++"$")
match re s = let (max,re2) = re.foldl (\(i,acc) c ->
if c == '(' then (i+1,acc++" "++show i++"@(") else (i,acc++[c])
) (1,[])
matchresult = s.searchS re2 []
subs = allSubexps matchresult
subs2 = if (subs.length > 0 && subs.last.fst /= show (max-1))
||(subs.length == 0 && max > 1)
then subs++[(show (max-1),"")]
else subs
subs3 = subs2.foldl (\(i,acc) (j,str)->
if show i == j then (i+1, acc++[str])
else ((read j)+1, acc++replicate ((read j)-i) ""++[str])
) (1,[]) in
subs3.snd
gmatch re s = let (max,re2) = re.foldl (\(i,acc) c ->
if c == '(' then (i+1,acc++" "++show i++"@(") else (i,acc++[c])
) (1,[])
matchresult = s.searchS re2 [] in
if matchedAny matchresult then (match re s):(gmatch re (afterMatch matchresult))
else []
pattern_matches ((re, v):xs) s = if s =~ re then v else pattern_matches xs s
(?) True (a,b) = a
(?) False (a,b) = b
(==>) a b = (a,b)
(.) o f = f o
(.>) m f = m >>= (\o -> return (f o))
(°) f g x = f (g x)
(f $ g) x = (g ° f) x
next_char c = chr (ord c + 1)
show_float i f = showFFloat (Just i) f ""
fixpoint f d | f d == d = d
| otherwise = fixpoint f (f d)
times = replicate
join e [] = []
join e xs = foldr1 (\a x -> a ++ e ++ x) xs
split re xs = let matchresult = searchS re [] xs in
if matchedAny matchresult
then (beforeMatch matchresult):(split re (afterMatch matchresult))
else [xs]
break_char c f s = let (a,b) = break (== c) s in
if b == [] then a else f a (tail b)
upcase xs = map toUpper xs
downcase xs = map toLower xs
capitalize (x:xs) = toUpper x : xs
tonum x = fromInteger x
hex ('0':('x':s)) = fst (head (readHex s))
oct ('0':('o':s)) = fst (head (readOct s))
tohex i = "0x"++aux i
where aux i = if i == 0 then "" else aux (i `div` 16)++((['0'..'9']++['A'..'F'])!![i `mod` 16])
tooct i = "0o"++aux i
where aux i = if i == 0 then "" else aux (i `div` 8)++(['0'..'7']!![i `mod` 8])
unique :: (Eq a) => [a] -> [a]
unique = nub
insert_at :: Int -> [a] -> [a] -> [a]
insert_at i toadd xs = let (a,b) = splitAt i xs in
a++toadd++b
replace :: [(Int, a)] -> [a] -> [a]
replace assoc xs = assoc.foldl (\a (i,e) -> let (x,y) = splitAt i a in x++[e]++y ) xs
shift (x:xs) = (x,xs)
pop xs = (init xs, last xs)
foldl_index f acc xs = foldl f acc (zip [1..] xs)
complex_i = 0 :+ 1
(<=>) a b = compare a b
infixl 1 >>>
(>>>) monad f = monad >>= (return ° f)
eval x = x >>= (putStrLn ° show)
action `when` bool = if bool then action else return ()
action `unless` bool = action `when` (not bool)
cat file = readFile file >>> lines
contents = getContents >>> lines
(<>) = do l <- argv
if (l == []) then contents else foldM (\a e -> cat e >>> (a++)) [] l
exec s = do _ <- system (s++" > /tmp/file")
cat "/tmp/file"
rand :: (Int, Int) -> IO Int
rand = getStdRandom ° randomR
stdrand :: IO Double
stdrand = getStdRandom (randomR (0,1))
srand val = setStdGen (mkStdGen val)
env :: IO (Assoc String String)
env = exec "env" >>> (map (\s -> let [a,b] = s.match "(\\w+)=(.*)" in (a,b)) $ fromList)
argv = getArgs
just (Just x) = x
just _ = error "Common:just"
exit i = primExitWith i
usage s = putStrLn ("usage:"++s) >> exit 1
class Collection e ce | ce -> e where
empty :: ce
single :: e -> ce
insert :: e -> ce -> ce
fromList :: [e] -> ce
fromList xs = xs.foldl (flip insert) empty
copy :: Int -> e -> ce
delete :: e -> ce -> ce
delete_all:: e -> ce -> ce
filter :: (e -> Bool) -> ce -> ce
partition:: (e -> Bool) -> ce -> (ce,ce)
toList :: ce -> [e]
size :: ce -> Int
foldl:: (a -> e -> a) -> a -> ce -> a
each :: (e -> IO ()) -> ce -> IO ()
null es = es == empty
member e es = e `elem` (es.toList)
union :: (Collection a c) => c -> c -> c
union a b = b.foldl (flip insert) a
intersect :: (Collection a c, Eq a) => c -> c -> c
intersect a b = a.foldl (\a e -> if e `member` b then a.insert e else a) empty
difference :: (Collection a c, Eq a) => c -> c -> c
difference a b = a.foldl (\a e -> if e `member` b then a else a.insert e) empty
class Collection e ce => Sequence e ce where
cons,snoc :: e -> ce -> ce
append :: ce -> ce -> ce
append = union
lview,rview :: ce -> (e,ce)
lhead,rhead :: ce -> e
ltail,rtail :: ce -> ce
take,drop :: Int -> ce -> ce
splitAt :: Int -> ce -> (ce,ce)
subseq :: Int -> Int -> ce -> ce
takeWhile,dropWhile:: (e -> Bool) -> ce -> ce
splitWhile :: (e -> Bool) -> ce -> (ce,ce)
reverse :: ce -> ce
class (Eq a, Eq b, Collection (a,b) cab) => Association a b cab | cab -> a, cab -> b where
keys :: cab -> [a]
values:: cab -> [b]
has_key:: a -> cab -> Bool
has_key k xs = k `elem` (xs.keys)
delete_key :: a -> cab -> cab
each_key :: (a -> IO ()) -> cab -> IO ()
keyss :: b -> cab -> [a]
keyss v cab = cab.toList.filter (snd $ (==v)).map fst
has_value:: b -> cab -> Bool
has_value v xs = v `elem` (xs.values)
map f [] = []
map f (x:xs) = f x: map f xs
cmap f = toList ° map f ° fromList
class Indexable i ca a | ca -> a where
(!~) :: ca -> i -> Maybe a
(!) :: ca -> i -> a
(!) xs i = (xs!~i).just
(!!) :: ca -> [i] -> [a]
(!!) xs is = map (\i -> xs ! i) is
instance (Num b,Ord b) => Indexable b [a] a where
(!!) xs [] = []
(!!) xs (i:is) | i >= (fromInt (length xs)) = []
| i < 0 = xs!((fromInt (length xs)) + i) : xs!!is
| otherwise = xs!(i) : xs!!is
(x:_) !~ n | n < 1 && n >= 0 = Just x
(_:xs) !~ n | n>0 = xs !~ (n-1)
_ !~ _ = Nothing
instance Collection a [a] where
insert = (:)
foldl f z [] = z
foldl f z (x:xs) = foldl f (f z x) xs
filter p xs = [ x | x <- xs, p x ]
each = mapM_
toList = id
fromList = id
empty = []
instance Sequence a [a] where
reverse = foldl (flip (:)) []
instance (Eq a,Eq b) => Association a b [(a,b)] where
keys xs = xs.map fst
delete_key k xs = xs.filter (\(a,b) -> a /= k)
each_key f = keys $ each f
data SetList a = SetList [a] deriving Show
instance Eq a => Collection a (SetList a) where
insert e (SetList xs) = SetList (e:(xs.filter (/= e)))
toList (SetList xs) = xs
instance Eq (SetList a) => Default_val (SetList a) where null_val = SetList []
instance Eq a => Eq (SetList a) where
(SetList xs) == (SetList ys) = (xs.all (`elem` ys)) && (xs.length == ys.length)
data Assoc a b = Assoc [(a,b)] deriving Eq
instance (Show a, Show b) => Show (Assoc a b) where
show (Assoc xs) = xs.map (\(a,b) -> a^" => "^b).unlines
instance Eq a => Collection (a,b) (Assoc a b) where
empty = Assoc []
insert (k,v) (Assoc xs) = Assoc ((k,v):xs.filter ((/= k) ° fst))
toList (Assoc xs) = xs
each f (Assoc xs) = xs.each f
foldl f z (Assoc xs) = xs.foldl f z
instance (Eq a,Eq b) => Association a b (Assoc a b) where
keys (Assoc xs) = xs.map fst
values (Assoc xs) = xs.map snd
instance Eq a => Indexable a (Assoc a b) b where
(!~) (Assoc []) k = Nothing
(!~) (Assoc ((x,y):xys)) k | k==x = Just y
| otherwise = (Assoc xys)!~k
data AssocDefault a b = AssocDefault (b,[(a,b)]) deriving Eq
instance (Show a, Show b) => Show (AssocDefault a b) where
show (AssocDefault (b,xs)) = xs.map (\(a,b) -> a^" => "^b).unlines
instance (Eq a,Default_val b) => Collection (a,b) (AssocDefault a b) where
empty = AssocDefault (null_val,[])
insert (k,v) (AssocDefault (b,xs)) = AssocDefault (b,((k,v):xs.filter ((/= k) ° fst)))
toList (AssocDefault (b,xs)) = xs
each f (AssocDefault (b,xs)) = xs.each f
foldl f z (AssocDefault (b,xs)) = xs.foldl f z
instance (Eq a,Default_val b) => Association a b (AssocDefault a b) where
keys (AssocDefault (b,xs)) = xs.map fst
instance Eq a => Indexable a (AssocDefault a b) b where
(!~) (AssocDefault (b,xs)) k = (Assoc xs)!~ k
update k f h@(AssocDefault (b,xs)) = h.insert(k, (h!~k ||| Just b).just.f)
newtype Matrix a = Matrix [[a]]
deriving (Eq,Show)
row_size (Matrix m) = m.length
column_size (Matrix m) = m.head.length
(%%) (Matrix m) (i,j) = m!i!j
instance Num a => Num (Matrix a) where
ma * mb | ma.column_size == mb.row_size = Matrix aux
where aux = [0..ma.row_size -1]
.foldl (\acc i ->
acc++[
[0..mb.column_size -1]
.foldl (\acc j ->
acc++[
[0..ma.column_size-1]
.foldl (\acc k ->
acc+
(ma%%(i,k) * (mb %%(k,j))))
0]
) []
]
) []
class Eq a => Default_val a where
null_val :: a
is_null :: a -> Bool
is_null = (== null_val)
instance Eq [a] => Default_val [a] where null_val = []
instance Eq (Maybe a) => Default_val (Maybe a) where null_val = Nothing
instance Default_val Int where null_val = 0
instance Default_val Float where null_val = 0.0
(&&&):: (Default_val a, Default_val b) => b -> a -> a
a &&& b = if a.is_null then null_val else b
(|||):: Default_val a => a -> a -> a
a ||| b = if a.is_null then b else a
update_anti_slash [] = []
update_anti_slash [x] = [x]
update_anti_slash ('\\':x:xs) =
(case x of
'n' -> '\n'
't' -> '\t'
x -> x
) : update_anti_slash xs
update_anti_slash (x:xs) = x : update_anti_slash xs
del_enclose :: String -> String
del_enclose xs | length xs <= 1 = xs
| head xs == '"' && last xs == '"' = xs.tail.init
| otherwise = xs
(^) a b = (update_anti_slash ° del_enclose ° show) a ++ (update_anti_slash ° del_enclose ° show) b
infixl 1 ^