packages feed

http-api-data-qq (empty) → 0.1.0.0

raw patch · 9 files changed

+340/−0 lines, 9 filesdep +aesondep +basedep +bytestring

Dependencies added: aeson, base, bytestring, containers, http-api-data, http-api-data-qq, http-client, tasty, tasty-hunit, tasty-quickcheck, template-haskell, text

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Unreleased++# 0.1.0.0++* Initial release
+ LICENSE view
@@ -0,0 +1,11 @@+Copyright 2021 Brandon Chinn++Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:++1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.++2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.++3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,24 @@+# `http-api-data-qq`++[![CircleCI](https://img.shields.io/circleci/build/github/brandonchinn178/http-api-data-qq)](https://app.circleci.com/pipelines/github/brandonchinn178/http-api-data-qq)+[![Hackage](https://img.shields.io/hackage/v/http-api-data-qq)](https://hackage.haskell.org/package/http-api-data-qq)+[![Codecov](https://img.shields.io/codecov/c/gh/brandonchinn178/http-api-data-qq)](https://codecov.io/gh/brandonchinn178/http-api-data-qq)++Quasiquoter for building URLs with strings interpolated using `ToHttpApiData` instances.++```hs+{-# LANGUAGE QuasiQuotes #-}++import Network.HTTP.Client+import Web.HttpApiData.QQ (url)++userId :: Int+userId = 100++main :: IO ()+main = do+  manager <- newManager defaultManagerSettings+  request <- parseRequest [url|http://httpbin.org/anything/user/#{userId}|]+  response <- httpLbs request manager+  print response+```
+ http-api-data-qq.cabal view
@@ -0,0 +1,65 @@+cabal-version: 1.12++-- This file has been generated from package.yaml by hpack version 0.34.4.+--+-- see: https://github.com/sol/hpack++name:           http-api-data-qq+version:        0.1.0.0+synopsis:       Quasiquoter for building URLs with ToHttpApiData types+description:    Quasiquoter for building URLs with strings interpolated+                using ToHttpApiData instances+category:       Web+homepage:       https://github.com/brandonchinn178/http-api-data-qq#readme+bug-reports:    https://github.com/brandonchinn178/http-api-data-qq/issues+maintainer:     Brandon Chinn <brandonchinn178@gmail.com>+license:        BSD3+license-file:   LICENSE+build-type:     Simple+extra-source-files:+    CHANGELOG.md+    README.md++source-repository head+  type: git+  location: https://github.com/brandonchinn178/http-api-data-qq++library+  exposed-modules:+      Web.HttpApiData.QQ+      Web.HttpApiData.QQ.Parser+  other-modules:+      Paths_http_api_data_qq+  hs-source-dirs:+      src+  ghc-options: -Wall+  build-depends:+      base >=4.12 && <4.17+    , http-api-data >=0.4.1.1 && <0.5+    , template-haskell >=2.14 && <2.19+    , text >=1.2.3.1 && <1.3+  default-language: Haskell2010++test-suite http-api-data-qq-test+  type: exitcode-stdio-1.0+  main-is: Main.hs+  other-modules:+      Web.HttpApiData.QQ.ParserTest+      Web.HttpApiData.QQTest+      Paths_http_api_data_qq+  hs-source-dirs:+      test+  ghc-options: -Wall+  build-depends:+      aeson+    , base+    , bytestring+    , containers+    , http-api-data+    , http-api-data-qq+    , http-client+    , tasty+    , tasty-hunit+    , tasty-quickcheck+    , text+  default-language: Haskell2010
+ src/Web/HttpApiData/QQ.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE TemplateHaskellQuotes #-}++module Web.HttpApiData.QQ (+  url,+) where++import Data.String (fromString)+import qualified Data.Text as Text+import Language.Haskell.TH+import Language.Haskell.TH.Quote (QuasiQuoter (..))+import Web.HttpApiData (toUrlPiece)++import Web.HttpApiData.QQ.Parser++{- |+A quasiquoter to build a URL by interpolating values via ToHttpApiData.+The resulting value can be any IsString type.++Currently only supports single variable names being interpolated, not+arbitrary Haskell expressions.++Usage:++>>> [url|/foo/#{fooId}/bar|]+-}+url :: QuasiQuoter+url =+  QuasiQuoter+    { quoteExp = toExpQ . either error id . parseUrlPieces+    , quotePat = error "'url' quasiquoter cannot be used as a pattern"+    , quoteType = error "'url' quasiquoter cannot be used as a type"+    , quoteDec = error "'url' quasiquoter cannot be used as a declaration"+    }+  where+    -- convert parsed URL pieces into the ExpQ to inject+    toExpQ = appE [|fromString . concat|] . listE . map urlPieceToExpQ+    urlPieceToExpQ = \case+      InterpolatedName name -> appE [|Text.unpack . toUrlPiece|] . varE . mkName $ name+      RawString s -> litE . stringL $ s
+ src/Web/HttpApiData/QQ/Parser.hs view
@@ -0,0 +1,59 @@+module Web.HttpApiData.QQ.Parser (+  ParsedUrlPiece (..),+  parseUrlPieces,+) where++import Control.Monad (unless)+import Text.ParserCombinators.ReadP hiding (choice, many1)++data ParsedUrlPiece+  = RawString String+  | InterpolatedName String+  deriving (Show, Eq)++parseUrlPieces :: String -> Either String [ParsedUrlPiece]+parseUrlPieces = runParser (manyTill parseUrlPiece eof)++parseUrlPiece :: ReadP ParsedUrlPiece+parseUrlPiece =+  choice+    [ InterpolatedName <$> between (string "#{") (string "}") (many1 $ anySingleBut '}')+    , RawString <$> many1 (notFollowedBy (string "#{") >> anySingle)+    ]++{--+Parser utilities++Using ReadP since it's in base, to avoid pulling down extra dependencies,+but defining helpers here to roughly mimic megaparsec's API, which is more+readable than ReadP's API.+--}++runParser :: Show a => ReadP a -> String -> Either String a+runParser p s =+  case filter (null . snd) (readP_to_S p s) of+    [(x, "")] -> Right x+    [] -> Left "Could not parse input"+    result -> Left $ "Ambiguous parse: " ++ show result++-- | Same as ReadP's 'choice', except using (<++) instead of (+++)+choice :: [ReadP a] -> ReadP a+choice = foldr (<++) pfail++-- | See megaparsec's 'anySingle'.+anySingle :: ReadP Char+anySingle = get++-- | See megaparsec's 'anySingleBut'.+anySingleBut :: Char -> ReadP Char+anySingleBut c = satisfy (/= c)++-- | Same as ReadP's 'many1', except using (<++) instead of (+++)+many1 :: ReadP a -> ReadP [a]+many1 p = (:) <$> p <*> (many1 p <++ return [])++-- | See megaparsec's 'notFollowedBy'.+notFollowedBy :: ReadP a -> ReadP ()+notFollowedBy p = do+  failed <- (p >> pure False) <++ pure True+  unless failed pfail
+ test/Main.hs view
@@ -0,0 +1,11 @@+import Test.Tasty++import qualified Web.HttpApiData.QQ.ParserTest+import qualified Web.HttpApiData.QQTest++main :: IO ()+main =+  defaultMain . testGroup "http-api-data-qq" $+    [ Web.HttpApiData.QQ.ParserTest.tests+    , Web.HttpApiData.QQTest.tests+    ]
+ test/Web/HttpApiData/QQ/ParserTest.hs view
@@ -0,0 +1,58 @@+{-# LANGUAGE TupleSections #-}++module Web.HttpApiData.QQ.ParserTest (tests) where++import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+import Test.Tasty.QuickCheck++import Web.HttpApiData.QQ.Parser++tests :: TestTree+tests =+  testGroup+    "Web.HttpApiData.QQ.Parser"+    [ testCase "Sanity check" $ do+        let expected = [RawString "/foo/", InterpolatedName "bar", RawString "/baz"]+        parseUrlPieces "/foo/#{bar}/baz" @?= Right expected+    , testCase "Allows special characters in non-interpolation settings" $+        parseUrlPieces "/foo/ba{r}/baz#asdf" @?= Right [RawString "/foo/ba{r}/baz#asdf"]+    , testProperty "Parses any raw string" $+        forAll rawString1 $ \s ->+          parseUrlPieces s === Right [RawString s]+    , testProperty "Parses any combination of raw/interpolated strings" $+        forAll (alternatingListOf ((,True) <$> rawString1) ((,False) <$> rawString1)) $ \parts ->+          let input =+                flip concatMap parts $ \(s, isRaw) ->+                  if isRaw then s else "#{" ++ s ++ "}"+              expected =+                flip map parts $ \(s, isRaw) ->+                  if isRaw then RawString s else InterpolatedName s+           in parseUrlPieces input === Right expected+    ]++{- |+For two generators A and B, generates a list where each element+alternates between the two generators.++e.g.+  * []+  * [A]+  * [B]+  * [A, B]+  * [B, A]+  * [A, B, A]+  * [B, A, B]+-}+alternatingListOf :: Gen a -> Gen a -> Gen [a]+alternatingListOf genA genB = do+  startOnB <- arbitrary+  NonNegative n <- arbitrary+  sequence $ take n $ cycle $ if startOnB then [genB, genA] else [genA, genB]++-- | String that won't contain any interpolation characters.+rawString :: Gen String+rawString = listOf (arbitrary `suchThat` (`notElem` "#{}"))++rawString1 :: Gen String+rawString1 = rawString `suchThat` (/= "")
+ test/Web/HttpApiData/QQTest.hs view
@@ -0,0 +1,67 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE QuasiQuotes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}++module Web.HttpApiData.QQTest (tests) where++import qualified Data.Aeson as Aeson+import Data.ByteString (ByteString)+import qualified Data.ByteString.Lazy as Lazy (ByteString)+import qualified Data.Map as Map+import Data.String (IsString, fromString)+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Lazy as Lazy (Text)+import Network.HTTP.Client (+  Response (..),+  defaultManagerSettings,+  httpLbs,+  newManager,+  parseRequest,+ )+import Test.Tasty (TestTree, testGroup)+import Test.Tasty.HUnit+import Web.HttpApiData (ToHttpApiData (..))++import Web.HttpApiData.QQ++tests :: TestTree+tests =+  testGroup+    "Web.HttpApiData.QQ"+    [ testCase "Quasiquoter works" $ do+        [url|/foo|] @?= "/foo"+        let asdf = "bar"+        [url|/foo/#{asdf}|] @?= "/foo/bar"+        [url|/foo/#{asdf}/baz|] @?= "/foo/bar/baz"+    , testCase "Quasiquoter generates any IsString" $ do+        let check :: forall a. (Eq a, IsString a, Show a) => Assertion+            check = [url|/foo|] @?= (fromString "/foo" :: a)+        check @String+        check @Text+        check @Lazy.Text+        check @ByteString+        check @Lazy.ByteString+    , testCase "Uses ToHttpApiData instances" $ do+        let path = PathHello+        [url|#{path}/1|] @?= "/hello/1"+    , testCase "Can be used with http-client" $ do+        manager <- newManager defaultManagerSettings+        let userId = 100 :: Int+        request <- parseRequest [url|http://httpbin.org/anything/user/#{userId}|]+        response <- responseBody <$> httpLbs request manager+        body <-+          maybe (assertFailure $ "Response could not be decoded: " ++ show response) return $+            Aeson.decode response+        "url" `Map.lookup` body @?= Just (Aeson.toJSON "http://httpbin.org/anything/user/100")+    ]++data MyPath = PathHello | PathWorld++instance ToHttpApiData MyPath where+  toUrlPiece =+    Text.pack . \case+      PathHello -> "/hello"+      PathWorld -> "/world"