-- -*- haskell -*-

-- @@PLEAC@@_NAME
-- @@SKIP@@ Haskell

-- @@PLEAC@@_WEB
-- @@SKIP@@ http://www.haskell.org/

-- @@PLEAC@@_INTRO
-- @@SKIP@@ Many auxiliary functions can be found in appendix (Helpers).
-- @@SKIP@@ You need hugs98 or ghc (tested with 5.002) and the external library: 
-- @@SKIP@@ http://www.dcs.gla.ac.uk/~meurig/regexp/
-- @@SKIP@@ The time section only work with ghc, s/--ghc // if you have ghc.
-- @@SKIP@@ You need to enable multi-parameter class and functionnal depedencies
-- @@SKIP@@  -98 with hugs, and -fglasgow-exts with ghc

-- @@PLEAC@@_APPENDIX
module Pleac where

import Prelude hiding (($),(^),(.),(!!),map,take,lookup,drop,splitAt,reverse,filter,takeWhile,dropWhile,null,foldl)

import Common

----------------------------------------------------------------------------------------------------
-- @@PLEAC@@_1.0

str  = "\\n"                             -- two characters, \ and an n
str2 = "Jon 'Maddog' Orwant"             -- in haskell we can do string only with ", no single quote
str3 = "\n"                              -- a "newline" character
str4 = "Jon \"Maddog\" Orwant"           -- literal double quotes
-- no q/qq/qw/.. stuff in haskell
-- no multiline, you can emulate it with ++ and \n, or unlines
str5 = "This is a multiline here document\n" ++
       "terminated by  on a line by itself\n"


-- @@PLEAC@@_1.1
s     = "This is what you have"
first = s!![0]                            -- "T"
start = s!![5,6]                          -- "is"
rest  = s!![13..]                         -- "you have"
las   = s!![-1]                           -- "e"
las2  = s.last                            -- 'e'
end   = s!![-4 .. -1]                     -- "have"
piece = s!![-8 .. -5]                     -- "you"


[lead,ss1,ss2,trailing]     = s.unpack [Grab 2, Forward 3, Grab 1, Grab 2, GrabAll] 
-- Regexp are better for this, why introduce extra concept (unpack)
[lead2,ss12,ss22,trailing2] = s.match "^(..)...(.)(..)(.*)"
[lead3,ss13,ss23,trailing3] = s.match "^(.{2}).{3}(.)(.{2})(.*)" -- just to show how to use repetition

fivers                      = s.unpack ((Grab 5).replicate (s.length `div` 5))

-- in haskell string == [Char] => no need to do  unpack("A1" x length($string), $string)
characters = s

-- can't modify string in haskell
s'    = s.substr 5 2 "wasn't"       -- "This wasn't what you have"
s''   = s'.substr2 (-12) "ondrous"  -- "This wasn't wondrous",note the () arount negative number :(
s'''  = s''.substr 0 1 ""           -- "his wasn't wondrous", delete first character <=> tail
s'''' = s'''.substr2 (-10) ""       -- "his wasn'"  ,delete last 10 characters <=> reverse . drop 10 . reverse

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

-- cant do as short as in perl cos cant use affection in haskell
news = s!![0..5].(substS "is" "at" [Global_Match]) ++ s!![6..] -- "That at what you have"

a1  = "make a hat"
a1' = a1!![-1] ++ a1!![1..(a1.length -2)] ++ a1!![0] -- "take a ham"

b1 = "to be or not to be"
b2      = b1.unpack [Forward 6, Grab 6]  -- "or not"
[b3,c3] = b1.unpack [Forward 6, Grab 2, Backward 5, Grab 2] -- ["or","be"]

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] -- [Grab 7,Grab 6,Grab 6,Grab 6,Grab 4,GrabAll]


-- @@PLEAC@@_1.2

v3 = "a" ||| "b" -- -> "a"
v4 = ""  ||| "b" -- -> "b"

