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.Trait
import WebGear.Trait.Path


prop_pathMatch :: Property
prop_pathMatch = property $ \h ->
  let
    rest = ["foo", "bar"]
    req = defaultRequest { pathInfo = h:rest }
  in
    case runIdentity (check @(Path "a") req) of
      CheckSuccess req' _ -> h === "a" .&&. pathInfo req' === rest
      CheckFail _         -> h =/= "a"

prop_pathVarMatch :: Property
prop_pathVarMatch = property $ \(n :: Int) ->
  let
    rest = ["foo", "bar"]
    req = defaultRequest { pathInfo = fromString (show n):rest }
  in
    case runIdentity (check @(PathVar "tag" Int) req) of
      CheckSuccess req' n' -> n' === n .&&. pathInfo req' === rest
      CheckFail _          -> property False

prop_pathVarParseError :: Property
prop_pathVarParseError = property $ \(p, ps) ->
  let
    p' = "test-" <> p
    req = defaultRequest { pathInfo = p':ps }
  in
    case runIdentity (check @(PathVar "tag" Int) req) of
      CheckSuccess _ _ -> property False
      CheckFail e      -> e === PathVarParseError ("could not parse: `" <> p' <> "' (input does not start with a digit)")


-- Hack for TH splicing
return []

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