diff --git a/src/Database/Persist/Net/PostgreSQL.hs b/src/Database/Persist/Net/PostgreSQL.hs --- a/src/Database/Persist/Net/PostgreSQL.hs +++ b/src/Database/Persist/Net/PostgreSQL.hs @@ -9,40 +9,41 @@ module Database.Persist.Net.PostgreSQL () where +import Data.Monoid +import Data.Text (Text) import Database.Persist import Database.Persist.Class import Database.Persist.Sql - -import Data.Text (Text) -import Data.Monoid import Net.Types (IPv4,Mac) + import qualified Data.Text as Text -import qualified Net.IPv4.Text as IPv4Text -import qualified Net.IPv4.ByteString.Char8 as IPv4ByteString -import qualified Net.Mac.Text as MacText -import qualified Net.Mac.ByteString.Char8 as MacByteString +import qualified Net.IPv4 as IPv4 +import qualified Net.Mac as Mac instance PersistField IPv4 where - toPersistValue = toPersistValue . IPv4Text.encode + toPersistValue = toPersistValue . IPv4.encode fromPersistValue v = case v of - PersistDbSpecific s -> case IPv4ByteString.decode s of + PersistDbSpecific s -> case IPv4.decodeUtf8 s of Just x -> Right x Nothing -> Left (Text.pack "PersistValue IPv4: Invalid format") - _ -> Left (Text.pack "PersistValue IPv4: Not a PersistDbSpecific") + PersistText t -> case IPv4.decode t of + Just x -> Right x + Nothing -> Left (Text.pack "PersistValue IPv4: Invalid format") + y -> Left $ Text.pack "PersistValue IPv4: Not a PersistDbSpecific: " <> Text.pack (show y) instance PersistFieldSql IPv4 where sqlType _ = SqlOther (Text.pack "inet") instance PersistField Mac where - toPersistValue = toPersistValue . MacText.encode + toPersistValue = toPersistValue . Mac.encode fromPersistValue v = case v of - PersistDbSpecific s -> case MacByteString.decode s of + PersistDbSpecific s -> case Mac.decodeUtf8 s of Just x -> Right x Nothing -> Left (Text.pack "PersistValue MAC: Invalid format") - _ -> Left (Text.pack "PersistValue MAC: Not a PersistDbSpecific") + PersistText t -> case Mac.decode t of + Just x -> Right x + Nothing -> Left (Text.pack "PersistValue MAC: Invalid format") + y -> Left $ Text.pack "PersistValue MAC: Not a PersistDbSpecific: " <> Text.pack (show y) instance PersistFieldSql Mac where sqlType _ = SqlOther (Text.pack "macaddr") - - - diff --git a/src/Database/Persist/Net/Simple.hs b/src/Database/Persist/Net/Simple.hs --- a/src/Database/Persist/Net/Simple.hs +++ b/src/Database/Persist/Net/Simple.hs @@ -10,27 +10,27 @@ module Database.Persist.Net.Simple () where +import Data.Monoid +import Data.Text (Text) import Database.Persist import Database.Persist.Class import Database.Persist.Sql - -import Data.Text (Text) -import Data.Monoid import Net.Types (IPv4, Mac) + import qualified Data.Text as Text -import qualified Net.IPv4.Text as IPv4Text -import qualified Net.Mac.Text as MacText +import qualified Net.IPv4 as IPv4 +import qualified Net.Mac as Mac instance PersistField IPv4 where - toPersistValue = toPersistValueTextShow IPv4Text.encode - fromPersistValue = fromPersistValueTextRead IPv4Text.decode + toPersistValue = toPersistValueTextShow IPv4.encode + fromPersistValue = fromPersistValueTextRead IPv4.decode instance PersistFieldSql IPv4 where sqlType _ = SqlString instance PersistField Mac where - toPersistValue = toPersistValueTextShow MacText.encode - fromPersistValue = fromPersistValueTextRead MacText.decode + toPersistValue = toPersistValueTextShow Mac.encode + fromPersistValue = fromPersistValueTextRead Mac.decode instance PersistFieldSql Mac where sqlType _ = SqlString diff --git a/src/Web/HttpApiData/Net.hs b/src/Web/HttpApiData/Net.hs --- a/src/Web/HttpApiData/Net.hs +++ b/src/Web/HttpApiData/Net.hs @@ -3,35 +3,34 @@ module Web.HttpApiData.Net () where -import Web.HttpApiData (ToHttpApiData(..),FromHttpApiData(..)) -import Data.Text (Text) import Data.Monoid +import Data.Text (Text) import Net.Types (IPv4,Mac) +import Web.HttpApiData (ToHttpApiData(..),FromHttpApiData(..)) + import qualified Data.Text as Text -import qualified Net.IPv4.Text as IPv4Text -import qualified Net.IPv4.ByteString.Char8 as IPv4ByteString -import qualified Net.Mac.Text as MacText -import qualified Net.Mac.ByteString.Char8 as MacByteString +import qualified Net.IPv4 as IPv4 +import qualified Net.Mac as Mac instance ToHttpApiData Mac where - toUrlPiece = MacText.encode - toHeader = MacByteString.encode - toQueryParam = MacText.encode + toUrlPiece = Mac.encode + toHeader = Mac.encodeUtf8 + toQueryParam = Mac.encode instance FromHttpApiData Mac where - parseUrlPiece = describeError mac . MacText.decode - parseQueryParam = describeError mac . MacText.decode - parseHeader = describeError mac . MacByteString.decode + parseUrlPiece = describeError mac . Mac.decode + parseQueryParam = describeError mac . Mac.decode + parseHeader = describeError mac . Mac.decodeUtf8 instance ToHttpApiData IPv4 where - toUrlPiece = IPv4Text.encode - toHeader = IPv4ByteString.encode - toQueryParam = IPv4Text.encode + toUrlPiece = IPv4.encode + toHeader = IPv4.encodeUtf8 + toQueryParam = IPv4.encode instance FromHttpApiData IPv4 where - parseUrlPiece = describeError ipv4 . IPv4Text.decode - parseQueryParam = describeError ipv4 . IPv4Text.decode - parseHeader = describeError ipv4 . IPv4ByteString.decode + parseUrlPiece = describeError ipv4 . IPv4.decode + parseQueryParam = describeError ipv4 . IPv4.decode + parseHeader = describeError ipv4 . IPv4.decodeUtf8 mac,ipv4 :: Text mac = Text.pack "MAC Address" diff --git a/src/Web/PathPieces/Net.hs b/src/Web/PathPieces/Net.hs --- a/src/Web/PathPieces/Net.hs +++ b/src/Web/PathPieces/Net.hs @@ -3,18 +3,19 @@ module Web.PathPieces.Net where -import Web.PathPieces (PathPiece(..)) -import Data.Text (Text) import Data.Monoid +import Data.Text (Text) import Net.Types (IPv4,Mac) -import qualified Net.IPv4.Text as IPv4Text -import qualified Net.Mac.Text as MacText +import Web.PathPieces (PathPiece(..)) +import qualified Net.IPv4 as IPv4 +import qualified Net.Mac as Mac + instance PathPiece Mac where - toPathPiece = MacText.encode - fromPathPiece = MacText.decode + toPathPiece = Mac.encode + fromPathPiece = Mac.decode instance PathPiece IPv4 where - toPathPiece = IPv4Text.encode - fromPathPiece = IPv4Text.decode + toPathPiece = IPv4.encode + fromPathPiece = IPv4.decode diff --git a/src/Yesod/Form/Net.hs b/src/Yesod/Form/Net.hs --- a/src/Yesod/Form/Net.hs +++ b/src/Yesod/Form/Net.hs @@ -2,47 +2,62 @@ {-# LANGUAGE OverloadedStrings #-} module Yesod.Form.Net ( ipv4Field + , ipv4RangeField , macField , NetFormMessage(..) , englishNetFormMessage ) where +import Data.Text (Text) +import Net.Types (IPv4, IPv4Range, Mac) import Yesod.Core import Yesod.Form.Fields import Yesod.Form.Types -import Net.Types (IPv4, 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 + | MsgInvalidIPv4Range | MsgInvalidMac englishNetFormMessage :: NetFormMessage -> Text englishNetFormMessage x = case x of MsgInvalidIPv4 -> "Please enter an IPv4 address in dot decimal notation." + MsgInvalidIPv4Range -> "Please enter an IPv4 range in CIDR 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 +ipv4Field :: + ( Monad m + , RenderMessage (HandlerSite m) NetFormMessage + , RenderMessage (HandlerSite m) FormMessage + ) => Field m IPv4 +ipv4Field = mapField IPv4.encode from textField where - from t = case IPv4Text.decode t of + from t = case IPv4.decode t of Nothing -> Left (SomeMessage MsgInvalidIPv4) Just ipv4 -> Right ipv4 +ipv4RangeField :: + ( Monad m + , RenderMessage (HandlerSite m) NetFormMessage + , RenderMessage (HandlerSite m) FormMessage + ) => Field m IPv4Range +ipv4RangeField = mapField IPv4.encodeRange from textField + where + from t = case IPv4.decodeRange t of + Nothing -> Left (SomeMessage MsgInvalidIPv4Range) + Just r -> Right r + + macField :: ( Monad m , RenderMessage (HandlerSite m) NetFormMessage , RenderMessage (HandlerSite m) FormMessage ) => Field m Mac -macField = mapField MacText.encode from textField +macField = mapField Mac.encode from textField where - from t = case MacText.decode t of + from t = case Mac.decode t of Nothing -> Left (SomeMessage MsgInvalidMac) Just mac -> Right mac diff --git a/yesod-ip.cabal b/yesod-ip.cabal --- a/yesod-ip.cabal +++ b/yesod-ip.cabal @@ -1,5 +1,5 @@ name: yesod-ip -version: 0.5.0 +version: 0.5.1 synopsis: Code for using the ip package with yesod description: Please see README.md homepage: https://github.com/andrewthad/yesod-ip#readme @@ -23,13 +23,13 @@ Web.HttpApiData.Net build-depends: base >= 4.7 && < 5 - , text - , yesod-core - , yesod-form - , persistent - , path-pieces - , http-api-data - , ip >= 0.8.1 && < 0.9 + , text >= 1.2 + , yesod-core >= 1.4 && < 1.7 + , yesod-form >= 1.4 && < 1.7 + , persistent >= 2.1 + , path-pieces >= 0.2 && < 0.3 + , http-api-data >= 0.3 && < 0.5 + , ip >= 1.4.1 && < 1.5 default-language: Haskell2010 source-repository head