-- force to put the type :(
v5 = (2::Int) &&& "ee" -- -> "ee"
v6 = (0::Int) &&& "ee" -- -> ""

-- no x ||= y
v3' = v3 ||| v4

dir  = argv >>> (\x -> (x ||| ["/tmp"]).head)
dir' = argv >>> ((||| ["/tmp"]) $ head) -- or even more cryptic

-- @@PLEAC@@_1.3
-- no side effect in haskell => swap is a nosense

-- @@PLEAC@@_1.4
i1 = ord 'a'
c1 = chr 97

-- ascii = string.unpack("C*"), string = ascii.pack("C*"), no need in haskell, String = [Char]
--  there is also packedString that are more efficient but less cool cos not list anymore
ibm = "HAL".map next_char                   -- "IBM"

-- @@PLEAC@@_1.5
s1 = "unique chars are: " ++ ("an apple a day".unique.sort)
sum1 = ("sum is " ^ s1.map ord.sum).putStrLn

-- TODO, script.hs HERE


-- @@PLEAC@@_1.6
s2 = s1.reverse

-- can do: s3 = (unwords . reverse . words) s1
--         s3 = (words $ reverse $ unwords) s1
s3 = s1.words.reverse.unwords 

s3' = s1.split " ".reverse.join " " -- not the same, cos words = split "\s+"
s3''= s1.split "\\s+".reverse.join " " 

-- eval long_palindromes or long_palindromes >>= (mapM putStrLn)
long_palindromes = cat "/usr/share/dict/words" >>> filter(\s -> s == s.reverse && s.length > 4) 

-- @@PLEAC@@_1.7
-- TODO, must do: \s if s == [] then [] else foldr1 .... ? must make a foldr1sure
expand_tabs = split "\t" $ (foldr1 (\a b -> a ++ (times (8 - a.length `mod` 8) ' ') ++ b)) -- more efficient
-- expand_tabs = fixpoint (break_char '\t' (\a b -> a ++ (' '.times (8 - a.length `mod` 8)) ++ b))
                                
-- @@PLEAC@@_1.8
-- cant do eval in haskell, too meta, too reflexif

s4 = "I am 17 years old".subst "\\d+" (\n -> show ((read n) * 2))

-- @@PLEAC@@_1.9
s5 = "bo beep".upcase
s6 = s5.downcase
s7 = s6.capitalize

s8 = "thIS is a loNG liNE".words.map capitalize

-- @@PLEAC@@_1.10
-- s9 = "I have " ++ (show (10+1)) ++ " guanacos."
s9 = "I have "^10+1^" guanacos."

-- @@PLEAC@@_1.11
-- cant put lines at beginning of line cos of layout pb
-- Multi_line is to say that ^ match beginning of every line, not of the string
multi = (substS "^\\s+" "" [Global_Match,Multi_Line] ° unlines) [
 "       This is a multiline here document",
 "       terminated by nothing"
 ]

-- @@PLEAC@@_1.12
-- in fact this fonction is wrong, cos it insert a space at the front of the sentence (must use a foldl1)
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])

-- @@PLEAC@@_1.13
escaping = "Mom Said, \"Don't do that.\""
esc1 = escaping.gsubst "['\"]" ("\\"++) -- section, <=> (\x -> "\\" ++ x)
esc3 = escaping.gsubst "[^A-Z]" ("\\"++)
esc4 = escaping.gsubst "[^\\w]" ("\\"++)

-- @@PLEAC@@_1.14
s10 = "    titi".substS "^\\s+" "" []
s11 = "  titi  ".substS "\\s+$" "" []

trim = substS "^\\s+" "" [] ° substS "\\s+$" "" []

-- @@PLEAC@@_1.15
parse_csv s = let re = ["\"([^\"\\\\]*(\\\\.[^\"\\\\]*)*)\",?" -- "toto,titi"
                       ,"([^,]+),?" -- something that not start with " can not contain any , => go until next ,
                       ,","
                       ].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

-- @@PLEAC@@_1.16
-- from explanation from http://www.myatt.demon.co.uk/sxalg.htm
soundex s = x:'-':((res++[0,0,0]).take 3.map show.concat) -- note that as haskell is lazy, this code is efficient
    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]
          -- A consonant immediately following an initial letter from the same code group is ignored
          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"           -- H-452
                  ,"adomomi"         -- A-350 -- 355
                  ,"vonderlehr"      -- V-536
                  ,"ball"            -- B-400
                  ,"shaw"            -- S-000
                  ,"jackson"         -- J-250
                  ,"scanlon"         -- S-545
                  ,"saintjohn"       -- S-532
                  ,"kingsmith"       -- K-525
                  ,"booth-davis"     -- B-312
                  ,"Knuth"           -- K-530
                  ,"Kant"            -- K-530
                  ,"Lloyd"           -- L-300
                  ,"Ladd"            -- L-300
                  ].map soundex      
