content: {-# LANGUAGE CPP #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE TypeOperators #-}
  
  module Web.Routing.Combinators where
  
  import Data.HVect
  import Data.String
  import qualified Data.Text as T
  import Data.Typeable (Typeable)
  import Web.HttpApiData
  import Web.Routing.SafeRouting
  
  data PathState = Open | Closed
  
  data Path (as :: [*]) (pathState :: PathState) where
    Empty :: Path '[] 'Open
    StaticCons :: T.Text -> Path as ps -> Path as ps
    VarCons :: (FromHttpApiData a, Typeable a) => Path as ps -> Path (a ': as) ps
    Wildcard :: Path as 'Open -> Path (T.Text ': as) 'Closed
  
  toInternalPath :: Path as pathState -> PathInternal as
  toInternalPath Empty = PI_Empty
  toInternalPath (StaticCons t p) = PI_StaticCons t (toInternalPath p)
  toInternalPath (VarCons p) = PI_VarCons (toInternalPath p)
  toInternalPath (Wildcard p) = PI_Wildcard (toInternalPath p)
  
  type Var a = Path (a ': '[]) 'Open
  
  -- | A variant of 'Either' with a 'FromHttpApiData' definition that tries both branches without a prefix.
  -- Useful to define routes with 'var's that should work with different types.
  data AltVar a b = AvLeft a | AvRight b
    deriving (Show, Eq, Read, Ord)
  
  instance (FromHttpApiData a, FromHttpApiData b) => FromHttpApiData (AltVar a b) where
    parseUrlPiece val =
      case parseUrlPiece val of
        Left err ->
          case parseUrlPiece val of
            Left err2 -> Left (err <> " " <> err2)
            Right ok -> Right (AvRight ok)
        Right ok -> Right (AvLeft ok)
  
  -- | A route parameter
  var :: (Typeable a, FromHttpApiData a) => Path (a ': '[]) 'Open
  var = VarCons Empty
  
  -- | A static route piece
  static :: String -> Path '[] 'Open
  static s =
    let pieces = filter (not . T.null) $ T.splitOn "/" $ T.pack s
     in foldr StaticCons Empty pieces
  
  instance (a ~ '[], pathState ~ 'Open) => IsString (Path a pathState) where
    fromString = static
  
  -- | The root of a path piece. Use to define a handler for "/"
  root :: Path '[] 'Open
  root = Empty
  
  -- | Matches the rest of the route. Should be the last part of the path.
  wildcard :: Path '[T.Text] 'Closed
  wildcard = Wildcard Empty
  
  (</>) :: Path as 'Open -> Path bs ps2 -> Path (Append as bs) ps2
  (</>) Empty xs = xs
  (</>) (StaticCons pathPiece xs) ys = StaticCons pathPiece (xs </> ys)
  (</>) (VarCons xs) ys = VarCons (xs </> ys)
  
  pathToRep :: Path as ps -> Rep as
  pathToRep Empty = RNil
  pathToRep (StaticCons _ p) = pathToRep p
  pathToRep (VarCons p) = RCons (pathToRep p)
  pathToRep (Wildcard p) = RCons (pathToRep p)
  
  renderRoute :: AllHave ToHttpApiData as => Path as 'Open -> HVect as -> T.Text
  renderRoute p = combineRoutePieces . renderRoute' p
  
  renderRoute' :: AllHave ToHttpApiData as => Path as 'Open -> HVect as -> [T.Text]
  renderRoute' Empty _ = []
  renderRoute' (StaticCons pathPiece pathXs) paramXs =
    (pathPiece : renderRoute' pathXs paramXs)
  renderRoute' (VarCons pathXs) (val :&: paramXs) =
    (toUrlPiece val : renderRoute' pathXs paramXs)
  
  #if __GLASGOW_HASKELL__ < 800
  renderRoute' _ _ =
      error "This will never happen."
  #endif
  