-
Notifications
You must be signed in to change notification settings - Fork 3
/
LibraryADT.hs
52 lines (40 loc) · 1.67 KB
/
LibraryADT.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
module LibraryADT ( Database
, initDB
, books
, borrowers
, borrowed
, numborrowed
, makeLoan
, returnLoan ) where
type Person = String
type Book = String
type Loan = [Book]
type Borrowers = [Person]
newtype DBLoans = DBLoans (Person -> Loan)
newtype DBBrows = DBBrows (Book -> Borrowers)
type Database = (DBLoans, DBBrows)
initDB :: Database
initDB = (DBLoans (\_ -> []), DBBrows (\_ -> []))
books :: Database -> Person -> Loan
books (DBLoans func, _) = func
borrowers :: Database -> Book -> Borrowers
borrowers (_, DBBrows func) = func
borrowed :: Database -> Book -> Bool
borrowed db bk = (not . null) (borrowers db bk)
numborrowed :: Database -> Person -> Int
numborrowed db = length . books db
makeLoan :: Database -> Person -> Book -> Database
makeLoan (DBLoans funl, DBBrows funb) pers bk
= ( DBLoans (\x -> if x == pers then bk : funl x else funl x)
, DBBrows (\x -> if x == bk then pers : funb x else funb x) )
returnLoan :: Database -> Person -> Book -> Database
returnLoan db pers bk = maybe db id (returnLoanM db pers bk)
returnLoanM :: Database -> Person -> Book -> Maybe Database
returnLoanM db@ (DBLoans funl, DBBrows funb) pers bk
= if (pers `elem` borrowers db bk) && (bk `elem` books db pers)
then Just ( DBLoans (\x -> if x == pers then eliminate (funl x) pers else funl x)
, DBBrows (\x -> if x == bk then eliminate (funb x) bk else funb x) )
else Nothing
eliminate :: Eq a => [a] -> a -> [a]
eliminate [] _ = []
eliminate (x : xs) fd = if x == fd then xs else x : eliminate xs fd