module Yesod.Form.Net
( ipv4Field
, macField
, NetFormMessage(..)
, englishNetFormMessage
) where
import Yesod.Core
import Yesod.Form.Fields
import Yesod.Form.Types
import Net.IPv4 (IPv4)
import Net.Mac (Mac)
import Data.Text (Text)
import qualified Net.IPv4 as IPv4
import qualified Net.IPv4.Text as IPv4Text
import qualified Net.Mac as Mac
import qualified Net.Mac.Text as MacText
data NetFormMessage
= MsgInvalidIPv4
| MsgInvalidMac
englishNetFormMessage :: NetFormMessage -> Text
englishNetFormMessage x = case x of
MsgInvalidIPv4 -> "Please enter an IPv4 address in dot decimal notation."
MsgInvalidMac -> "Please enter a valid MAC address."
ipv4Field :: ( Monad m
, RenderMessage (HandlerSite m) NetFormMessage
, RenderMessage (HandlerSite m) FormMessage
) => Field m IPv4
ipv4Field = mapField IPv4Text.encode from textField
where
from t = case IPv4Text.decode t of
Nothing -> Left (SomeMessage MsgInvalidIPv4)
Just ipv4 -> Right ipv4
macField :: ( Monad m
, RenderMessage (HandlerSite m) NetFormMessage
, RenderMessage (HandlerSite m) FormMessage
) => Field m Mac
macField = mapField MacText.encode from textField
where
from t = case MacText.decode t of
Nothing -> Left (SomeMessage MsgInvalidMac)
Just mac -> Right mac
mapField :: Monad m => (a -> b) -> (b -> Either (SomeMessage (HandlerSite m)) a) -> Field m b -> Field m a
mapField fwd bck (Field parse view enctype) = Field
(\ts fis -> do
eres <- parse ts fis
return $ eres >>= (\mb -> case mb of
Just b -> Just <$> bck b
Nothing -> Right Nothing)
)
(\a b c d e -> view a b c (fmap fwd d) e)
enctype