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. OK, I Understand
 
Top