-- TODO, not complete ($quota,$comment,$gcos,$expire) = getpw*
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 ()
                        )
                         
-- TODO, pstyle and psgrep                       
                         
----------------------------------------------------------------------------------------------------
-- @@PLEAC@@_2.1
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]") -- no \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+))$")
-- in haskell, regexp are first class, then can be appended, sometimes easier to read
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"      

-- @@PLEAC@@_2.2
equal_num n1 n2 nbdecimal = (abs (n1 - n2)) < 1 / (10 ^^ nbdecimal)
eqnum = equal_num 10.001 10.002 4 -- with 3 give True cos 10.001 - 10.002 != 0.001 but 0.000999

wage = 536          -- $5.36/hour
week = 40 * wage    -- $214.40
weekwage = putStrLn ("One week's wage is: $"++show_float 2 (tonum week/100.0))

-- @@PLEAC@@_2.3
i = 2.3.round
a2  = 0.255
sa2 = show_float 2 a2
mprinta = putStrLn ("Unrounded: "^a2^"\nRounded: "^sa2)

-- TODO, i dont exactly produce the good ouput, negative number are not centered
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)))

-- @@PLEAC@@_2.4
-- TODO? not exacly this, as 54 = 110 110 we dont see the pb of big endian
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" -- 54

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

-- @@PLEAC@@_2.5
m1 = putStr "Infancy is: " >> [0..2].each(\e -> putStr (e^" "))
m2 = putStr "Infancy is: " >> [0..2].map show.unwords.putStr

-- @@PLEAC@@_2.6
-- code from comp.lang.functionnal
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)

-- @@PLEAC@@_2.7
ran = rand (25, 75) -- [25,75]

chars = concat [['A'..'Z'],['a'..'z'],['0'..'9'],"!@$%^&*"]

--password = [1..8].foldM (\a _ -> rand (0, chars.length -1) >>= (\i -> return (a++chars![i]))) "" 
--password = [1..8].mapM (\_ -> rand (0, chars.length -1) >>= (\i -> return (chars!!i)))
password = [1..8].mapM (\_ -> rand (0, chars.length -1) >>> (chars!)) -- no join, string = [Char] :) hihi section :)

-- @@PLEAC@@_2.8
randfixed = do srand 2
               rand(1,10)

-- @@PLEAC@@_2.9
-- uses a Perl module.., in haskell too you can provide your own random generator by
-- playing with the StdGen type

-- @@PLEAC@@_2.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)

-- @@PLEAC@@_2.11
deg2rad d = d * pi / 180
rad2deg r = r * 180 / pi

-- @@PLEAC@@_2.12
sin_val = sin pi
cos_val = cos pi
tan_val = tan pi

asin_val = asin 1
acos_val = acos 1

-- @@PLEAC@@_2.13
log_e = log 10
log_10 = log10 100 -- 2

-- in haskell we dont have by default log10 but we have logBase
log10 = logBase 10

answer = logBase 10 10000
mlog = putStrLn ("log10(10,000)="^answer)

-- @@PLEAC@@_2.14
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

--TODO,transposed = matrixc.transpose
--determined = matrixa.det

-- @@PLEAC@@_2.15
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)

-- @@PLEAC@@_2.16
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"])
-- no printf :((

m3' = do putStrLn "Enter file permission in octal: "
         permissions <- getLine
         putStrLn ("The decimal value is "^permissions.oct)


-- @@PLEAC@@_2.17
commify s = if s.length <= 3 then s else 
            let (a,b) = splitAt (s.length -3) s in commify a ++ "," ++ b

-- @@PLEAC@@_2.18
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))

-- TODO, the suffix program and prime factor

