• API
• FAQ
• Tools
• Archive
SHARE
TWEET # Untitled a guest Oct 18th, 2019 91 Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. data Month = MakeMonth String deriving (Eq, Ord)
2.
3. toMonth :: String -> Month
4. toMonth x
5.    | (read x :: Integer) < 1  = error "Minimum month number is 1"
6.    | (read x :: Integer) > 12 = error "Maximum month number is 12"
7.    | otherwise = MakeMonth x
8.
9. fromMonth :: Month -> String
10. fromMonth (MakeMonth i) = i
11.
12. data Day = MakeDay String deriving (Eq, Ord)
13.
14. toDay :: String -> Day
15. toDay x
16.    | (read x :: Integer) < 1  = error "Minimum day number is 1"
17.    | (read x :: Integer) > 31 = error "Maximum day number is 31"
18.    | otherwise = MakeDay x
19.
20. fromDay :: Day -> String
21. fromDay (MakeDay i) = i
22.
23. newtype Year = MakeYear String deriving (Eq, Ord)
24.
25. toYear :: String -> Year
26. toYear x
27.    | x == "0" = error "No year 0"
28.    | otherwise = MakeYear x
29.
30. fromYear :: Year -> String
31. fromYear (MakeYear x) = x
32.
33. data Date = Date { year :: Year, month :: Month, day :: Day } deriving(Eq, Ord)
34.
35. leapYear y
36.    | mod y 400 == 0 = True
37.    | mod y 100 == 0 = False
38.    | mod y 4 == 0 = True
39.    | otherwise = False
40.
41. correctDate :: Integer -> Integer -> Integer -> Bool
42. correctDate 0 _ _  = False
43. correctDate y m d
44.    | (elem m [1,3,5,7,8,10,12]) && (elem d [1..31]) = True
45.    | (elem m [4,6,9,11]) && (elem d [1..30]) = True
46.    | (m==2) && (elem d [1..28]) = True
47.    | (leapYear y) && (m==2) && (d==29) = True
48.    | otherwise = False
49.
50. makeDate :: String -> String -> String -> Date
51. makeDate y m d
52.    | correctDate yInt mInt dInt = Date { year = toYear y, month = toMonth m, day = toDay d }
53.    | otherwise = error "Bad date"
54.    where yInt = read y :: Integer
55.          mInt = read m :: Integer
56.          dInt = read d :: Integer
57.
58. data EventInfo = EventInfo { name :: String
59.                            , place :: String
60.                            , date :: Date
61.                            } deriving(Eq)
62.
63. -- findEventByPlace :: String -> [EventInfo] -> [EventInfo]
64. -- findEventByPlace plc events = filter (\p -> place p == plc) events
65.
66. -- findEventsByDate :: String -> [EventInfo] -> [EventInfo]
67. -- findEventsByDate dt events = filter (\d -> date d == dt) events
68.
69. -- aboutEvent :: String -> [EventInfo] -> EventInfo
70.
71. doCommand :: String -> IO [EventInfo] -> IO ()
72. doCommand input ioEvents = do
73.    events <- ioEvents -- Now you can use events as [EventInfo]
74.    possiblyChangedEvents <- checkCommand input events
75.    loop \$ return [possiblyChangedEvents]
76.
77. errorMsg = "I do not understand that. I understand the following: \n\
78.            \*Event <name> happens at <place> on <date> \n\
79.            \*Tell me about <eventname> \n\
80.            \*What happens on <date> \n\
81.            \*What happens at <place> \n\
82.            \*Quit"
83.
84. checkCommand :: String -> [EventInfo] -> [EventInfo]
85. checkCommand input events
86.    | concat cmd == "Eventhappensaton" = events
87.    | concat cmd == "Tellmeabout" = events
88.    | concat cmd == "Whathappenson" = events
89.    | concat cmd == "Whathappensat" = events
90.    | otherwise = error errorMsg
91.    where cmd = filter (\n -> head n /= '\''  && last n /= '\'') \$ words input
92.          info = filter (\n -> head n == '\'' || last n == '\'') \$ words input
93.
94. main = loop \$ return []
95.
96. loop :: IO [EventInfo] -> IO ()
97. loop ioEvents = do
98.    input <- getLine
99.    if input == "Quit"
100.       then putStrLn "bye"
101.       else doCommand input ioEvents
RAW Paste Data
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.

Top