No title

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
{-# LANGUAGE RecordWildCards #-}

module Test where

import           Control.Applicative        ((<|>))
import           Data.Aeson
import           Data.Aeson.Types
import qualified Data.ByteString.Lazy       as LB
import qualified Data.ByteString.Lazy.Char8 as C
import qualified Data.HashMap.Lazy          as HM
import           Data.Monoid                ((<>))
import           Data.Text                  (pack)
import           GHC.Generics               (Generic)
import           Prelude

data Document = Document
  { count  :: Int
  , events :: [Event]
  } deriving (Show)

data Event = Event
  { sequence :: Int
  , entry    :: Entry
  } deriving (Show)

data Entry
  = Content String
  | Answer String String
  deriving (Show)

instance FromJSON Document where
  parseJSON =
    withObject "The document" $ \o -> do
      count <- o .: "count"
      events <- extractKey "events" =<< extractEmbedded o
      return Document {..}

instance FromJSON Event where
    parseJSON = withObject "A event" $ \o -> do
      sequence <- o .: "sequence"
      entry <- extractEntry =<< extractEmbedded o
      return Event {..}

instance FromJSON Entry where
  parseJSON v = parseContent v <|> parseAnswer v

    where
      parseContent :: Value -> Parser Entry
      parseContent = withObject "An entry of type content" $ \o -> do
        content <- o .: "content"
        return $ Content content

      parseAnswer :: Value -> Parser Entry
      parseAnswer = withObject "An entry of type answer" $ \o -> do
        answer <- o .: "answer"
        question <- extractKey "question" =<< extractKey "question" =<< extractEmbedded o
        return $ Answer answer question

extractEmbedded :: FromJSON a => Object -> Parser a
extractEmbedded = extractKey "_embedded"

extractEntry :: FromJSON a => Object -> Parser a
extractEntry = extractKey "entry"

extractKey :: FromJSON a => String -> Object -> Parser a
extractKey k o = maybe (fail $ "key " <> show k <> " missing") parseJSON (HM.lookup (pack k) o)

json_data :: IO LB.ByteString
json_data = C.readFile "./src/data.json"

main = do
    c <- json_data
    let v = eitherDecode c :: Either String Document
    putStrLn . show $ v