Permalink
Browse files

Add refererLink splice

  • Loading branch information...
1 parent 33801ee commit e9b7ad08077d3564d86884486ef5d9e0cd1a2348 @mightybyte mightybyte committed Apr 3, 2013
Showing with 13 additions and 0 deletions.
  1. +6 −0 src/Snap/Extras/SpliceUtils/Compiled.hs
  2. +7 −0 src/Snap/Extras/SpliceUtils/Interpreted.hs
@@ -19,9 +19,15 @@ import Text.XmlHtml
utilSplices :: MonadSnap m => [(Text, Splice m)]
utilSplices = [ ("rqparam", paramSplice)
+ , ("refererLink", refererCSplice)
]
+refererCSplice :: MonadSnap m => Splice m
+refererCSplice = return $ yieldRuntimeText $ return .
+ maybe "/" T.decodeUtf8 =<< lift (getsRequest (getHeader "Referer"))
+
+
------------------------------------------------------------------------------
-- | Gets the value of a request parameter. Example use:
--
@@ -8,6 +8,7 @@ module Snap.Extras.SpliceUtils.Interpreted
, runTextAreas
, scriptsSplice
, ifFlagSplice
+ , refererSplice
) where
-------------------------------------------------------------------------------
@@ -32,9 +33,15 @@ import Text.XmlHtml
utilSplices :: [(Text, SnapletISplice b)]
utilSplices =
[ ("rqparam", paramSplice)
+ , ("refererLink", refererSplice)
]
+refererSplice :: MonadSnap m => Splice m
+refererSplice =
+ textSplice . maybe "/" T.decodeUtf8 =<< lift (getsRequest (getHeader "Referer"))
+
+
------------------------------------------------------------------------------
-- | Gets the value of a request parameter. Example use:
--

0 comments on commit e9b7ad0

Please sign in to comment.