diff --git a/.ghci b/.ghci index a015de1..821d0b6 100644 --- a/.ghci +++ b/.ghci @@ -2,3 +2,4 @@ :set -XOverloadedStrings :set -XTemplateHaskell :set -XFlexibleInstances +:set -XScopedTypeVariables diff --git a/memoise.cabal b/memoise.cabal index 6003f3a..3de42e8 100644 --- a/memoise.cabal +++ b/memoise.cabal @@ -1,5 +1,5 @@ Name: memoise -Version: 0.8 +Version: 0.9 License: BSD3 Author: Ryan Trinkle Maintainer: ryan.trinkle@gmail.com @@ -26,3 +26,4 @@ Executable memoise Extensions: OverloadedStrings , TemplateHaskell , FlexibleInstances + , ScopedTypeVariables diff --git a/src/Main.hs b/src/Main.hs index caaf445..e527c6c 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -2,6 +2,7 @@ import Snap import Snap.Snaplet.Heist import Snap.Snaplet.PostgresqlSimple import Snap.Util.FileServe +import Snap.Extras.CoreUtils import Snap.Extras.TextUtils import Control.Lens import Data.Text @@ -38,10 +39,21 @@ indexHandler = do case mUrl of Just url -> do urlId <- getUrlId $ decodeUtf8 url - mainTextboxContents .= Just ("URL saved with id " <> showT urlId) + mainTextboxContents .= Just ("http://memoi.se/" <> showT urlId) render "index" Nothing -> render "index" +redirectHandler :: Handler Memoise Memoise () +redirectHandler = do + mUrlId :: Maybe Integer <- readMayParam "urlId" + case mUrlId of + Nothing -> redirect "/" + Just urlId -> do + results <- query "SELECT url FROM urls WHERE id = ?" (Only urlId) + case results of + (Only url) : _ -> redirect url + [] -> redirect "/" + mainTextboxAttributeSplice :: AttrSplice (Handler Memoise Memoise) mainTextboxAttributeSplice _ = do mContents <- lift $ use mainTextboxContents @@ -55,6 +67,7 @@ memoiseInit = makeSnaplet "memoise" "The world's laziest hyperlink shortener" No modifyHeistState $ bindAttributeSplices [("main-textbox", mainTextboxAttributeSplice)] d <- nestSnaplet "db" db pgsInit addRoutes [ ("static", serveDirectory "static") + , (":urlId", redirectHandler) , ("", indexHandler) ] return $ Memoise { _heist = h