----------------------------------------------------------------------------------------------------
--ghc -- @@PLEAC@@_3.0
--ghc mtime1 = now >>= (\d -> putStrLn (calendarTimeToString d))
--ghc mtime2 = do d <- now
--ghc             putStrLn ("Today is day "^d.ctYDay^" of the current year")
--ghc             putStrLn ("Today is day "^d.ctDay^ " of the current month")
--ghc 
--ghc 
--ghc -- @@PLEAC@@_3.1
--ghc (day,month,year) = (now >>> ctDay, now >>> ctMonth, now >>> ctYear)
--ghc tl = now >>= localtime
--ghc 
--ghc mtime3 = do date <- tl
--ghc             putStrLn ("The current date is "^date.ctYear^" "^date.ctMonth^" "^date.ctDay)
--ghc 
--ghc mtime4 = do d <- now
--ghc             putStrLn (strftime "%Y-%m-%d" d)
--ghc 
--ghc -- TODO 3.2, 3.3
--ghc 
--ghc -- @@PLEAC@@_3.4
--ghc add_sec sec d = d.toClockTime.addToClockTime (nulltime {tdSec= sec})
--ghc when_ = now >>> (\d -> d.add_sec 100)
--ghc then_ = now >>> (\d -> d.add_sec (-100))
--ghc 
--ghc -- @@PLEAC@@_3.5, TODO, not complete
--ghc bree = 361535725
--ghc nat  =  96201950
--ghc 
--ghc differenc = bree - nat
--ghc mtime5 = putStrLn ("there were "^differenc^"seconds between Nat and Bree")
--ghc 
--ghc seconds = differenc `mod` 60
--ghc differenc' = (differenc - seconds) `div` 60
--ghc minutes = differenc' `mod` 60
--ghc differenc2 = (differenc' - minutes) `div` 60
--ghc hours   = differenc2 `mod` 24
--ghc differenc3 = (differenc2 - hours) `div` 24
--ghc days    = differenc3 `mod` 7
--ghc weeks   = (differenc3 - days) `div` 7
--ghc 
--ghc -- (438 weeks, 4 days, 23:49:35)
--ghc mtime6 = putStrLn ("("^weeks^" weeks, "^days^" days, "^hours^":"^minutes^":"^seconds^")")
--ghc 
--ghc -- @@PLEAC@@_3.6
--ghc (monthday, weekday, yearday) = (now >>> ctDay, now >>> ctWDay, now >>> ctYDay)
--ghc 
--ghc weeknum = now >>> (\d -> d.strftime "%U".read + 1)
--ghc 
--ghc -- TODO 3.9
--ghc usec = now >>> ctPicosec -- is this ?
--ghc 
--ghc -- TODO _3.10
--ghc -- have sleep::Int but not Double :(

----------------------------------------------------------------------------------------------------
-- @@PLEAC@@_4.0
single_level = [ "this", "that", "the", "other" ]
-- can make nested list, but must all have the same depth

-- @@PLEAC@@_4.1
a  = ["quick", "brown", "fox"]
a' = "Why are you teasing me?".words
-- no multiline in haskell

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 $$") -- that's the new shell's $$
banner_array1 = ["Costs","only","$4.95"]
banner_array2 = "Costs only $4.95".words
banner_array3 = "Costs only $4.95".split " "

-- @@PLEAC@@_4.2
commify_series :: [String] -> String
commify_series []  = ""
commify_series [x] = x
commify_series xs  = join ", " (init xs)  ++ " and " ++ (last xs)
-- commify_series ["cava", "etoi","ouais"] => "cava, etoi and ouais"

array = ["red", "yellow", "green"]
s12 = "I have "++commify_series array++" marbles"
marray1 = putStrLn ("I have "^(concat  array)^" marbles") -- I have redyellowgreen marbles
marray2 = putStrLn ("I have "^(unwords array)^" marbles") -- I have red yellow green marbles



-- @@PLEAC@@_4.3
-- grow/shring the array by assigning nil to past the end of array
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

-- @@PLEAC@@_4.4
-- in hugs even this take time :), sort is insertion sort :) by default
m4 = env >>= (\l -> l.keys.sort.each(\var -> (var ^"=" ^ (l!var)).putStrLn))
m5 = env >>= (\l -> l.each(\(var,val) -> (var^"="^val).putStrLn)) -- but non-sorted
m6 = env >>= (\l -> l.toList.sortBy(\(a,_) (b,_) -> a <=> b).each(\(var,val) -> (var^"="^val).putStrLn))

