rnhmjoj/breve
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Better way to send JSON

Browse Source
This commit is contained in:
rnhmjoj 2015-05-09 23:04:14 +02:00
parent ab9ef4e277
commit 257e94f474
1 changed files with 5 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
src/Application.hs
View File

@ -8,7 +8,7 @@ import Views
import Control.Monad.IO.Class (liftIO) import Control.Monad.IO.Class (liftIO)
import Text.Printf (printf) import Text.Printf (printf)
import Data.Aeson import Data.Aeson hiding (json)
import Data.Monoid import Data.Monoid
import Data.Text (pack, unpack) import Data.Text (pack, unpack)
import Data.Text.Lazy.Encoding (decodeUtf8) import Data.Text.Lazy.Encoding (decodeUtf8)
@ -40,7 +40,7 @@ app url' table = do
logStr (printf "Resolved %s -> %s" name url) logStr (printf "Resolved %s -> %s" name url)
redirect (pack url) redirect (pack url)
post root $ do post "/" $ do
url <- fmap unpack <$> param "url" url <- fmap unpack <$> param "url"
case url of case url of
Nothing -> html (render $ message "bad request") Nothing -> html (render $ message "bad request")
@ -57,7 +57,6 @@ app url' table = do
Just url -> do Just url -> do
name <- liftIO (insert table url) name <- liftIO (insert table url)
logStr (printf "Registered %s -> %s " url name) logStr (printf "Registered %s -> %s " url name)
let json = object [ "link" .= pack (url' <> name) json $ object [ "link" .= pack (url' <> name)
, "name" .= name , "name" .= name
, "original" .= url ] , "original" .= url ]
text (toStrict $ decodeUtf8 $ encode json)