Add redirect functionality.

Ryan Trinkle · Ryan Trinkle · commit 4692ced0cb4b · 2013-11-15T10:35:07.000-05:00
diff --git a/.ghci b/.ghci
@@ -2,3 +2,4 @@
 :set -XOverloadedStrings
 :set -XTemplateHaskell
 :set -XFlexibleInstances
+:set -XScopedTypeVariables
diff --git 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
@@ -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
