module Handler.Utils where
import Prelude
import Control.Applicative ((<$>))
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)
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