-- @@PLEAC@@_4.5
-- not relevant in haskell since we have always kind of references


-- @@PLEAC@@_4.6
users  = exec "who" >>> map (words $ head) $ sort $ unique
users2 = exec "who" >>> map (match "(\\w+)" $ head) $ sort $ unique
-- cant do as short as ruby: puts("users logged in: .{commify_series(users)}")
--  monad are too intrusive and we need to introduce an extra var l, :(((  
m10 = do l <- users 
         putStrLn ("users logged in:"++(commify_series l))

-- @@PLEAC@@_4.7
l1 = [1..5] `difference` [2,5] -- could make [1..5] - [2,5], just have to make an instance Num

instance (Eq a,Show a) => Num ([a]) where
    a + b = a `union` b
    (-) a b = a `difference` b -- we can write it like that
    (*) = intersect -- or even shorter
-- make this instance is very dangerous, cos now typechecker not detect the error [show 1,show 2]++[0,0], WHY ?
l1' = [1..5] - [2,5]

-- @@PLEAC@@_4.8
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)

-- @@PLEAC@@_4.9
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")]

-- @@PLEAC@@_4.10

reversed = [1..5].reverse
array5 = [3,2,5,1]
descending  = array5.sort.reverse
descending' = array5.sortBy (\a b -> b <=> a)
descending2 = array5.sortBy (flip (<=>))

-- @@PLEAC@@_4.11
-- remove n elements from front of ary (shift n)
(front,newarray) = array5.splitAt 1

-- remove n elements from the end of ary (pop n)
(newarray',end')  = array5.splitAt (array5.length - 1)


shift2 (x:y:ys) = ((x,y),ys) -- shift2 = zip ... shift ... TODO
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

-- @@PLEAC@@_4.12
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}
             ]
-- can do also with classic assoc list
-- employees = [("ben","neuneu1"),("pixel","neuneu2"),("pad","engineer"),("guit","engineer")]
-- category = snd
-- name = fst
(Just highest_engineer) = employees.find(\employee -> employee.category == "engineer")

s14 = "Highest paid engineer is: "++ highest_engineer.name


-- @@PLEAC@@_4.13
bigs = [5..200].filter (>50) -- hihi section :)

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)

-- @@PLEAC@@_4.14
-- normally you would have an array of Numeric (Float or
-- Fixnum or Bignum), so you would use:
sorted1 = [11,5,2,8].sort

-- if you have strings representing Integers or Floats
-- you may specify another sort method (not lexicographic ordering):
sorted2  = ["11","5","1","8"].sort -- ["1","11","5","8"]
sorted2' = ["11","5","1","8"].sortBy (\a b -> ((read a)::Int) <=> read b) -- ["1","5","8","11"]

-- cant inline expression :(
pidsorted = do ps <- exec "ps ux" 
               myenv <- env
               ps!![1..] -- avoid the indication string: USER TTY ....
                     .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)

-- @@PLEAC@@_4.15
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)

-- @@PLEAC@@_4.16
-- in haskell we can use infinite list
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 () -- forced, WHY?
                                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 () -- forced, WHY?


-- @@PLEAC@@_4.17
-- brute force
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)!)

-- @@PLEAC@@_4.19
bigint = fact 500
-- on hugs, i have 1134 digits
permute = permut
----------------------------------
#!/usr/bin/runhugs
module Main where
import Prelude hiding ((.))

-- usage: echo dog eat cat | ./script.hs
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 -- object notation for object fan
(°) f g x = f (g x)

main = do line <- getLine
          line.words.permut.mapM_(putStrLn ° unwords)

----------------------------------



-- @@PLEAC@@_5.0

-- this choose for association the traditionnal assoc list representation
age = [ ("Nat",24)
        ,("Jules",25)
        ,("Josh",17)]
-- if you preprend the list with fromList, then you can decide what representaion to choose by typing age
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"
                        ]

-- In haskell, you cannot avoid the double quoting while manipulatin hashes

