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

Drop text format dependency

Browse Source
This commit is contained in:
rnhmjoj 2015-08-11 05:12:58 +02:00
parent 0e4bb4024d
commit 4040f8e1f7
2 changed files with 10 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
breve.cabal
View File

@ -33,7 +33,7 @@ executable breve
Spock, blaze-html, http-types,
wai, wai-middleware-static, wai-extra,
transformers, mtl,
text, text-format, aeson, bytestring, binary,
text, aeson, bytestring, binary,
hashtables, cryptohash, random,
xdg-basedir, configurator, directory
ghc-options: -threaded -O2

15
src/Application.hs
View File

@ -10,7 +10,7 @@ import Data.Monoid
import Control.Monad.IO.Class (liftIO)
import Data.Aeson hiding (json)
import Data.Text (Text)
import qualified Data.Text.Format as F
import qualified Data.Text.IO as T
import Web.Spock.Safe
import Network.HTTP.Types.Status
@ -27,6 +27,10 @@ reply :: Status -> Text -> ActionT IO ()
reply code text = setStatus code >> render (message text)
logStr :: Text -> ActionT IO ()
logStr = liftIO . T.putStrLn
app :: Url -> UrlTable -> SpockT IO ()
app url' table = do
static <- liftIO (getDataFileName "static/")
@ -41,7 +45,7 @@ app url' table = do
case url of
Nothing -> reply status404 "404: does not exist"
Just url -> do
F.print "Resolved {} -> {} " (name, url)
logStr ("Resolved " <> name <> " -> " <> url)
redirect url
post "/" $ do
@ -50,9 +54,8 @@ app url' table = do
Nothing -> reply status400 "400: bad request"
Just url -> do
name <- liftIO (insert table url)
F.print "Registered {} -> {} " (url, name)
let link = url' <> name
render (done link)
logStr ("Registered " <> url <> " -> " <> name)
render (done $ url' <> name)
post "api" $ do
url <- param "url"
@ -63,7 +66,7 @@ app url' table = do
, "msg" .= ("missing url field" :: Text ) ]
Just url -> do
name <- liftIO (insert table url)
F.print "Registered {} -> {} " (url, name)
logStr ("Registered " <> url <> " -> " <> name)
json $ object [ "link" .= (url' <> name)
, "name" .= name
, "original" .= url ]