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 (($), (.), id)
  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 [" . go (Map.toList ms) . showString "]"
  43                 where
  44                 go :: forall a k. [(PathSegment, RouterUnion repr a k)] -> ShowS
  45                 go ((n, RouterUnion _b2a r):xs) =
  46                         (showParen True $ showString (show n<>", ") . showsPrec 0 r) .
  47                         case xs of
  48                          [] -> id
  49                          _ -> showString ", " . go xs
  50          Router_Seg s   -> showsPrec 10 s
  51          Router_Cat x y -> showParen (p>4) $ showsPrec 4 x . showString " <.> " . showsPrec 4 y
  52          Router_Alt x y -> showParen (p>3) $ showsPrec 3 x . showString " <!> " . showsPrec 3 y
  53          Router_Cap n   -> showString (":"<>n)
  54          Router_Caps cs -> showParen (p>10) $ showString "cap [" . go cs . showString "]"
  55                 where
  56                 go :: Captures (Router repr) cs k -> ShowS
  57                 go (Captures0 a n r) = showParen True $ showString (":"<>n<>", ") . showsPrec 0 r
  58                 go (Captures2 x y) = go x . showString ", " . go y