web: fix non-ascii handling with ghc 6.12
The "GHC 6.12.1 has UTF8 support on board. Using System.IO.UTF8 can cause problems." patch was over-zealous. Restore and clarify UTF8 handling with 6.12.
This commit is contained in:
parent
287e71d54f
commit
7dbcb035bb
@ -6,9 +6,7 @@ A web-based UI.
|
|||||||
|
|
||||||
module Hledger.Cli.Commands.Web
|
module Hledger.Cli.Commands.Web
|
||||||
where
|
where
|
||||||
#if __GLASGOW_HASKELL__ <= 610
|
|
||||||
import Codec.Binary.UTF8.String (decodeString)
|
import Codec.Binary.UTF8.String (decodeString)
|
||||||
#endif
|
|
||||||
import Control.Applicative.Error (Failing(Success,Failure))
|
import Control.Applicative.Error (Failing(Success,Failure))
|
||||||
import Control.Concurrent
|
import Control.Concurrent
|
||||||
import Control.Monad.Reader (ask)
|
import Control.Monad.Reader (ask)
|
||||||
@ -83,8 +81,8 @@ server opts args j =
|
|||||||
#endif
|
#endif
|
||||||
\env -> do -- IO Response
|
\env -> do -- IO Response
|
||||||
-- general request handler
|
-- general request handler
|
||||||
let a = intercalate "+" $ reqparam env "a"
|
let a = intercalate "+" $ map decodeString $ reqParamUtf8 env "a"
|
||||||
p = intercalate "+" $ reqparam env "p"
|
p = intercalate "+" $ map decodeString $ reqParamUtf8 env "p"
|
||||||
opts' = opts ++ [Period p]
|
opts' = opts ++ [Period p]
|
||||||
args' = args ++ words a
|
args' = args ++ words a
|
||||||
j' <- fromJust `fmap` getValue "hledger" "journal"
|
j' <- fromJust `fmap` getValue "hledger" "journal"
|
||||||
@ -110,12 +108,8 @@ getenv = ask
|
|||||||
response = update
|
response = update
|
||||||
redirect u c = response $ Hack.Contrib.Response.redirect u c
|
redirect u c = response $ Hack.Contrib.Response.redirect u c
|
||||||
|
|
||||||
reqparam :: Hack.Env -> String -> [String]
|
reqParamUtf8 :: Hack.Env -> String -> [String]
|
||||||
#if __GLASGOW_HASKELL__ <= 610
|
reqParamUtf8 env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env
|
||||||
reqparam env p = map (decodeString.snd) $ filter ((==p).fst) $ Hack.Contrib.Request.params env
|
|
||||||
#else
|
|
||||||
reqparam env p = map snd $ filter ((==p).fst) $ Hack.Contrib.Request.params env
|
|
||||||
#endif
|
|
||||||
|
|
||||||
journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal
|
journalReloadIfChanged :: [Opt] -> [String] -> Journal -> IO Journal
|
||||||
journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do
|
journalReloadIfChanged opts _ j@Journal{filepath=f,filereadtime=tread} = do
|
||||||
@ -170,7 +164,7 @@ hsp msgs f = do
|
|||||||
hackEnvToHspEnv :: Hack.Env -> IO HSPEnv
|
hackEnvToHspEnv :: Hack.Env -> IO HSPEnv
|
||||||
hackEnvToHspEnv env = do
|
hackEnvToHspEnv env = do
|
||||||
x <- newIORef 0
|
x <- newIORef 0
|
||||||
let req = HSP.Request (reqparam env) (Hack.http env)
|
let req = HSP.Request (reqParamUtf8 env) (Hack.http env)
|
||||||
num = NumberGen (atomicModifyIORef x (\a -> (a+1,a)))
|
num = NumberGen (atomicModifyIORef x (\a -> (a+1,a)))
|
||||||
return $ HSPEnv req num
|
return $ HSPEnv req num
|
||||||
|
|
||||||
@ -203,11 +197,7 @@ navbar env =
|
|||||||
<a href="http://hledger.org/MANUAL.html" id="helplink">help</a>
|
<a href="http://hledger.org/MANUAL.html" id="helplink">help</a>
|
||||||
</div>
|
</div>
|
||||||
|
|
||||||
#if __GLASGOW_HASKELL__ <= 610
|
|
||||||
getParamOrNull p = (decodeString . fromMaybe "") `fmap` getParam p
|
getParamOrNull p = (decodeString . fromMaybe "") `fmap` getParam p
|
||||||
#else
|
|
||||||
getParamOrNull p = fromMaybe "" `fmap` getParam p
|
|
||||||
#endif
|
|
||||||
|
|
||||||
navlinks :: Hack.Env -> HSP XML
|
navlinks :: Hack.Env -> HSP XML
|
||||||
navlinks _ = do
|
navlinks _ = do
|
||||||
@ -241,13 +231,8 @@ addform :: Hack.Env -> HSP XML
|
|||||||
addform env = do
|
addform env = do
|
||||||
today <- io $ liftM showDate $ getCurrentDay
|
today <- io $ liftM showDate $ getCurrentDay
|
||||||
let inputs = Hack.Contrib.Request.inputs env
|
let inputs = Hack.Contrib.Request.inputs env
|
||||||
#if __GLASGOW_HASKELL__ <= 610
|
|
||||||
date = decodeString $ fromMaybe today $ lookup "date" inputs
|
date = decodeString $ fromMaybe today $ lookup "date" inputs
|
||||||
desc = decodeString $ fromMaybe "" $ lookup "desc" inputs
|
desc = decodeString $ fromMaybe "" $ lookup "desc" inputs
|
||||||
#else
|
|
||||||
date = fromMaybe today $ lookup "date" inputs
|
|
||||||
desc = fromMaybe "" $ lookup "desc" inputs
|
|
||||||
#endif
|
|
||||||
<div>
|
<div>
|
||||||
<div id="addform">
|
<div id="addform">
|
||||||
<form action="" method="POST">
|
<form action="" method="POST">
|
||||||
@ -277,13 +262,8 @@ help topic = <a href=u>?</a>
|
|||||||
transactionfields :: Int -> Hack.Env -> HSP XML
|
transactionfields :: Int -> Hack.Env -> HSP XML
|
||||||
transactionfields n env = do
|
transactionfields n env = do
|
||||||
let inputs = Hack.Contrib.Request.inputs env
|
let inputs = Hack.Contrib.Request.inputs env
|
||||||
#if __GLASGOW_HASKELL__ <= 610
|
|
||||||
acct = decodeString $ fromMaybe "" $ lookup acctvar inputs
|
acct = decodeString $ fromMaybe "" $ lookup acctvar inputs
|
||||||
amt = decodeString $ fromMaybe "" $ lookup amtvar inputs
|
amt = decodeString $ fromMaybe "" $ lookup amtvar inputs
|
||||||
#else
|
|
||||||
acct = fromMaybe "" $ lookup acctvar inputs
|
|
||||||
amt = fromMaybe "" $ lookup amtvar inputs
|
|
||||||
#endif
|
|
||||||
<tr>
|
<tr>
|
||||||
<td>
|
<td>
|
||||||
<% nbsp %><% nbsp %>
|
<% nbsp %><% nbsp %>
|
||||||
@ -306,21 +286,12 @@ handleAddform j = do
|
|||||||
validate :: Hack.Env -> Day -> Failing Transaction
|
validate :: Hack.Env -> Day -> Failing Transaction
|
||||||
validate env today =
|
validate env today =
|
||||||
let inputs = Hack.Contrib.Request.inputs env
|
let inputs = Hack.Contrib.Request.inputs env
|
||||||
#if __GLASGOW_HASKELL__ <= 610
|
|
||||||
date = decodeString $ fromMaybe "today" $ lookup "date" inputs
|
date = decodeString $ fromMaybe "today" $ lookup "date" inputs
|
||||||
desc = decodeString $ fromMaybe "" $ lookup "desc" inputs
|
desc = decodeString $ fromMaybe "" $ lookup "desc" inputs
|
||||||
acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs
|
acct1 = decodeString $ fromMaybe "" $ lookup "acct1" inputs
|
||||||
amt1 = decodeString $ fromMaybe "" $ lookup "amt1" inputs
|
amt1 = decodeString $ fromMaybe "" $ lookup "amt1" inputs
|
||||||
acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs
|
acct2 = decodeString $ fromMaybe "" $ lookup "acct2" inputs
|
||||||
amt2 = decodeString $ fromMaybe "" $ lookup "amt2" inputs
|
amt2 = decodeString $ fromMaybe "" $ lookup "amt2" inputs
|
||||||
#else
|
|
||||||
date = fromMaybe "today" $ lookup "date" inputs
|
|
||||||
desc = fromMaybe "" $ lookup "desc" inputs
|
|
||||||
acct1 = fromMaybe "" $ lookup "acct1" inputs
|
|
||||||
amt1 = fromMaybe "" $ lookup "amt1" inputs
|
|
||||||
acct2 = fromMaybe "" $ lookup "acct2" inputs
|
|
||||||
amt2 = fromMaybe "" $ lookup "amt2" inputs
|
|
||||||
#endif
|
|
||||||
validateDate "" = ["missing date"]
|
validateDate "" = ["missing date"]
|
||||||
validateDate _ = []
|
validateDate _ = []
|
||||||
validateDesc "" = ["missing description"]
|
validateDesc "" = ["missing description"]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user