symantic-http-test/Hspec/Utils.hs

   1 module Hspec.Utils
   2  ( module Test.Hspec
   3  , module Test.Tasty
   4  , module Test.Tasty.Hspec
   5  , ($), (.)
   6  , Functor(..), (<$>)
   7  , Applicative(..)
   8  , Monad(..), (=<<)
   9  , Semigroup(..)
  10  , IO
  11  ) where
  12
  13 import Data.Bool
  14 import Data.Eq (Eq(..))
  15 import Data.Ord (Ord(..))
  16 import Data.Semigroup (Semigroup(..))
  17 import Control.Applicative (Applicative(..))
  18 import Control.Monad (Monad(..), (=<<))
  19 import Data.Either (Either(..))
  20 import Data.Function (($), (.))
  21 import Data.Functor (Functor(..), (<$>))
  22 import Data.Proxy (Proxy(..))
  23 import Data.Semigroup (Semigroup(..))
  24 import System.IO (IO)
  25 import Test.Hspec
  26 import Test.Tasty
  27 import Test.Tasty.Hspec
  28 import Text.Show (Show(..), showString, showParen, ShowS)
  29 import Data.String (String)
  30
  31 import Symantic.HTTP
  32 import Symantic.HTTP.Server
  33 import qualified Data.Map.Strict as Map
  34 import qualified Data.Map.Merge.Strict as Map
  35 import Data.Function (const)
  36 import qualified Debug.Trace as Dbg
  37 import qualified Data.Text as Text
  38
  39 instance (repr ~ Server) => Show (Router repr a b) where
  40         showsPrec p = \case
  41          Router_Any{}    -> showString "X"
  42          Router_Map ms   -> showParen (p>10) $ showString "map " . showsPrec p (Map.toList ms)
  43          Router_Seg s    -> showsPrec 10 s
  44          Router_Cat x y  -> showParen (p>4) $ showsPrec 4 x . showString " <.> " . showsPrec 4 y
  45          Router_Alt x y  -> showParen (p>3) $ showsPrec 3 x . showString " <!> " . showsPrec 3 y
  46          Router_AltL x   -> showParen (p>4) $ showString "L " . showsPrec 10 x
  47          Router_AltR x   -> showParen (p>4) $ showString "R " . showsPrec 10 x
  48          Router_Cap n    -> showString (":"<>n)
  49          -- Router_CapAlt xn x yn y -> showString (":"<>xn<>"|"<>yn<>" ") . showsPrec p (router_Alt x y)
  50          Router_Caps cs -> showParen (p>10) $ showString "cap [" . go cs . showString "]"
  51                 where
  52                 go :: Captures (Router repr) cs k -> ShowS
  53                 go (Captures0 a n r) = showParen True $ showString (":"<>n<>", ") . showsPrec 0 r
  54                 go (Captures2 x y) = go x . showString ", " . go y
  55
  56 type family Domain x :: * where
  57   Domain (a -> b) = a