Browse files

Add formlet and splices for Day

  • Loading branch information...
1 parent d85b361 commit b84d2396ddb121bc5d42325f770a15c7fad56838 @mightybyte mightybyte committed Aug 30, 2012
Showing with 25 additions and 1 deletion.
  1. +3 −1 restful-snap.cabal
  2. +22 −0 src/Snap/Restful.hs
View
4 restful-snap.cabal
@@ -29,10 +29,12 @@ library
ghc-prim >= 0.2 && < 0.3,
heist >= 0.8 && < 0.9,
mtl >= 2.0 && < 2.1,
+ old-locale >= 1.0 && < 1.1,
readable >= 0.1 && < 0.2,
relational >= 0.0 && < 0.1,
snap-core >= 0.9 && < 0.10,
snap >= 0.9 && < 0.10,
- text >= 0.11 && < 0.12
+ text >= 0.11 && < 0.12,
+ time >= 1.4 && < 1.5
ghc-options: -Wall -fwarn-tabs
View
22 src/Snap/Restful.hs
@@ -36,6 +36,9 @@ module Snap.Restful
, redirToItem
, HasFormlet(..)
+ , validDate
+ , simpleDateFormlet
+
, HasSplices(..)
, prefixSplices
, liftSplices
@@ -47,6 +50,7 @@ module Snap.Restful
import Control.Applicative
import Control.Arrow
import Control.Monad
+import Control.Monad.Trans
import Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as B
import Data.Char (toUpper)
@@ -57,13 +61,15 @@ import Data.Readable
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
+import Data.Time
import Data.Typeable
import Data.Word
import GHC.Generics
import Relational.Types
import Snap.Core
import Snap.Snaplet
import Snap.Snaplet.Heist
+import System.Locale
import Text.Digestive
import Text.Templating.Heist
------------------------------------------------------------------------------
@@ -105,6 +111,19 @@ instance HasFormlet FK32 where
instance HasFormlet FK64 where
formlet d = FK64 <$> stringRead "must be a foreign key" (unFK64 <$> d)
+validDate :: Text -> Result Text Day
+validDate = maybe (Error "invalid date") Success .
+ parseTime defaultTimeLocale "%F" . T.unpack
+
+dayText :: Day -> Text
+dayText = T.pack . formatTime defaultTimeLocale "%F"
+
+------------------------------------------------------------------------------
+-- | A simple formlet for dates that
+simpleDateFormlet :: (Monad m)
+ => Maybe Day -> Form Text m Day
+simpleDateFormlet d = validate validDate $
+ text (dayText <$> d)
------------------------------------------------------------------------------
-- | Type class for uniform creation of splices. For primitives that don't
@@ -153,6 +172,9 @@ instance HasSplices FK32 where
instance HasSplices FK64 where
splices = splices . unFK64
+instance HasSplices Day where
+ splices = splices . dayText
+
instance HasSplices a => HasSplices (Maybe a) where
splices Nothing = [("", textSplice "")]
splices (Just x) = splices x

0 comments on commit b84d239

Please sign in to comment.