Aeson example

Main.hs

-- build with cabal file:

-- name: aeson-ex
-- version: 0.1
-- build-type: Simple
-- 
-- executable aeson_ex
--   hs-source-dirs:  src
--   main-is:         Main.hs
--   build-depends:   base >= 4,
--                    aeson,
--                    time,
--                    bytestring
--   ghc-options:     -Wall


-- run with:
-- curl http://data.itsfactory.fi/siriaccess/vm/json | cabal run

{-# LANGUAGE DeriveGeneric #-}
module Main where
import GHC.Generics
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.POSIX
import Data.Aeson
import Data.Aeson.Types (Options(..),defaultOptions)
import Data.Char (toUpper)
import qualified Data.ByteString.Lazy as BS

-- define some domain specific types
data Ref = Ref { _value :: String } deriving (Generic, Show)
data Degrees = Degrees Int deriving (Generic, Show)
data LocalizedString = LocalizedString { lang :: String, value :: String } deriving (Generic, Show)
data Coordinate = Coordinate { latitude :: Degrees, longitude :: Degrees } deriving (Generic, Show)
data Timestamp = Timestamp UTCTime deriving (Generic, Show)
data Duration = Duration String deriving (Generic, Show) -- TODO: actual impl...

-- define the data structure
data Root = Root {
  siri :: Siri
} deriving (Generic, Show)
data Siri = Siri {
  serviceDelivery :: ServiceDelivery,
  version :: String
} deriving (Generic, Show)
data ServiceDelivery = ServiceDelivery {
  moreData :: Bool,
  producerRef :: Ref,
  responseTimestamp :: Timestamp,
  status :: Bool,
  vehicleMonitoringDelivery :: [VehicleMonitoringDelivery]
} deriving (Generic, Show)
data VehicleMonitoringDelivery = VehicleMonitoringDelivery {
  _responseTimestamp :: Timestamp,
  _status :: Bool,
  vehicleActivity :: [VehicleActivity],
  _version :: String
} deriving (Generic, Show)
data VehicleActivity = VehicleActivity {
  monitoredVehicleJourney :: MonitoredVehicleJourney,
  recordedAtTime :: Timestamp,
  validUntilTime :: Timestamp
} deriving (Generic, Show)
data MonitoredVehicleJourney = MonitoredVehicleJourney {
  bearing :: Degrees,
  delay :: Duration,
  destinationName :: LocalizedString,
  directionRef :: Ref,
  framedVehicleJourneyRef :: FramedVehicleJourneyRef,
  lineRef :: Ref,
  monitored :: Bool,
  operatorRef :: Ref,
  originName :: LocalizedString,
  vehicleLocation :: Coordinate,
  vehicleRef :: Ref
} deriving (Generic, Show)
data FramedVehicleJourneyRef = FramedVehicleJourneyRef {
  dataFrameRef :: Ref,
  datedVehicleJourneyRef :: String
} deriving (Generic, Show)

-- some hacks to 
-- 1) andle equal record field names
-- 2) handle the fact that the ITSFactory Siri-json-format has some capitalized field names
unPrefix = dropWhile (== '_')
capitalize s@"version" = s
capitalize s@"value" = s
capitalize s@"lang" = s
capitalize str = toUpper (head str) : tail str
options = defaultOptions { fieldLabelModifier = capitalize . unPrefix }

-- JSON deserialization definitions
instance FromJSON Ref where parseJSON = genericParseJSON options
instance FromJSON Degrees where parseJSON = genericParseJSON options
instance FromJSON LocalizedString where parseJSON = genericParseJSON options
instance FromJSON Coordinate where parseJSON = genericParseJSON options
instance FromJSON Duration where parseJSON = genericParseJSON options
instance FromJSON Timestamp where parseJSON i = Timestamp . posixSecondsToUTCTime . fromInteger <$> parseJSON i
instance FromJSON Root where parseJSON = genericParseJSON options
instance FromJSON Siri where parseJSON = genericParseJSON options
instance FromJSON ServiceDelivery where parseJSON = genericParseJSON options
instance FromJSON VehicleMonitoringDelivery where parseJSON = genericParseJSON options
instance FromJSON VehicleActivity where parseJSON = genericParseJSON options
instance FromJSON MonitoredVehicleJourney where parseJSON = genericParseJSON options
instance FromJSON FramedVehicleJourneyRef where parseJSON = genericParseJSON options



main = do
  jsonData <- BS.getContents
  
  case eitherDecode jsonData of
    Left err ->
      print err
    -- ah, blessed pattern matching...
    Right (Root (Siri (ServiceDelivery _ _ _ _ vehicleMonitoringDeliveries) _)) ->
      print vehicleRefs
      where
       getVehicleActivities (VehicleMonitoringDelivery _ _ vehicleActivities _) = vehicleActivities
       getVehicleRef (VehicleActivity (MonitoredVehicleJourney _ _ _ _ _ _ _ _ _ _ (Ref vehicleRef)) _ _) = vehicleRef
       vehicleRefs = map getVehicleRef (concatMap getVehicleActivities vehicleMonitoringDeliveries)

In a static language:

• data is really well defined upfront, whereas in JavaScript or Clojure it's more ad-hoc within the application logic.
• serialization/deserialization is completely separated from the data definitions and the application using the data. Thus you can add e.g. XML or binary serialization without messing with the data definitions.
• no need to handle low-level data (lists, maps, strings...) when there exists a more structural or "sensible" format, for example with timestamps.
• and one can always use just maps and lists if it's a simple use case or the app is interested in only a small part of the data.

Perhaps everything is possible with (Typed) Clojure, but is it still idiomatic?