-- | This module provides orphan instances for 'ToHttpApiData'
--   and 'FromHttpApiData' for data types from the @ip@ package.

module Web.HttpApiData.Net () where

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 as IPv4
import qualified Net.Mac as Mac

instance ToHttpApiData Mac where
  toUrlPiece :: Mac -> Text
toUrlPiece   = Mac -> Text
Mac.encode
  toHeader :: Mac -> ByteString
toHeader     = Mac -> ByteString
Mac.encodeUtf8
  toQueryParam :: Mac -> Text
toQueryParam = Mac -> Text
Mac.encode

instance FromHttpApiData Mac where
  parseUrlPiece :: Text -> Either Text Mac
parseUrlPiece   = Text -> Maybe Mac -> Either Text Mac
forall a. Text -> Maybe a -> Either Text a
describeError Text
mac (Maybe Mac -> Either Text Mac)
-> (Text -> Maybe Mac) -> Text -> Either Text Mac
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Mac
Mac.decode
  parseQueryParam :: Text -> Either Text Mac
parseQueryParam = Text -> Maybe Mac -> Either Text Mac
forall a. Text -> Maybe a -> Either Text a
describeError Text
mac (Maybe Mac -> Either Text Mac)
-> (Text -> Maybe Mac) -> Text -> Either Text Mac
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe Mac
Mac.decode
  parseHeader :: ByteString -> Either Text Mac
parseHeader     = Text -> Maybe Mac -> Either Text Mac
forall a. Text -> Maybe a -> Either Text a
describeError Text
mac (Maybe Mac -> Either Text Mac)
-> (ByteString -> Maybe Mac) -> ByteString -> Either Text Mac
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe Mac
Mac.decodeUtf8

instance ToHttpApiData IPv4 where
  toUrlPiece :: IPv4 -> Text
toUrlPiece   = IPv4 -> Text
IPv4.encode
  toHeader :: IPv4 -> ByteString
toHeader     = IPv4 -> ByteString
IPv4.encodeUtf8
  toQueryParam :: IPv4 -> Text
toQueryParam = IPv4 -> Text
IPv4.encode

instance FromHttpApiData IPv4 where
  parseUrlPiece :: Text -> Either Text IPv4
parseUrlPiece   = Text -> Maybe IPv4 -> Either Text IPv4
forall a. Text -> Maybe a -> Either Text a
describeError Text
ipv4 (Maybe IPv4 -> Either Text IPv4)
-> (Text -> Maybe IPv4) -> Text -> Either Text IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe IPv4
IPv4.decode
  parseQueryParam :: Text -> Either Text IPv4
parseQueryParam = Text -> Maybe IPv4 -> Either Text IPv4
forall a. Text -> Maybe a -> Either Text a
describeError Text
ipv4 (Maybe IPv4 -> Either Text IPv4)
-> (Text -> Maybe IPv4) -> Text -> Either Text IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Maybe IPv4
IPv4.decode
  parseHeader :: ByteString -> Either Text IPv4
parseHeader     = Text -> Maybe IPv4 -> Either Text IPv4
forall a. Text -> Maybe a -> Either Text a
describeError Text
ipv4 (Maybe IPv4 -> Either Text IPv4)
-> (ByteString -> Maybe IPv4) -> ByteString -> Either Text IPv4
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Maybe IPv4
IPv4.decodeUtf8

mac,ipv4 :: Text
mac :: Text
mac = String -> Text
Text.pack String
"MAC Address"
ipv4 :: Text
ipv4 = String -> Text
Text.pack String
"IPv4 Address"

describeError :: Text -> Maybe a -> Either Text a
describeError :: forall a. Text -> Maybe a -> Either Text a
describeError Text
name Maybe a
x = case Maybe a
x of
  Maybe a
Nothing -> Text -> Either Text a
forall a b. a -> Either a b
Left (String -> Text
Text.pack String
"could not parse " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name)
  Just a
a  -> a -> Either Text a
forall a b. b -> Either a b
Right a
a