From 1a273387d694b97c90984c2e064b087914ed9756 Mon Sep 17 00:00:00 2001
From: Michael Snoyman <michael@snoyman.com>
Date: Thu, 12 Aug 2010 11:41:18 +0300
Subject: [PATCH] Added urlField

---
 Yesod/Form.hs | 28 ++++++++++++++++++++++++++++
 yesod.cabal   |  1 +
 2 files changed, 29 insertions(+)

diff --git a/Yesod/Form.hs b/Yesod/Form.hs
index cd05c30f..8fde8226 100644
--- a/Yesod/Form.hs
+++ b/Yesod/Form.hs
@@ -44,6 +44,7 @@ module Yesod.Form
     , timeFieldProfile
     , htmlFieldProfile
     , emailFieldProfile
+    , urlFieldProfile
     , FormFieldSettings (..)
     , labelSettings
       -- * Pre-built fields
@@ -68,6 +69,8 @@ module Yesod.Form
     , boolField
     , emailField
     , maybeEmailField
+    , urlField
+    , maybeUrlField
       -- * Pre-built inputs
     , stringInput
     , maybeStringInput
@@ -76,6 +79,7 @@ module Yesod.Form
     , dayInput
     , maybeDayInput
     , emailInput
+    , urlInput
       -- * Template Haskell
     , mkToForm
       -- * Utilities
@@ -102,6 +106,7 @@ import Yesod.Widget
 import Control.Arrow ((&&&))
 import qualified Text.Email.Validate as Email
 import Data.List (group, sort)
+import Network.URI (parseURI)
 
 -- | A form can produce three different results: there was no data available,
 -- the data was invalid, or there was a successful parse.
@@ -739,6 +744,29 @@ toLabel (x:rest) = toUpper x : go rest
         | isUpper c = ' ' : c : go cs
         | otherwise = c : go cs
 
+urlFieldProfile :: FieldProfile s y String
+urlFieldProfile = FieldProfile
+    { fpParse = \s -> case parseURI s of
+                        Nothing -> Left "Invalid URL"
+                        Just _ -> Right s
+    , fpRender = id
+    , fpHamlet = \theId name val isReq -> [$hamlet|
+%input#$theId$!name=$name$!type=url!:isReq:required!value=$val$
+|]
+    , fpWidget = const $ return ()
+    }
+
+urlField :: FormFieldSettings -> FormletField sub y String
+urlField = requiredFieldHelper urlFieldProfile
+
+maybeUrlField :: FormFieldSettings -> FormletField sub y (Maybe String)
+maybeUrlField = optionalFieldHelper urlFieldProfile
+
+urlInput :: String -> FormInput sub master String
+urlInput n =
+    mapFormXml fieldsToInput $
+    requiredFieldHelper urlFieldProfile (nameSettings n) Nothing
+
 emailFieldProfile :: FieldProfile s y String
 emailFieldProfile = FieldProfile
     { fpParse = \s -> if Email.isValid s
diff --git a/yesod.cabal b/yesod.cabal
index 37b80b44..8152a9dc 100644
--- a/yesod.cabal
+++ b/yesod.cabal
@@ -46,6 +46,7 @@ library
                      neither >= 0.0.0 && < 0.1,
                      MonadCatchIO-transformers >= 0.2.2.0 && < 0.3,
                      data-object >= 0.3.1 && < 0.4,
+                     network >= 2.2.1.5 && < 2.3,
                      email-validate >= 0.2.5 && < 0.3
     exposed-modules: Yesod
                      Yesod.Content