@@ -13,21 +13,27 @@
1313-- such as URL pieces, headers and query parameters.
1414module Web.Internal.HttpApiData where
1515
16−import Prelude ()
16+import Prelude ()
1717import Prelude.Compat
1818
1919import Control.Arrow (left, (&&&))
2020import Control.Monad ((<=<))
21−
21+import qualified Data.Attoparsec.Text as Atto
22+import qualified Data.Attoparsec.Time as Atto
2223import Data.ByteString (ByteString)
2324import qualified Data.ByteString as BS
25+import qualified Data.ByteString.Builder as BS
2426import qualified Data.ByteString.Lazy as LBS
25−import Data.Monoid
26−
27+import Data.Coerce (coerce)
28+import Data.Data (Data)
2729import qualified Data.Fixed as F
28−import Data.Int
29−import Data.Word
30−
30+import Data.Int (Int16, Int32, Int64, Int8)
31+import Data.Monoid (All (..), Any (..), Dual (..),
32+ First (..), Last (..),
33+ Product (..), Sum (..))
34+import Data.Semigroup (Semigroup (..))
35+import qualified Data.Semigroup as Semi
36+import Data.Tagged (Tagged (..))
3137import Data.Text (Text)
3238import qualified Data.Text as T
3339import Data.Text.Encoding (decodeUtf8', decodeUtf8With,
@@ -36,43 +42,41 @@ import Data.Text.Encoding.Error (lenientDecode)
3642import qualified Data.Text.Lazy as L
3743import Data.Text.Read (Reader, decimal, rational,
3844 signed)
39−
40−import Data.Time
41−import Data.Time.Locale.Compat
45+import Data.Time (Day, FormatTime, LocalTime,
46+ NominalDiffTime, TimeOfDay,
47+ UTCTime, ZonedTime, formatTime)
48+import Data.Time.Locale.Compat (defaultTimeLocale,
49+ iso8601DateFormat)
50+import Data.Typeable (Typeable)
51+import qualified Data.UUID.Types as UUID
52+import Data.Version (Version, parseVersion,
53+ showVersion)
54+import Data.Void (Void, absurd)
55+import Data.Word (Word16, Word32, Word64, Word8)
56+import qualified Network.HTTP.Types as H
57+import Numeric.Natural (Natural)
58+import Text.ParserCombinators.ReadP (readP_to_S)
59+import Text.Read (readMaybe)
60+import Web.Cookie (SetCookie, parseSetCookie,
61+ renderSetCookie)
4262
4363#if MIN_VERSION_time(1,9,1)
44−import Data.Time (nominalDiffTimeToSeconds, secondsToNominalDiffTime)
64+import Data.Time (nominalDiffTimeToSeconds,
65+ secondsToNominalDiffTime)
4566#endif
4667
47−import Data.Version
48−
49−import Data.Void
50−import Numeric.Natural
51−
52−import Text.ParserCombinators.ReadP (readP_to_S)
53−import Text.Read (readMaybe)
54−
5568#if USE_TEXT_SHOW
5669import TextShow (TextShow, showt)
5770#endif
5871
59−import qualified Data.UUID.Types as UUID
6072
61−import qualified Data.ByteString.Builder as BS
62−import Data.Data (Data)
63−import Data.Typeable (Typeable)
64−import qualified Network.HTTP.Types as H
65−
66−import qualified Data.Attoparsec.Text as Atto
67−import qualified Data.Attoparsec.Time as Atto
68−
69−import Web.Cookie (SetCookie, parseSetCookie,
70− renderSetCookie)
7173
7274
7375-- $setup
7476-- >>> data BasicAuthToken = BasicAuthToken Text deriving (Show)
7577-- >>> instance FromHttpApiData BasicAuthToken where parseHeader h = BasicAuthToken <$> parseHeaderWithPrefix "Basic " h; parseQueryParam p = BasicAuthToken <$> parseQueryParam p
78+-- >>> import Data.Time
79+-- >>> import Data.Version
7680
7781-- | Convert value to HTTP API data.
7882--
@@ -519,28 +523,49 @@ instance ToHttpApiData String where toUrlPiece = T.pack
519523instance ToHttpApiData Text where toUrlPiece = id
520524instance ToHttpApiData L.Text where toUrlPiece = L.toStrict
521525
522−instance ToHttpApiData All where toUrlPiece = toUrlPiece . getAll; toEncodedUrlPiece = toEncodedUrlPiece . getAll
523−instance ToHttpApiData Any where toUrlPiece = toUrlPiece . getAny; toEncodedUrlPiece = toEncodedUrlPiece . getAny
526+instance ToHttpApiData All where
527+ toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
528+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
529+
530+instance ToHttpApiData Any where
531+ toUrlPiece = coerce (toUrlPiece :: Bool -> Text)
532+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Bool -> BS.Builder)
524533
525534instance ToHttpApiData a => ToHttpApiData (Dual a) where
526− toUrlPiece = toUrlPiece . getDual
527− toEncodedUrlPiece = toEncodedUrlPiece . getDual
535+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
536+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
528537
529538instance ToHttpApiData a => ToHttpApiData (Sum a) where
530− toUrlPiece = toUrlPiece . getSum
531− toEncodedUrlPiece = toEncodedUrlPiece . getSum
539+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
540+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
532541
533542instance ToHttpApiData a => ToHttpApiData (Product a) where
534− toUrlPiece = toUrlPiece . getProduct
535− toEncodedUrlPiece = toEncodedUrlPiece . getProduct
543+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
544+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
536545
537546instance ToHttpApiData a => ToHttpApiData (First a) where
538− toUrlPiece = toUrlPiece . getFirst
539− toEncodedUrlPiece = toEncodedUrlPiece . getFirst
547+ toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
548+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
540549
541550instance ToHttpApiData a => ToHttpApiData (Last a) where
542− toUrlPiece = toUrlPiece . getLast
543− toEncodedUrlPiece = toEncodedUrlPiece . getLast
551+ toUrlPiece = coerce (toUrlPiece :: Maybe a -> Text)
552+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: Maybe a -> BS.Builder)
553+
554+instance ToHttpApiData a => ToHttpApiData (Semi.Min a) where
555+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
556+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
557+
558+instance ToHttpApiData a => ToHttpApiData (Semi.Max a) where
559+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
560+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
561+
562+instance ToHttpApiData a => ToHttpApiData (Semi.First a) where
563+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
564+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
565+
566+instance ToHttpApiData a => ToHttpApiData (Semi.Last a) where
567+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
568+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
544569
545570-- |
546571-- >>> toUrlPiece (Just "Hello")
@@ -572,6 +597,12 @@ instance ToHttpApiData SetCookie where
572597 toHeader = LBS.toStrict . BS.toLazyByteString . renderSetCookie
573598 -- toEncodedUrlPiece = renderSetCookie -- doesn't do things.
574599
600+instance ToHttpApiData a => ToHttpApiData (Tagged b a) where
601+ toUrlPiece = coerce (toUrlPiece :: a -> Text)
602+ toHeader = coerce (toHeader :: a -> ByteString)
603+ toQueryParam = coerce (toQueryParam :: a -> Text)
604+ toEncodedUrlPiece = coerce (toEncodedUrlPiece :: a -> BS.Builder)
605+
575606-- |
576607-- >>> parseUrlPiece "_" :: Either Text ()
577608-- Right ()
@@ -657,14 +688,19 @@ instance FromHttpApiData UTCTime where parseUrlPiece = runAtto Atto.utcTime
657688
658689instance FromHttpApiData NominalDiffTime where parseUrlPiece = fmap secsToNominalDiffTime . parseUrlPiece
659690
660−instance FromHttpApiData All where parseUrlPiece = fmap All . parseUrlPiece
661−instance FromHttpApiData Any where parseUrlPiece = fmap Any . parseUrlPiece
691+instance FromHttpApiData All where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
692+instance FromHttpApiData Any where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text Bool)
693+
694+instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
695+instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
696+instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
697+instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
698+instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text (Maybe a))
662699
663−instance FromHttpApiData a => FromHttpApiData (Dual a) where parseUrlPiece = fmap Dual . parseUrlPiece
664−instance FromHttpApiData a => FromHttpApiData (Sum a) where parseUrlPiece = fmap Sum . parseUrlPiece
665−instance FromHttpApiData a => FromHttpApiData (Product a) where parseUrlPiece = fmap Product . parseUrlPiece
666−instance FromHttpApiData a => FromHttpApiData (First a) where parseUrlPiece = fmap First . parseUrlPiece
667−instance FromHttpApiData a => FromHttpApiData (Last a) where parseUrlPiece = fmap Last . parseUrlPiece
700+instance FromHttpApiData a => FromHttpApiData (Semi.Min a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
701+instance FromHttpApiData a => FromHttpApiData (Semi.Max a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
702+instance FromHttpApiData a => FromHttpApiData (Semi.First a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
703+instance FromHttpApiData a => FromHttpApiData (Semi.Last a) where parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
668704
669705-- |
670706-- >>> parseUrlPiece "Just 123" :: Either Text (Maybe Int)
@@ -715,6 +751,11 @@ instance FromHttpApiData SetCookie where
715751 parseUrlPiece = parseHeader . encodeUtf8
716752 parseHeader = Right . parseSetCookie
717753
754+instance FromHttpApiData a => FromHttpApiData (Tagged b a) where
755+ parseUrlPiece = coerce (parseUrlPiece :: Text -> Either Text a)
756+ parseHeader = coerce (parseHeader :: ByteString -> Either Text a)
757+ parseQueryParam = coerce (parseQueryParam :: Text -> Either Text a)
758+
718759-------------------------------------------------------------------------------
719760-- Attoparsec helpers
720761-------------------------------------------------------------------------------
@@ -723,3 +764,5 @@ runAtto :: Atto.Parser a -> Text -> Either Text a
723764runAtto p t = case Atto.parseOnly (p <* Atto.endOfInput) t of
724765 Left err -> Left (T.pack err)
725766 Right x -> Right x
767+
768+