parsing some JSON data and displaying it hackily, but stuff is coming…

… together. needs some cleanup tho

Gauges/API/Data.hs

@@ -1,23 +1,55 @@
 module Gauges.API.Data 
        (
-
+         GaugesSummary(..),
+         GaugeSummary(..),
+         GaugeSummaryStats(..)
        ) where
 
-import Text.JSON (JSON(..), JSValue(..), fromJSObject)
+import Text.JSON (JSON(..), JSValue(..), fromJSObject, Result)
 import Control.Applicative (Applicative(..), Alternative(..), liftA2, (<$>))
 
-newtype GaugesSummary = GaugesSummary [GaugeSummary]  
+newtype GaugesSummary = GaugesSummary [GaugeSummary] deriving (Show)
 -- id, title, views, people
-data GaugeSummary = GuageSummary String Int Int
-
-data TestGaugeSummary = TestGaugeSummary String String
-
-instance JSON TestGaugeSummary where  
-  showJSON gs = error "We have no need to show Data JSON right now"
-  readJSON (JSObject o) = 
-    let obj = fromJSObject o
-    in liftA2 TestGaugeSummary (show <$> (aLookup "title" obj)) (show <$> (aLookup "id" obj)) -- its failing to compile here because these return JSValue not 
-  readJSON _            = fail "not an object"
+data GaugeSummary = GaugeSummary { id :: String, 
+                                   title :: String, 
+                                   stats :: GaugeSummaryStats 
+                                 } deriving (Show)
+-- view count, people count
+data GaugeSummaryStats = GaugeSummaryStats { views :: Int, people :: Int } deriving (Show)
+
+instance JSON GaugesSummary where
+  showJSON = error "not showing JSON"
+  readJSON (JSObject o) = GaugesSummary <$> summaries
+    where
+      obj = fromJSObject o
+      summaries :: Result [GaugeSummary]
+      summaries = (aLookup "gauges" obj) >>= readJSONs
+
+  readJSON _            = error "not an object"
+
+instance JSON GaugeSummary where
+  showJSON gs = error "We have no need to showJSON data right now"
+  readJSON (JSObject o) = GaugeSummary <$> idData <*> titleData <*> summaryData
+    where 
+      obj = fromJSObject o    
+      titleData :: Result String
+      titleData = (aLookup "title" obj) >>= readJSON
+      idData :: Result String
+      idData = (aLookup "id" obj) >>= readJSON 
+      summaryData = (aLookup "today" obj) >>= readJSON
+  readJSON _            = error "not an object"
+
+instance JSON GaugeSummaryStats where
+  showJSON gs = error "no need to show json"
+  readJSON (JSObject o) = liftA2 GaugeSummaryStats viewsData peopleData
+    where
+      obj = fromJSObject o
+      viewsData :: Result Int
+      viewsData = (aLookup "views" obj) >>= readJSON
+      peopleData :: Result Int
+      peopleData = (aLookup "people" obj) >>= readJSON
+  readJSON _            = fail "expected object"
+
 
 aLookup :: (Alternative t, Eq a) => a -> [(a, b)] -> t b 
 aLookup a as = maybe empty pure (lookup a as)

Main.hs

@@ -1,15 +1,19 @@
 module Main (main) where
 
+-- this file really needs cleaning up and things moved out of it
+
 import Gauges.CLI.Credentials (credentialPath,
                                readCredential,
                                validateCredential,
                                writeCredential)
 import Gauges.CLI.Interact (sayLine, saysLine, say, ask, prompt)
 import Gauges.API.Client (Client, createClient, getResponse)  
 import Gauges.API.Resources (gaugesR)
+import Gauges.API.Data (GaugesSummary)
 import System.Directory (doesFileExist)
 import System (getArgs)
 import Network.Curl.Code (CurlCode(..))
+import Text.JSON (Result, decode)
 
 main = do
   args <- getArgs
@@ -55,7 +59,7 @@ listCommand :: Client -> IO ()
 listCommand c = do  
   (res,resp) <- getResponse c gaugesR
   say $ case res of 
-    CurlOK ->  resp
+    CurlOK ->  show (decode resp :: Result GaugesSummary)
     _      -> "Failed to download information about gauges."
 
 help = sayLine "USAGE: gauges [COMMAND]"