{-# LANGUAGE DataKinds #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE InstanceSigs #-}

module Servant
  ( -- * Routes
    Get
  , Capture
  , (:<|>)(..)
  , (:/)
    -- * Servers
  , HasServer(..)
  , serve
    -- * Utilities
  , Proxy(..)
  )
where

import GHC.TypeLits (KnownSymbol(..), Symbol(..), symbolVal)
import Text.Read (readMaybe)
import Data.Kind (Type)

import Control.Concurrent.MonadIO (liftIO)
import Orc (Orc, (<|>))

-- * Carries a phantom type around with it.
data Proxy (a :: k) = Proxy

-- * API type language

-- | An endpoint serving content of type @content :: *@.
-- Content types are ignored here.
data Get (content :: Type)

-- | Choice between two routes.
data (a :: Type) :<|> (b :: Type) = a :<|> b
infixr 8 :<|>

-- | Nested routes. @component :: k@ is either a type-level string or a
-- @Capture@. Because these two possibilities have different kinds we make
-- @component@ kind-polymorphic.
data (component :: k) :/ (rest :: Type)
infixr 9 :/

-- | A route component that is captured.
data Capture (component :: Type)

-- | Types which have servers!
class HasServer (layout :: k) where
  -- | Responds to requests matching some route 'layout'.
  type Server layout :: Type
  -- | Request router for a particular 'layout'.
  route
    :: Proxy layout
    -> Server layout
    -> [ String ]
    -> Maybe (Orc String)

-- | Endpoints may be served.
instance Show content => HasServer (Get content) where
  type Server (Get content) = Orc content
  route
    :: Proxy (Get content)
    -> Orc content
    -> [ String ]
    -> Maybe (Orc String)
  route :: Proxy (Get content)
-> Orc content -> [String] -> Maybe (Orc String)
route Proxy (Get content)
_ Orc content
handler [] = forall a. a -> Maybe a
Just (forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Orc content
handler)
  route Proxy (Get content)
_ Orc content
_       [String]
_  = forall a. Maybe a
Nothing

-- | Given the choice of two routes, either may be served.
instance (HasServer a, HasServer b) => HasServer (a :<|> b) where
  type Server (a :<|> b) = Server a :<|> Server b
  route
    :: Proxy (a :<|> b)
    -> (Server a :<|> Server b)
    -> [ String ]
    -> Maybe (Orc String)
  route :: Proxy (a :<|> b)
-> (Server a :<|> Server b) -> [String] -> Maybe (Orc String)
route Proxy (a :<|> b)
_ (Server a
handlerA :<|> Server b
handlerB) [String]
xs =
        forall k (layout :: k).
HasServer layout =>
Proxy layout -> Server layout -> [String] -> Maybe (Orc String)
route (forall k (a :: k). Proxy a
Proxy :: Proxy a) Server a
handlerA [String]
xs
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall k (layout :: k).
HasServer layout =>
Proxy layout -> Server layout -> [String] -> Maybe (Orc String)
route (forall k (a :: k). Proxy a
Proxy :: Proxy b) Server b
handlerB [String]
xs

-- | An endpoint nested under a static path may be served.
instance (KnownSymbol s, HasServer r) => HasServer ((s :: Symbol) :/ r) where
  type Server ((s :: Symbol) :/ r) = Server r
  route
    :: Proxy (s :/ r)
    -> Server r
    -> [ String ]
    -> Maybe (Orc String)
  route :: Proxy (s :/ r) -> Server r -> [String] -> Maybe (Orc String)
route Proxy (s :/ r)
_ Server r
handler (String
x : [String]
xs)
    | forall (n :: Symbol) (proxy :: Symbol -> *).
KnownSymbol n =>
proxy n -> String
symbolVal (forall k (a :: k). Proxy a
Proxy :: Proxy s) forall a. Eq a => a -> a -> Bool
== String
x =
      forall k (layout :: k).
HasServer layout =>
Proxy layout -> Server layout -> [String] -> Maybe (Orc String)
route (forall k (a :: k). Proxy a
Proxy :: Proxy r) Server r
handler [String]
xs
  route Proxy (s :/ r)
_ Server r
_ [String]
_ = forall a. Maybe a
Nothing

-- | An endpoint nested under a dynamic path may be served using the content of
-- the path.
instance (Read a, HasServer r) => HasServer (Capture a :/ r) where
  type Server (Capture a :/ r) = a -> Server r
  route
    :: Proxy (Capture a :/ r)
    -> (a -> Server r)
    -> [ String ]
    -> Maybe (Orc String)
  route :: Proxy (Capture a :/ r)
-> (a -> Server r) -> [String] -> Maybe (Orc String)
route Proxy (Capture a :/ r)
_ a -> Server r
handler (String
x : [String]
xs) = do
    a
a <- forall a. Read a => String -> Maybe a
readMaybe String
x
    forall k (layout :: k).
HasServer layout =>
Proxy layout -> Server layout -> [String] -> Maybe (Orc String)
route (forall k (a :: k). Proxy a
Proxy :: Proxy r) (a -> Server r
handler a
a) [String]
xs
  route Proxy (Capture a :/ r)
_ a -> Server r
_ [String]
_ = forall a. Maybe a
Nothing

-- | Builds an 'Orc' computation to serve requests matching some URL layout.
serve
  :: HasServer layout
  => Proxy layout
  -> Server layout
  -> [ String ]
  -> Orc String
serve :: forall {k} (layout :: k).
HasServer layout =>
Proxy layout -> Server layout -> [String] -> Orc String
serve Proxy layout
p Server layout
h [String]
xs = case forall k (layout :: k).
HasServer layout =>
Proxy layout -> Server layout -> [String] -> Maybe (Orc String)
route Proxy layout
p Server layout
h [String]
xs of
  Maybe (Orc String)
Nothing     ->  forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IOError -> IO a
ioError (String -> IOError
userError String
"404")
  Just Orc String
m      -> Orc String
m