Aeson output of cached files in place.

hcole-server.cabal

@@ -19,6 +19,7 @@ Executable coleserver
   main-is: Main.hs
 
   Build-depends:
+    aeson >= 0.3.2.11,
     base >= 4 && < 5,
     bytestring >= 0.9.1 && < 0.10,
     directory,

src/Application.hs

@@ -29,9 +29,10 @@ type Application = SnapExtend ApplicationState
 -- templates, and Timer simply to illustrate the config loading differences
 -- between development and production modes.
 data ApplicationState = ApplicationState
-    { templateState :: HeistState Application
-    , timerState    :: TimerState
-    , cacheState    :: FSCacheState
+    { templateState     :: HeistState Application
+    , timerState        :: TimerState
+    , cacheState        :: FSCacheState
+    --, coleConfigState   :: ColeConfigState
     }
 
 
@@ -63,6 +64,6 @@ applicationInitializer :: Initializer ApplicationState
 applicationInitializer = do
     heist <- heistInitializer "resources/templates" id
     timer <- timerInitializer
-    cache <- fsCacheInitializer "/Users/ageorges/tmp/brol"
+    cache <- fsCacheInitializer "/Users/ageorges/tmp/hcole-server"
     return $ ApplicationState heist timer cache
 

src/Cole/ColeData.hs

@@ -43,12 +43,12 @@ mkColeData fp = do
                     }
 
 instance A.ToJSON ColeData where
-  toJSON cd = A.object [ pack "coleRefSpeedup"       A..= coleRefSpeedup cd
-                       , pack "coleTrainSpeedup"     A..= coleTrainSpeedup cd
-                       , pack "coleCompilationTime"  A..= coleCompilationTime cd
-                       , pack "coleCodeSize"         A..= coleCodeSize cd
-                       , pack "coleRefEnergyUsage"   A..= coleRefEnergyUsage cd
-                       , pack "coleTrainEnergyUsage" A..= coleTrainEnergyUsage cd
+  toJSON cd = A.object [ "coleRefSpeedup"       A..= coleRefSpeedup cd
+                       , "coleTrainSpeedup"     A..= coleTrainSpeedup cd
+                       , "coleCompilationTime"  A..= coleCompilationTime cd
+                       , "coleCodeSize"         A..= coleCodeSize cd
+                       , "coleRefEnergyUsage"   A..= coleRefEnergyUsage cd
+                       , "coleTrainEnergyUsage" A..= coleTrainEnergyUsage cd
                        ]
 
 -- FIXME: Perhaps we should also have a FromJSON instance?

src/Site.hs

@@ -12,11 +12,13 @@ module Site
   ) where
 
 import           Control.Applicative
+import qualified Data.Aeson as A
 import           Data.ByteString.Char8 (unpack, pack)
 import           Data.Maybe
 import qualified Data.Text as T
 import qualified Data.Text.Encoding as TE
-import qualified Text.JSON as JSON
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TLE
 
 import           Snap.Extension.Heist
 import           Snap.Extension.Timer
@@ -60,13 +62,20 @@ sequence :: Application ()
 sequence = do
     s <- decodedParam "sequence"
     -- check if the sequence exists in the cache
+    -- FIXME: This should follow a different pattern. Once we have the DB
+    -- added to the application, we first check the DB for the key. This
+    -- has three possible results: (i) the sequence has been measured, i.e., the 
+    -- data is available in the filesystem cache, (ii) the sequence is being 
+    -- measured, thus we need not launch a new measurement, and (iii) the sequence 
+    -- is unknown to the system, so we need to launch a measurement and update the
+    -- DB accordingly.
     v <- fsCacheRequest (unpack s) 
     case v of
-      Just (s, c) -> do let jsonResponse = T.pack $ JSON.encode ("dit is een test" :: String, 1.0 :: Double)
-                        modifyResponse $ setResponseCode 200 
-                                       . setContentType (pack "application/json")
-                                       . setContentLength (fromIntegral $ T.length jsonResponse) --FIXME
-                        writeText $ jsonResponse 
+      Just coleData -> do let jsonResponse = TLE.decodeUtf8 . A.encode . A.toJSON $ coleData
+                          modifyResponse $ setResponseCode 200 
+                                         . setContentType (pack "application/json")
+                                         . setContentLength (fromIntegral $ TL.length jsonResponse) --FIXME
+                          writeText . TL.toStrict $ jsonResponse 
       Nothing -> do modifyResponse $ setResponseCode 404
                                    . setContentLength 3
 

src/Snap/Extension/FileSystemCache.hs

@@ -67,6 +67,7 @@ instance InitializerState FSCacheState where
 instance HasFileSystemCacheState s => MonadFSCache (SnapExtend s) where
     fsCacheRequest filename = do 
         fsCacheState <- asks getFSCacheState
+        -- FIXME: this should be made cleaner.
         fss <- liftIO $ getDirectoryContents (fsCacheDir fsCacheState)
         if filename `elem` fss 
             then do cd <- liftIO $ mkColeData (combine (fsCacheDir fsCacheState) filename)

src/Splice/Cole.hs

@@ -20,7 +20,7 @@ import           Application
 
 coleCachePlaceHolder :: Splice Application
 coleCachePlaceHolder = do 
-  dirListing <- liftIO . getDirectoryContents $ "/Users/ageorges/tmp/brol"
+  dirListing <- liftIO . getDirectoryContents $ "/Users/ageorges/tmp/hcole-server"
   return $ map (TextNode . T.pack) dirListing