Visgean/tut4.hs

## tut4.hs
-- Informatics 1 - Functional Programming
-- Tutorial 4
--
-- Due: the tutorial of week 6 (27/28 Oct)

import Data.List (nub)
import Data.Char
import Test.QuickCheck
import Network.HTTP (simpleHTTP,getRequest,getResponseBody)

-- <type decls>

type Link = String
type Name = String
type Email = String
type HTML = String
type URL = String

-- </type decls>
-- <sample data>

testURL     = "http://www.inf.ed.ac.uk/teaching/courses/inf1/fp/testpage.html"

testHTML :: String
testHTML =    "<html>"
           ++ "<head>"
           ++ "<title>FP: Tutorial 4</title>"
           ++ "</head>"
           ++ "<body>"
           ++ "<h1>A Boring test page</h1>"
           ++ "<h2>for tutorial 4</h2>"
           ++ "<a href=\"http://www.inf.ed.ac.uk/teaching/courses/inf1/fp/\">FP Website</a><br>"
           ++ "<b>Lecturer:</b> <a href=\"mailto:dts@inf.ed.ac.uk\">Don Sannella</a><br>"
           ++ "<b>TA:</b> <a href=\"mailto:m.k.lehtinen@sms.ed.ac.uk\">Karoliina Lehtinen</a>"
           ++ "</body>"
           ++ "</html>"

testLinks :: [Link]
testLinks = [ "http://www.inf.ed.ac.uk/teaching/courses/inf1/fp/\">FP Website</a><br><b>Lecturer:</b> "
            , "mailto:dts@inf.ed.ac.uk\">Don Sannella</a><br><b>TA:</b> "
            , "mailto:m.k.lehtinen@sms.ed.ac.uk\">Karoliina Lehtinen</a></body></html>" ]


testAddrBook :: [(Name,Email)]
testAddrBook = [ ("Don Sannella","dts@inf.ed.ac.uk")
               , ("Karoliina Lehtinen","m.k.lehtinen@sms.ed.ac.uk")]

-- </sample data>
-- <system interaction>

getURL :: String -> IO String
getURL url = simpleHTTP (getRequest url) >>= getResponseBody

emailsFromURL :: URL -> IO ()
emailsFromURL url =
  do html <- getURL url
     let emails = (emailsFromHTML html)
     putStr (ppAddrBook emails)

emailsByNameFromURL :: URL -> Name -> IO ()
emailsByNameFromURL url name =
  do html <- getURL url
     let emails = (emailsByNameFromHTML html name)
     putStr (ppAddrBook emails)

-- </system interaction>
-- <exercises>

-- 1.
sameString :: String -> String -> Bool
sameString s v = map toUpper s == map toUpper v


-- 2.
prefix :: String -> String -> Bool
prefix [] _ = True
prefix _ [] = False
prefix part whole = sameString (take (length part) whole) part

prop_prefix_pos :: String -> Int -> Bool
prop_prefix_pos str n =  prefix substr (map toLower str) &&
		         prefix substr (map toUpper str)
                           where
                             substr  =  take n str

prop_prefix_neg :: String -> Int -> Bool
prop_prefix_neg str n = sameString str substr || (not $ prefix str substr)
                          where substr = take n str


-- 3.
contains :: String -> String -> Bool
contains _ [] = True
contains [] _ = False
contains whole sub = prefix sub whole || contains (tail whole) sub

prop_contains :: String -> Int -> Int -> Bool
prop_contains str n d = contains str (take n (drop d str))


-- 4.
takeUntil :: String -> String -> String
takeUntil _ [] = []
takeUntil part whole | prefix part whole = []
                     | otherwise = head whole: (takeUntil part (tail whole))

dropUntil :: String -> String -> String
dropUntil part [] = []
dropUntil part word | prefix part word = drop (length part) word
                    | otherwise = dropUntil part (tail word)


-- 5.
split :: String -> String -> [String]
split _ [] = []
split [] _ = error "Pyco!"
split sep whole = takeUntil sep whole : split sep (dropUntil sep whole)

reconstruct :: String -> [String] -> String
reconstruct _ [] = []
reconstruct _ [x] = x
reconstruct sep (x:xs) = x ++ sep ++ reconstruct sep xs

prop_split :: Char -> String -> String -> Bool
prop_split c sep str = reconstruct sep' (split sep' str) `sameString` str
  where sep' = c : sep

-- 6.
linksFromHTML :: HTML -> [Link]
linksFromHTML xs =  filter (\x -> prefix "mailto" x || prefix "http" x) $  split "<a href=\"" xs

testLinksFromHTML :: Bool
testLinksFromHTML  =  linksFromHTML testHTML == testLinks


-- 7.
takeEmails :: [Link] -> [Link]
takeEmails = filter (prefix "mailto:")