-- @@PLEAC@@_5.1
food_color' = food_color.insert ("Raspberry" ==> "pink")
mfood_color = putStrLn ("Know foods: "^(unwords (food_color.keys)))

-- @@PLEAC@@_5.2
-- does hash have a value for key ?

mhash = ["Banana", "Martini"].mapM(\name -> 
        putStrLn (name^" is a "^(food_color.has_key name ? ("food","drink")))
                                  )
-- @@PLEAC@@_5.3
food_color2 = food_color.delete_key "Banana"

-- @@PLEAC@@_5.4

mhash2 = food_color.each (\(food,color) ->
         putStrLn (food^" is "^color)
         )
mhash3 = food_color.each_key(\food -> 
         putStrLn (food^" is "^(food_color!food))
         )

-- IMO too (as gc), this demonstrates that OO style is by far more readable
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
-- TODO, very slow, try with ghc

-- countfrom - count number of messages from each sender
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))
---------------------------------------
                              
                           
-- @@PLEAC@@_5.5
-- You may use the not built-in 'show' (poor ruby)
mhash5 = putStrLn (age4.show)
         
-- Or do it the Cookbook way:
mhash5' = age4.each (\(k,v) -> putStrLn (k^" => "^v))

-- Sorted by keys
mhash6 = age4.toList.sortBy (\a b -> (a.fst) <=> (b.fst)).each(\(k,v) -> putStrLn (k^" => "^v))
-- Sorted by values
mhash7 = age4.toList.sortBy (\a b -> (a.snd) <=> (b.snd)).each(\(k,v) -> putStrLn (k^" => "^v))

-- @@PLEAC@@_5.7
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)))

-- @@PLEAC@@_5.8
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"
                 ]


-- foodfind - find match for food or color
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)
---------------------------------------

-- @@PLEAC@@_5.9
-- Sorted by keys
mhash9  = age4.toList.sortBy (\a b -> (a.fst) <=> (b.fst)).each (\(k,v) -> 
          putStrLn (k^" is "^v))
-- Sorted by values
mhash10 = age4.toList.sortBy (\a b -> (a.snd) <=> (b.snd)).each (\(k,v) -> 
          putStrLn (k^" is "^v))

-- Sorted by length of values
mhash11 = food_color.toList.sortBy (\a b -> (a.snd.length) <=> (b.snd.length)).each (\(k,v) -> 
          putStrLn (k^" is "^v))

-- @@PLEAC@@_5.10
drink_color:: Assoc String String
drink_color = fromList ["Galliano" ==> "yellow", "Mai Tai" ==> "blue"]

-- in haskell no clone, we do implictly always clone :)
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

-- @@PLEAC@@_5.11
common = food_color.keys * drink_color.keys

this_not_that = food_color.keys - drink_color.keys

-- @@PLEAC@@_5.12
-- no problem here, haskell handles any kind of object for key-ing

-- TODO 5.13 AFAIK, not possible in Ruby

-- @@PLEAC@@_5.14
count:: AssocDefault String Int
count = ["toto","toto","toto","tata","tata","tutu"].foldl (\a s -> a.update s (+1)) empty

--@PLEAC@@_5.15
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

-- TODO    

-- @@PLEAC@@_APPENDIX
----------------------------------------------------------------------------------------------------
module Common ( module Common
                , module Regexp
                , module System
                , module Complex
                , module Char 
                , module Numeric 
                -- Monad
                , foldM
                -- List
                , 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
--              ,module Prelude

) 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

-- seems ghc need it for chr,ord, readHex, readOct
import Char 
import Numeric 
--ghc import Time
--ghc import Locale

--import Trace

----------------------------------------------------------------------------------------------------
substr start len insert s = 
    if start >= 0 then s!![0..start-1] ++ insert ++ s!![start+len..] -- [0.. -1] -> []
    else s!![0..(length s + start -1)] ++ insert ++ s!![start+len.. -1]
--substr s start len insert = take s start ++ insert ++ s!![start+len..]
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 --(snd $ reverse) (foldl aux (0,[]) opt)
    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)
-- could do a foldr so that no need reverse but need reverse opt
-- could to a str2Unpack_option so that str2Unpack_option "A5 A*" => [Grab 5,GrabAll]