specJson.hs

specJson.hs

-- Parsing the API result from wesleyan/spec
{-# LANGUAGE DeriveGeneric #-}


module Event where

import           Control.Monad        (mzero)
import           Control.Applicative
import           Data.Aeson
import           GHC.Generics
import           Data.Time.Clock      (UTCTime)
import           Data.Maybe           (fromMaybe)
import qualified Data.ByteString.Lazy as B
import qualified Data.Text            as T
import qualified Data.Scientific      as Sci

newtype ShiftId    = ShiftId    T.Text  deriving (Eq, Show, Generic)
newtype ShiftStaff = ShiftStaff T.Text  deriving (Eq, Show, Generic)
newtype ShiftStart = ShiftStart UTCTime deriving (Eq, Show, Generic)
newtype ShiftEnd   = ShiftEnd   UTCTime deriving (Eq, Show, Generic)

data Shift = Shift { getShiftId    :: ShiftId
                   , getShiftStaff :: ShiftStaff
                   , getShiftStart :: ShiftStart
                   , getShiftEnd   :: ShiftEnd
                   } deriving (Eq, Show)

instance FromJSON ShiftId
instance FromJSON ShiftStaff
instance FromJSON ShiftStart
instance FromJSON ShiftEnd
instance FromJSON Shift where
  parseJSON (Object v) = Shift <$> v .: "id"
                               <*> v .: "staff"
                               <*> v .: "start"
                               <*> v .: "end"
  parseJSON _          = mzero

newtype NoteId    = NoteId    T.Text  deriving (Eq, Show, Generic)
newtype NoteText  = NoteText  T.Text  deriving (Eq, Show, Generic)
newtype NoteUser  = NoteUser  T.Text  deriving (Eq, Show, Generic)
newtype NoteTime  = NoteTime  UTCTime deriving (Eq, Show, Generic)

data Note  = Note  { getNoteId    :: NoteId
                   , getNoteText  :: NoteText
                   , getNoteUser  :: NoteUser
                   , getNoteTime  :: NoteTime
                   } deriving (Eq, Show)

instance FromJSON NoteId
instance FromJSON NoteText
instance FromJSON NoteUser
instance FromJSON NoteTime
instance FromJSON Note where
  parseJSON (Object v) = Note <$> v .: "id"
                              <*> v .: "text"
                              <*> v .: "user"
                              <*> v .: "date"
  parseJSON _          = mzero

newtype InventoryItem   = InventoryItem    T.Text  deriving (Eq, Show, Generic)
newtype InventoryAmount = InventoryAmount  Int     deriving (Eq, Show, Generic)

data Inventory = Inventory { getInventoryItem   :: InventoryItem
                           , getInventoryAmount :: InventoryAmount
                           } deriving (Eq, Show)

instance FromJSON InventoryItem
instance FromJSON InventoryAmount
instance FromJSON Inventory where
  parseJSON (Object v) = Inventory <$> v .: "item"
                                   <*> v .: "amt"
  parseJSON _          = mzero

newtype EventId           = EventId           T.Text  deriving (Eq, Show, Generic)
newtype EventEmsId        = EventEmsId        Int     deriving (Eq, Show, Generic)
newtype EventTitle        = EventTitle        T.Text  deriving (Eq, Show, Generic)
newtype EventDescription  = EventDescription  T.Text  deriving (Eq, Show, Generic)
newtype EventLocation     = EventLocation     T.Text  deriving (Eq, Show, Generic)
newtype EventCategory     = EventCategory     T.Text  deriving (Eq, Show)
newtype EventCancelled    = EventCancelled    Bool    deriving (Eq, Show, Generic)
newtype EventOnHold       = EventOnHold       Bool    deriving (Eq, Show, Generic)
newtype EventTechStay     = EventTechStay     Bool    deriving (Eq, Show, Generic)
newtype EventVideo        = EventVideo        Bool    deriving (Eq, Show)
newtype EventAudio        = EventAudio        Bool    deriving (Eq, Show)
newtype EventStaffNeeded  = EventStaffNeeded  Int     deriving (Eq, Show, Generic)
newtype EventReserveStart = EventReserveStart UTCTime deriving (Eq, Show, Generic)
newtype EventReserveEnd   = EventReserveEnd   UTCTime deriving (Eq, Show, Generic)
newtype EventStart        = EventStart        UTCTime deriving (Eq, Show, Generic)
newtype EventEnd          = EventEnd          UTCTime deriving (Eq, Show, Generic)

-- | Type of each JSON entry in record syntax.
data Event = Event { getId           :: EventId
                   , getEmsId        :: EventEmsId
                   , getTitle        :: EventTitle
                   , getDescription  :: EventDescription
                   , getLocation     :: EventLocation
                   , getCategory     :: EventCategory
                   , getCancelled    :: EventCancelled
                   , getOnHold       :: EventOnHold
                   , getTechStay     :: EventTechStay
                   , getVideo        :: EventVideo
                   , getAudio        :: EventAudio
                   , getStaffNeeded  :: EventStaffNeeded
                   , getReserveStart :: EventReserveStart
                   , getReserveEnd   :: EventReserveEnd
                   , getStart        :: EventStart
                   , getEnd          :: EventEnd
                   , getShifts       :: [Shift]
                   , getNotes        :: [Note]
                   , getInventory    :: [Inventory]
                   } deriving (Eq, Show)

instance FromJSON EventId
instance FromJSON EventEmsId
instance FromJSON EventTitle
instance FromJSON EventDescription
instance FromJSON EventLocation
instance FromJSON EventCategory where
  parseJSON (String v) = if   v `elem` ["A", "B", "C"]
                         then pure $ EventCategory v
                         else mzero
  parseJSON _          = mzero
instance FromJSON EventCancelled
instance FromJSON EventOnHold
instance FromJSON EventTechStay
instance FromJSON EventVideo where
  parseJSON (Bool v) = pure $ EventVideo v
  parseJSON _        = mzero
instance FromJSON EventAudio where
  parseJSON (Bool v) = pure $ EventAudio v
  parseJSON _        = mzero
instance FromJSON EventStaffNeeded
instance FromJSON EventReserveStart
instance FromJSON EventReserveEnd
instance FromJSON EventStart
instance FromJSON EventEnd
instance FromJSON Event where
  parseJSON (Object v) =
    Event <$> v .: "_id"
          <*> v .: "XMLid"
          <*> v .: "title"
          <*> v .: "desc"
          <*> v .: "loc"
          <*> v .: "category"
          <*> v .: "cancelled"
          <*> v .: "onHold"
          <*> v .: "techMustStay"
          <*> fmap (fromMaybe (EventVideo False)) (v .:? "video")
          <*> fmap (fromMaybe (EventAudio False)) (v .:? "audio")
          <*> v .: "staffNeeded"
          <*> v .: "start"
          <*> v .: "end"
          <*> v .: "eventStart"
          <*> v .: "eventEnd"
          <*> v .: "shifts"
          <*> v .: "notes"
          <*> v .: "inventory"
  parseJSON _ = mzero

-- | Example.
getJSON :: IO B.ByteString
getJSON = B.readFile "events.json"

main :: IO ()
main = do
  d <- (eitherDecode <$> getJSON) :: IO (Either String [Event])
  case d of
    Left err -> putStrLn err
    Right ps -> print ps