module Handler.Utils where
import Prelude
import Control.Applicative ((<$>))
import Control.Monad.IO.Class (liftIO)
import Data.IORef
import Data.Maybe
import Data.Text(pack,unpack)
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.Format
import System.Locale (defaultTimeLocale)
#if BLAZE_HTML_0_4
import Text.Blaze (toHtml)
#else
import Text.Blaze.Html (toHtml)
#endif
import Text.Hamlet
import Yesod.Core
import Foundation
import Hledger hiding (is)
import Hledger.Cli hiding (version)
import Hledger.Web.Options
data ViewData = VD {
opts :: WebOpts
,here :: AppRoute
,msg :: Maybe Html
,today :: Day
,j :: Journal
,q :: String
,m :: Query
,qopts :: [QueryOpt]
,am :: Query
,aopts :: [QueryOpt]
,showpostings :: Bool
}
nullviewdata :: ViewData
nullviewdata = viewdataWithDateAndParams nulldate "" "" ""
viewdataWithDateAndParams :: Day -> String -> String -> String -> ViewData
viewdataWithDateAndParams d q a p =
let (querymatcher,queryopts) = parseQuery d q
(acctsmatcher,acctsopts) = parseQuery d a
in VD {
opts = defwebopts
,j = nulljournal
,here = RootR
,msg = Nothing
,today = d
,q = q
,m = querymatcher
,qopts = queryopts
,am = acctsmatcher
,aopts = acctsopts
,showpostings = p == "1"
}
getViewData :: Handler ViewData
getViewData = do
app <- getYesod
let opts@WebOpts{cliopts_=copts@CliOpts{reportopts_=ropts}} = appOpts app
(j, err) <- getCurrentJournal app copts{reportopts_=ropts{no_elide_=True}}
msg <- getMessageOr err
Just here <- getCurrentRoute
today <- liftIO getCurrentDay
q <- getParameterOrNull "q"
a <- getParameterOrNull "a"
p <- getParameterOrNull "p"
return (viewdataWithDateAndParams today q a p){
opts=opts
,msg=msg
,here=here
,today=today
,j=j
}
where
getCurrentJournal :: App -> CliOpts -> Handler (Journal, Maybe String)
getCurrentJournal app opts = do
j <- liftIO $ readIORef $ appJournal app
(jE, changed) <- liftIO $ journalReloadIfChanged opts j
if not changed
then return (j,Nothing)
else case jE of
Right j' -> do liftIO $ writeIORef (appJournal app) j'
return (j',Nothing)
Left e -> do setMessage $ "error while reading"
return (j, Just e)
getParameterOrNull :: String -> Handler String
getParameterOrNull p = unpack `fmap` fromMaybe "" <$> lookupGetParam (pack p)
getMessageOr :: Maybe String -> Handler (Maybe Html)
getMessageOr mnewmsg = do
oldmsg <- getMessage
return $ maybe oldmsg (Just . toHtml) mnewmsg
numbered :: [a] -> [(Int,a)]
numbered = zip [1..]
dayToJsTimestamp :: Day -> Integer
dayToJsTimestamp d = read (formatTime defaultTimeLocale "%s" t) * 1000
where t = UTCTime d (secondsToDiffTime 0)
chomp :: String -> String
chomp = reverse . dropWhile (`elem` "\r\n") . reverse