-- 8.
link2pair :: Link -> (Name, Email)
link2pair link | prefix "mailto:" link = (name, email)
               | otherwise = error "Dej mi link"
               where name = dropUntil "\">" $ takeUntil "</a>" link
                     email = takeUntil "\">" $ dropUntil "mailto:" link


-- 9.
emailsFromHTML :: HTML -> [(Name,Email)]
emailsFromHTML html = map link2pair $ takeEmails $ linksFromHTML html

testEmailsFromHTML :: Bool
testEmailsFromHTML  =  emailsFromHTML testHTML == testAddrBook


-- 10.
findEmail :: Name -> [(Name, Email)] -> [(Name, Email)]
findEmail name book = filter (\(n, e) -> contains n name) book


-- 11.
emailsByNameFromHTML :: HTML -> Name -> [(Name,Email)]
emailsByNameFromHTML html name = findEmail name $ emailsFromHTML html


-- Optional Material

-- 12.
hasInitials :: String -> Name -> Bool
hasInitials initials name = (map (toUpper . head) (split " " name)) == initials

-- 13.
emailsByMatchFromHTML :: (Name -> Bool) -> HTML -> [(Name, Email)]
emailsByMatchFromHTML f html = filter (\(n,e) -> f n) $ emailsFromHTML html

emailsByInitialsFromHTML :: String -> HTML -> [(Name, Email)]
emailsByInitialsFromHTML initials html = emailsByMatchFromHTML (hasInitials initials) html

-- 14.

-- If your criteria use parameters (like hasInitials), change the type signature.
myCriteria :: Name -> Bool
myCriteria name = contains name "Don"

emailsByMyCriteriaFromHTML :: HTML -> [(Name, Email)]
emailsByMyCriteriaFromHTML = emailsByMatchFromHTML myCriteria

-- 15
nameFormat :: Name -> Name
nameFormat n | ',' `elem` n  = n
             | otherwise = reconstruct ", " $ reverse $ split " " n

normalizeString :: String -> Int -> String
normalizeString string n = string ++ take (n - length string) (repeat ' ')


