Data.hs 4.0 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123
  1. {-# LANGUAGE LambdaCase #-}
  2. {-# LANGUAGE DeriveGeneric #-}
  3. module Data where
  4. import qualified Data.Yaml as Yaml
  5. import GHC.Generics
  6. -- First some types to make signatures more readable
  7. type Name = String
  8. type Note = String
  9. type Synopsis = String
  10. type Review = String
  11. type NumEpisodes = Int
  12. type Number = Int
  13. type DoctorNum = Int
  14. type SeasonNum = String
  15. -- Our Table is just a list of Doctors...
  16. type Table = [Doctor]
  17. -- A Doctor is just a number and a list of seasons...
  18. data Doctor = Doctor
  19. {
  20. doctorNum :: DoctorNum
  21. , seasons :: [Season]
  22. } deriving (Generic, Show, Read)
  23. -- A Season is just a season number* and a list of stories
  24. data Season = Season
  25. {
  26. seasonNum :: SeasonNum
  27. , stories :: [Story]
  28. } deriving (Generic, Show, Read)
  29. -- A story contains a bunch of info!
  30. data Story = Story
  31. {
  32. name :: Name
  33. , number :: Number
  34. , numEpisodes :: NumEpisodes
  35. , missing :: Missing
  36. , reccomendation :: Recommendation
  37. , note :: (Maybe Note)
  38. , synopsis :: Synopsis
  39. , review :: Review
  40. , majorPlotChanges :: Maybe String
  41. } deriving (Generic, Show, Read)
  42. -- A story is either missing no episodes, all episodes, or some specific episodes
  43. data Missing = None
  44. | All
  45. | Some [Int] deriving (Generic, Show, Read, Eq)
  46. -- Our recommendations
  47. data Recommendation = Highly | Yes | Maybe | Partial | No deriving (Generic, Show, Read)
  48. instance Yaml.ToJSON Doctor
  49. instance Yaml.ToJSON Season
  50. instance Yaml.ToJSON Story
  51. instance Yaml.ToJSON Missing
  52. instance Yaml.ToJSON Recommendation
  53. instance Yaml.FromJSON Doctor
  54. instance Yaml.FromJSON Season
  55. instance Yaml.FromJSON Story
  56. instance Yaml.FromJSON Missing
  57. instance Yaml.FromJSON Recommendation
  58. -- an empty table.
  59. emptyTable :: Table
  60. emptyTable = []
  61. -- | Checks if a certain doctor is in the table
  62. hasDoctor :: DoctorNum -> Table -> Bool
  63. hasDoctor _ [] = False
  64. hasDoctor n (Doctor n' _ : rest) = n == n' || hasDoctor n rest
  65. -- | Checks if a certain season is in the table
  66. hasSeason :: SeasonNum -> Table -> Bool
  67. hasSeason _ [] = False
  68. hasSeason n (Doctor _ seasons : rest) = any (\(Season n' _) -> n == n') seasons || hasSeason n rest
  69. -- | Tells you what the last doctor is (by number)
  70. getLastDoctor :: Table -> DoctorNum
  71. getLastDoctor [] = 0
  72. getLastDoctor table = case last table of
  73. Doctor n _ -> n
  74. -- | Adds another Doctor to the table
  75. addDoctor :: Table -> Table
  76. addDoctor table = let nextDoctor = getLastDoctor table + 1
  77. in table ++ [Doctor nextDoctor []]
  78. -- | Adds a new season to the table. Requires both a doctor number and a season number
  79. addSeason :: DoctorNum -> SeasonNum -> Table -> Maybe Table
  80. addSeason doctorNum seasonNum table = if hasDoctor doctorNum table then Just (addSeason' doctorNum seasonNum table)
  81. else Nothing
  82. where
  83. addSeason' :: DoctorNum -> SeasonNum -> Table -> Table
  84. addSeason' _ _ [] = error "impossible"
  85. addSeason' doctorNum seasonNum (Doctor n seasons : rest)
  86. = if n == doctorNum
  87. then Doctor n (seasons ++ [Season seasonNum []]) : rest
  88. else Doctor n seasons : addSeason' doctorNum seasonNum rest
  89. -- | Adds a story to a specific season in the table
  90. addStory :: Story -> SeasonNum -> Table -> Maybe Table
  91. addStory story season table = if hasSeason season table then Just (addStory' story season table)
  92. else Nothing
  93. where
  94. addStory' story season [] = error "impossible"
  95. addStory' story season (Doctor n seasons : rest)
  96. = if any (\s -> case s of Season n' _ -> season == n') seasons
  97. then (Doctor n (addToSeason story season seasons)) : rest
  98. else Doctor n seasons : addStory' story season rest
  99. addToSeason story season [] = error "impossible"
  100. addToSeason story season (Season sn stories : rest)
  101. | sn == season = Season sn (stories ++ [story]) : rest
  102. | otherwise = Season sn stories : (addToSeason story season rest)