refactor: remove MTPlanAttrs to doctest

src/PostgREST/ApiRequest.hs

@@ -51,9 +51,7 @@ import PostgREST.ApiRequest.Types        (ApiRequestError (..),
                                           RangeError (..))
 import PostgREST.Config                  (AppConfig (..),
                                           OpenAPIMode (..))
-import PostgREST.MediaType               (MTPlanAttrs (..),
-                                          MTPlanFormat (..),
-                                          MediaType (..))
+import PostgREST.MediaType               (MediaType (..))
 import PostgREST.RangeQuery              (NonnegRange, allRange,
                                           convertToLimitZeroRange,
                                           hasLimitZero,
@@ -375,5 +373,5 @@ producedMediaTypes conf action path =
         ++ [MTOpenAPI | pathIsRootSpec path]
     defaultMediaTypes =
       [MTApplicationJSON, MTSingularJSON, MTGeoJSON, MTTextCSV] ++
-      [MTPlan $ MTPlanAttrs Nothing PlanJSON mempty | configDbPlanEnabled conf] ++ [MTAny]
+      [MTPlan Nothing Nothing mempty | configDbPlanEnabled conf] ++ [MTAny]
     rawMediaTypes = configRawMediaTypes conf `union` [MTOctetStream, MTTextPlain, MTTextXML]

src/PostgREST/MediaType.hs

@@ -4,7 +4,6 @@ module PostgREST.MediaType
   ( MediaType(..)
   , MTPlanOption (..)
   , MTPlanFormat (..)
-  , MTPlanAttrs(..)
   , toContentType
   , toMime
   , decodeMediaType
@@ -19,6 +18,14 @@ import Network.HTTP.Types.Header (Header, hContentType)
 
 import Protolude
 
+--
+-- $setup
+-- Setup for doctests
+-- >>> import Text.Pretty.Simple (pPrint)
+-- >>> deriving instance Show MTPlanFormat
+-- >>> deriving instance Show MTPlanOption
+-- >>> deriving instance Show MediaType
+
 -- | Enumeration of currently supported media types
 data MediaType
   = MTApplicationJSON
@@ -32,12 +39,21 @@ data MediaType
   | MTOctetStream
   | MTAny
   | MTOther ByteString
-  | MTPlan MTPlanAttrs
-  deriving Eq
-
-data MTPlanAttrs = MTPlanAttrs (Maybe MediaType) MTPlanFormat [MTPlanOption]
-instance Eq MTPlanAttrs where
-  MTPlanAttrs {} == MTPlanAttrs {} = True -- we don't care about the attributes when comparing two MTPlan media types
+  | MTPlan (Maybe MediaType) (Maybe MTPlanFormat) [MTPlanOption]
+instance Eq MediaType where
+  MTApplicationJSON == MTApplicationJSON = True
+  MTSingularJSON    == MTSingularJSON    = True
+  MTGeoJSON         == MTGeoJSON         = True
+  MTTextCSV         == MTTextCSV         = True
+  MTTextPlain       == MTTextPlain       = True
+  MTTextXML         == MTTextXML         = True
+  MTOpenAPI         == MTOpenAPI         = True
+  MTUrlEncoded      == MTUrlEncoded      = True
+  MTOctetStream     == MTOctetStream     = True
+  MTAny             == MTAny             = True
+  MTOther x         == MTOther y         = x == y
+  MTPlan{}          == MTPlan{}          = True
+  _                 == _                 = False
 
 data MTPlanOption
   = PlanAnalyze | PlanVerbose | PlanSettings | PlanBuffers | PlanWAL
@@ -67,8 +83,8 @@ toMime MTUrlEncoded      = "application/x-www-form-urlencoded"
 toMime MTOctetStream     = "application/octet-stream"
 toMime MTAny             = "*/*"
 toMime (MTOther ct)      = ct
-toMime (MTPlan (MTPlanAttrs mt fmt opts)) =
-  "application/vnd.pgrst.plan+" <> toMimePlanFormat fmt <>
+toMime (MTPlan mt fmt opts) =
+  "application/vnd.pgrst.plan" <> maybe mempty (\x -> "+" <> toMimePlanFormat x) fmt <>
   (if isNothing mt then mempty else "; for=\"" <> toMime (fromJust mt) <> "\"") <>
   (if null opts then mempty else "; options=" <> BS.intercalate "|" (toMimePlanOption <$> opts))
 
@@ -83,7 +99,19 @@ toMimePlanFormat :: MTPlanFormat -> ByteString
 toMimePlanFormat PlanJSON = "json"
 toMimePlanFormat PlanText = "text"
 
--- | Convert from ByteString to MediaType. Warning: discards MIME parameters
+-- | Convert from ByteString to MediaType.
+--
+-- >>> decodeMediaType "application/json"
+-- MTApplicationJSON
+--
+-- >>> decodeMediaType "application/vnd.pgrst.plan;"
+-- MTPlan Nothing PlanText []
+--
+-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"application/json\""
+-- MTPlan (Just MTApplicationJSON) PlanText []
+--
+-- >>> decodeMediaType "application/vnd.pgrst.plan;for=\"text/csv\""
+-- MTPlan (Just MTTextCSV) PlanText []
 decodeMediaType :: BS.ByteString -> MediaType
 decodeMediaType mt =
   case BS.split (BS.c2w ';') mt of
@@ -97,9 +125,9 @@ decodeMediaType mt =
     "application/vnd.pgrst.object":_       -> MTSingularJSON
     "application/x-www-form-urlencoded":_  -> MTUrlEncoded
     "application/octet-stream":_           -> MTOctetStream
-    "application/vnd.pgrst.plan":rest      -> getPlan PlanText rest
-    "application/vnd.pgrst.plan+text":rest -> getPlan PlanText rest
-    "application/vnd.pgrst.plan+json":rest -> getPlan PlanJSON rest
+    "application/vnd.pgrst.plan":rest      -> getPlan Nothing rest
+    "application/vnd.pgrst.plan+text":rest -> getPlan (Just PlanText) rest
+    "application/vnd.pgrst.plan+json":rest -> getPlan (Just PlanJSON) rest
     "*/*":_                                -> MTAny
     other:_                                -> MTOther other
     _                                      -> MTAny
@@ -110,7 +138,7 @@ decodeMediaType mt =
        inOpts str   = str `elem` opts
        mtFor        = decodeMediaType . dropAround (== BS.c2w '"') <$> (BS.stripPrefix "for=" =<< find (BS.isPrefixOf "for=") rest)
        dropAround p = BS.dropWhile p . BS.dropWhileEnd p in
-     MTPlan $ MTPlanAttrs mtFor fmt $
+     MTPlan mtFor fmt $
       [PlanAnalyze  | inOpts "analyze" ] ++
       [PlanVerbose  | inOpts "verbose" ] ++
       [PlanSettings | inOpts "settings"] ++
@@ -119,6 +147,6 @@ decodeMediaType mt =
 
 getMediaType :: MediaType -> MediaType
 getMediaType mt = case mt of
-  MTPlan (MTPlanAttrs (Just mType) _ _) -> mType
-  MTPlan (MTPlanAttrs Nothing _ _)      -> MTApplicationJSON
-  other                                 -> other
+  MTPlan (Just mType) _ _ -> mType
+  MTPlan Nothing _ _      -> MTApplicationJSON
+  other                   -> other

src/PostgREST/Plan.hs

@@ -44,8 +44,7 @@ import PostgREST.ApiRequest               (Action (..),
                                            Payload (..))
 import PostgREST.Config                   (AppConfig (..))
 import PostgREST.Error                    (Error (..))
-import PostgREST.MediaType                (MTPlanAttrs (..),
-                                           MediaType (..))
+import PostgREST.MediaType                (MediaType (..))
 import PostgREST.Query.SqlFragment        (sourceCTEName)
 import PostgREST.RangeQuery               (NonnegRange, allRange,
                                            convertToLimitZeroRange,
@@ -634,10 +633,10 @@ binaryField AppConfig{configRawMediaTypes} acceptMediaType proc rpTree
   where
     isRawMediaType = acceptMediaType `elem` configRawMediaTypes `L.union` [MTOctetStream, MTTextPlain, MTTextXML] || isRawPlan acceptMediaType
     isRawPlan mt = case mt of
-      MTPlan (MTPlanAttrs (Just MTOctetStream) _ _) -> True
-      MTPlan (MTPlanAttrs (Just MTTextPlain) _ _)   -> True
-      MTPlan (MTPlanAttrs (Just MTTextXML) _ _)     -> True
-      _                                             -> False
+      MTPlan (Just MTOctetStream) _ _ -> True
+      MTPlan (Just MTTextPlain) _ _   -> True
+      MTPlan (Just MTTextXML) _ _     -> True
+      _                               -> False
 
     fstFieldName :: ReadPlanTree -> Maybe FieldName
     fstFieldName (Node ReadPlan{select=(("*", []), _, _):_} [])  = Nothing

src/PostgREST/Query/SqlFragment.hs

@@ -431,7 +431,7 @@ intercalateSnippet :: ByteString -> [SQL.Snippet] -> SQL.Snippet
 intercalateSnippet _ [] = mempty
 intercalateSnippet frag snippets = foldr1 (\a b -> a <> SQL.sql frag <> b) snippets
 
-explainF :: MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet
+explainF :: Maybe MTPlanFormat -> [MTPlanOption] -> SQL.Snippet -> SQL.Snippet
 explainF fmt opts snip =
   "EXPLAIN (" <>
     SQL.sql (BS.intercalate ", " (fmtPlanFmt fmt : (fmtPlanOpt <$> opts))) <>
@@ -444,8 +444,9 @@ explainF fmt opts snip =
     fmtPlanOpt PlanBuffers  = "BUFFERS"
     fmtPlanOpt PlanWAL      = "WAL"
 
-    fmtPlanFmt PlanJSON = "FORMAT JSON"
-    fmtPlanFmt PlanText = "FORMAT TEXT"
+    fmtPlanFmt Nothing         = "FORMAT TEXT"
+    fmtPlanFmt (Just PlanJSON) = "FORMAT JSON"
+    fmtPlanFmt (Just PlanText) = "FORMAT TEXT"
 
 -- | Do a pg set_config(setting, value, true) call. This is equivalent to a SET LOCAL.
 setConfigLocal :: ByteString -> (ByteString, ByteString) -> SQL.Snippet

src/PostgREST/Query/Statements.hs

@@ -26,8 +26,7 @@ import Control.Lens ((^?))
 import Data.Maybe   (fromJust)
 
 import PostgREST.ApiRequest.Preferences
-import PostgREST.MediaType               (MTPlanAttrs (..),
-                                          MTPlanFormat (..),
+import PostgREST.MediaType               (MTPlanFormat (..),
                                           MediaType (..),
                                           getMediaType)
 import PostgREST.Query.SqlFragment
@@ -168,7 +167,7 @@ preparePlanRows :: SQL.Snippet -> Bool -> SQL.Statement () (Maybe Int64)
 preparePlanRows countQuery =
   SQL.dynamicallyParameterized snippet decodeIt
   where
-    snippet = explainF PlanJSON mempty countQuery
+    snippet = explainF (Just PlanJSON) mempty countQuery
     decodeIt :: HD.Result (Maybe Int64)
     decodeIt =
       let row = HD.singleRow $ column HD.bytea in
@@ -188,8 +187,8 @@ standardRow noLocation =
 
 mtSnippet :: MediaType -> SQL.Snippet -> SQL.Snippet
 mtSnippet mediaType snippet = case mediaType of
-  MTPlan (MTPlanAttrs _ fmt opts) -> explainF fmt opts snippet
-  _                               -> snippet
+  MTPlan _ fmt opts -> explainF fmt opts snippet
+  _                 -> snippet
 
 -- | We use rowList because when doing EXPLAIN (FORMAT TEXT), the result comes as many rows. FORMAT JSON comes as one.
 planRow :: HD.Result ResultSet

test/doc/Main.hs

@@ -16,4 +16,5 @@ main =
     , "src/PostgREST/ApiRequest/Preferences.hs"
     , "src/PostgREST/ApiRequest/QueryParams.hs"
     , "src/PostgREST/Error.hs"
+    , "src/PostgREST/MediaType.hs"
     ]

test/spec/Feature/Query/PlanSpec.hs

@@ -254,7 +254,7 @@ spec actualPgVersion = do
           resStatus  = simpleStatus r
 
       liftIO $ do
-        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan+text; charset=utf-8")
+        resHeaders `shouldSatisfy` elem ("Content-Type", "application/vnd.pgrst.plan; charset=utf-8")
         resStatus `shouldBe` Status { statusCode = 200, statusMessage="OK" }
         resBody `shouldSatisfy` (\t -> LBS.take 9 t == "Aggregate")