Path.hs

module Properties.Trait.Path (
  tests,
) where

import Data.Functor.Identity (runIdentity)
import Data.String (fromString)
import Network.Wai (defaultRequest, pathInfo)
import Test.QuickCheck (Property, allProperties, property, (=/=), (===))
import Test.QuickCheck.Instances ()
import Test.Tasty (TestTree)
import Test.Tasty.QuickCheck (testProperties)
import WebGear.Core.Trait.Path (Path (..), PathVar (..), PathVarError (..))
import WebGear.Core.Request (Request (..))
import WebGear.Core.Trait (getTrait, linkzero)
import WebGear.Server.Handler (RoutePath (..), runServerHandler)
import WebGear.Server.Trait.Path ()

prop_pathMatch :: Property
prop_pathMatch = property $ \h ->
  let rest = ["foo", "bar"]
      req = linkzero $ Request $ defaultRequest{pathInfo = h : rest}
   in runIdentity $ do
        res <- runServerHandler (getTrait $ Path "a") (RoutePath $ h : rest) req
        pure $ case res of
          Right (Right _) -> h === "a"
          Right (Left _) -> h =/= "a"
          Left _ -> property False

prop_pathVarMatch :: Property
prop_pathVarMatch = property $ \(n :: Int) ->
  let rest = ["foo", "bar"]
      p = fromString (show n) : rest
      req = linkzero $ Request $ defaultRequest{pathInfo = p}
   in runIdentity $ do
        res <- runServerHandler (getTrait (PathVar @"tag" @Int)) (RoutePath p) req
        pure $ case res of
          Right (Right n') -> n' === n
          _ -> property False

prop_pathVarParseError :: Property
prop_pathVarParseError = property $ \(p, ps) ->
  let p' = "test-" <> p
      req = linkzero $ Request $ defaultRequest{pathInfo = p' : ps}
   in runIdentity $ do
        res <- runServerHandler (getTrait (PathVar @"tag" @Int)) (RoutePath $ p' : ps) req
        pure $ case res of
          Right (Left e) -> e === PathVarParseError ("could not parse: `" <> p' <> "' (input does not start with a digit)")
          _ -> property False

-- Hack for TH splicing
return []

tests :: TestTree
tests = testProperties "Trait.Path" $allProperties