lift . return . workIndex $ fmap (^. _PLogEntry) rows

  lift . pure . workIndex $ fmap (^. _PLogEntry) rows

{-# LANGUAGE OverloadedStrings #-}

import Data.Aeson

instance ToJSON Interval where
  toJSON (Interval s e) = 
    object ["start" .= s, "end" .= e]

instance FromJSON Interval where
  parseJSON (Object v) = Interval <$> v .: "start" <*> v .: "end"
  parseJSON _ = mzero

import Data.Aeson

instance FromJSON WorkEvent where
  parseJSON (Object jv) = 
    WorkEvent <$> (jv .: "type" >>= nameEvent) <*> jv .: "timestamp"     
  parseJSON _ = mzero

instance FromJSON LogEntry where
  parseJSON (Object jv) = 
    LogEntry <$> jv .: "btcAddr" <*> jv .: "workEvent"
  parseJSON _ = mzero

type WorkIndex = Map BtcAddr ([WorkEvent], [Interval])

type WorkIndex = Map BtcAddr [Interval]

type RawIndex = Map BtcAddr ([LogEntry], [LogInterval])

      (totalTime, keyTimes) = MS.mapAccum addIntervalDiff (fromInteger 0) $ MS.map snd widx
  in  MS.map (\kt -> toRational $ kt / totalTime) keyTimes

      (totalTime, keyTimes) = MS.mapAccum addIntervalDiff (fromInteger 0) $ widx
  in  fmap (\kt -> toRational $ kt / totalTime) keyTimes

  in  MS.map (bimap (fmap (^. event)) (fmap workInterval)) $ logSum

  in  fmap (fmap workInterval . snd) $ logSum

type RawIndex = Map BtcAddr ([LogEntry], [LogInterval])

-- data LogEventParseError = LogEventParseError String deriving (Show, Typeable)
-- instance Exception LogEventParseError where
-- instance FromField WorkEvent where
--   fromField f m = let fromText "start_work" = return StartWork
--                       fromText "stop_work"  = return StopWork
--                       fromText a = conversionError $ LogEventParseError $ "unrecognized log event type " ++ a
--                   in fromField f m >>= fromText
-- instance FromRow LogEntry where
--   fromRow = LogEntry <$> field <*> field <*> field 

import Control.Lens

import Data.Map

  , ("loggedIntervals/:btcAddr", loggedIntervals qdb)

loggedIntervals :: QDB IO a -> ReaderT a Snap ()
loggedIntervals qdb = do
  let QDB{..} = qdb
  widx <- mapReaderT liftIO $ readWorkIndex
  lift . modifyResponse $ addHeader "content-type" "application/json"
  lift . writeLBS . A.encode $ mapKeys (^. address) widx