ppAddrBook :: [(Name, Email)] -> String
ppAddrBook addr = unlines [(normalizeString (nameFormat name) longest) ++ "\t" ++ email | (name,email) <- addr ]
    where longest = maximum $ map length $ map fst addr
	-- Informatics 1 - Functional Programming
	-- Tutorial 4
	--
	-- Due: the tutorial of week 6 (27/28 Oct)

	import Data.List (nub)
	import Data.Char
	import Test.QuickCheck
	import Network.HTTP (simpleHTTP,getRequest,getResponseBody)

	-- <type decls>

	type Link = String
	type Name = String
	type Email = String
	type HTML = String
	type URL = String

	-- </type decls>
	-- <sample data>

	testURL = "http://www.inf.ed.ac.uk/teaching/courses/inf1/fp/testpage.html"

	testHTML :: String
	testHTML = "<html>"
	++ "<head>"
	++ "<title>FP: Tutorial 4</title>"
	++ "</head>"
	++ "<body>"
	++ "<h1>A Boring test page</h1>"
	++ "<h2>for tutorial 4</h2>"
	++ "<a href=\"http://www.inf.ed.ac.uk/teaching/courses/inf1/fp/\">FP Website</a><br>"
	++ "<b>Lecturer:</b> <a href=\"mailto:dts@inf.ed.ac.uk\">Don Sannella</a><br>"
	++ "<b>TA:</b> <a href=\"mailto:m.k.lehtinen@sms.ed.ac.uk\">Karoliina Lehtinen</a>"
	++ "</body>"
	++ "</html>"

	testLinks :: [Link]
	testLinks = [ "http://www.inf.ed.ac.uk/teaching/courses/inf1/fp/\">FP Website</a><br><b>Lecturer:</b> "
	, "mailto:dts@inf.ed.ac.uk\">Don Sannella</a><br><b>TA:</b> "
	, "mailto:m.k.lehtinen@sms.ed.ac.uk\">Karoliina Lehtinen</a></body></html>" ]


	testAddrBook :: [(Name,Email)]
	testAddrBook = [ ("Don Sannella","dts@inf.ed.ac.uk")
	, ("Karoliina Lehtinen","m.k.lehtinen@sms.ed.ac.uk")]

	-- </sample data>
	-- <system interaction>

	getURL :: String -> IO String
	getURL url = simpleHTTP (getRequest url) >>= getResponseBody

	emailsFromURL :: URL -> IO ()
	emailsFromURL url =
	do html <- getURL url
	let emails = (emailsFromHTML html)
	putStr (ppAddrBook emails)

	emailsByNameFromURL :: URL -> Name -> IO ()
	emailsByNameFromURL url name =
	do html <- getURL url
	let emails = (emailsByNameFromHTML html name)
	putStr (ppAddrBook emails)

	-- </system interaction>
	-- <exercises>

	-- 1.
	sameString :: String -> String -> Bool
	sameString s v = map toUpper s == map toUpper v


	-- 2.
	prefix :: String -> String -> Bool
	prefix [] _ = True
	prefix _ [] = False
	prefix part whole = sameString (take (length part) whole) part

	prop_prefix_pos :: String -> Int -> Bool
	prop_prefix_pos str n = prefix substr (map toLower str) &&
	prefix substr (map toUpper str)
	where
	substr = take n str

	prop_prefix_neg :: String -> Int -> Bool
	prop_prefix_neg str n = sameString str substr \|\| (not $ prefix str substr)
	where substr = take n str


	-- 3.
	contains :: String -> String -> Bool
	contains _ [] = True
	contains [] _ = False
	contains whole sub = prefix sub whole \|\| contains (tail whole) sub

	prop_contains :: String -> Int -> Int -> Bool
	prop_contains str n d = contains str (take n (drop d str))


	-- 4.
	takeUntil :: String -> String -> String
	takeUntil _ [] = []
	takeUntil part whole \| prefix part whole = []
	\| otherwise = head whole: (takeUntil part (tail whole))

	dropUntil :: String -> String -> String
	dropUntil part [] = []
	dropUntil part word \| prefix part word = drop (length part) word
	\| otherwise = dropUntil part (tail word)


	-- 5.
	split :: String -> String -> [String]
	split _ [] = []
	split [] _ = error "Pyco!"
	split sep whole = takeUntil sep whole : split sep (dropUntil sep whole)

	reconstruct :: String -> [String] -> String
	reconstruct _ [] = []
	reconstruct _ [x] = x
	reconstruct sep (x:xs) = x ++ sep ++ reconstruct sep xs

	prop_split :: Char -> String -> String -> Bool
	prop_split c sep str = reconstruct sep' (split sep' str) `sameString` str
	where sep' = c : sep

	-- 6.
	linksFromHTML :: HTML -> [Link]
	linksFromHTML xs = filter (\x -> prefix "mailto" x \|\| prefix "http" x) $ split "<a href=\"" xs

	testLinksFromHTML :: Bool
	testLinksFromHTML = linksFromHTML testHTML == testLinks


	-- 7.
	takeEmails :: [Link] -> [Link]
	takeEmails = filter (prefix "mailto:")


	-- 8.
	link2pair :: Link -> (Name, Email)
	link2pair link \| prefix "mailto:" link = (name, email)
	\| otherwise = error "Dej mi link"
	where name = dropUntil "\">" $ takeUntil "</a>" link
	email = takeUntil "\">" $ dropUntil "mailto:" link


	-- 9.
	emailsFromHTML :: HTML -> [(Name,Email)]
	emailsFromHTML html = map link2pair $ takeEmails $ linksFromHTML html

	testEmailsFromHTML :: Bool
	testEmailsFromHTML = emailsFromHTML testHTML == testAddrBook


	-- 10.
	findEmail :: Name -> [(Name, Email)] -> [(Name, Email)]
	findEmail name book = filter (\(n, e) -> contains n name) book


	-- 11.
	emailsByNameFromHTML :: HTML -> Name -> [(Name,Email)]
	emailsByNameFromHTML html name = findEmail name $ emailsFromHTML html


	-- Optional Material

	-- 12.
	hasInitials :: String -> Name -> Bool
	hasInitials initials name = (map (toUpper . head) (split " " name)) == initials

	-- 13.
	emailsByMatchFromHTML :: (Name -> Bool) -> HTML -> [(Name, Email)]
	emailsByMatchFromHTML f html = filter (\(n,e) -> f n) $ emailsFromHTML html

	emailsByInitialsFromHTML :: String -> HTML -> [(Name, Email)]
	emailsByInitialsFromHTML initials html = emailsByMatchFromHTML (hasInitials initials) html

	-- 14.

	-- If your criteria use parameters (like hasInitials), change the type signature.
	myCriteria :: Name -> Bool
	myCriteria name = contains name "Don"

	emailsByMyCriteriaFromHTML :: HTML -> [(Name, Email)]
	emailsByMyCriteriaFromHTML = emailsByMatchFromHTML myCriteria

	-- 15
	nameFormat :: Name -> Name
	nameFormat n \| ',' `elem` n = n
	\| otherwise = reconstruct ", " $ reverse $ split " " n

	normalizeString :: String -> Int -> String
	normalizeString string n = string ++ take (n - length string) (repeat ' ')


	ppAddrBook :: [(Name, Email)] -> String
	ppAddrBook addr = unlines [(normalizeString (nameFormat name) longest) ++ "\t" ++ email \| (name,email) <- addr ]
	where longest = maximum $ map length $ map fst addr