{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}

module Slab.Serve
  ( run
  ) where

import Network.Wai qualified as Wai
import Network.Wai.Handler.Warp qualified as Warp
import Protolude hiding (Handler)
import Servant hiding (serve)
import Servant.HTML.Blaze qualified as B
import Servant.Server qualified as Server
import Text.Blaze.Html5 (Html)
import WaiAppStatic.Storage.Filesystem
  ( defaultWebAppSettings
  )

------------------------------------------------------------------------------
run :: FilePath -> IO ()
run :: FilePath -> IO ()
run FilePath
distDir =
  Port -> Application -> IO ()
Warp.run Port
9000 (Application -> IO ()) -> Application -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> Application
serve FilePath
distDir

-- | Turn our `serverT` implementation into a Wai application, suitable for
-- Warp.run.
serve :: FilePath -> Wai.Application
serve :: FilePath -> Application
serve FilePath
root =
  Proxy App -> Context '[] -> Server App -> Application
forall api (context :: [*]).
(HasServer api context, ServerContext context) =>
Proxy api -> Context context -> Server api -> Application
Servant.serveWithContext Proxy App
appProxy Context '[]
Server.EmptyContext (Server App -> Application) -> Server App -> Application
forall a b. (a -> b) -> a -> b
$
    Proxy App
-> Proxy '[]
-> (forall x. Handler x -> Handler x)
-> Server App
-> Server App
forall {k} (api :: k) (context :: [*]) (m :: * -> *) (n :: * -> *).
HasServer api context =>
Proxy api
-> Proxy context
-> (forall x. m x -> n x)
-> ServerT api m
-> ServerT api n
forall (m :: * -> *) (n :: * -> *).
Proxy App
-> Proxy '[]
-> (forall x. m x -> n x)
-> ServerT App m
-> ServerT App n
Server.hoistServerWithContext Proxy App
appProxy Proxy '[]
settingsProxy Handler x -> Handler x
forall a. a -> a
forall x. Handler x -> Handler x
identity (Server App -> Server App) -> Server App -> Server App
forall a b. (a -> b) -> a -> b
$
      FilePath -> Server App
serverT FilePath
root

------------------------------------------------------------------------------
type ServerSettings = '[]

settingsProxy :: Proxy ServerSettings
settingsProxy :: Proxy '[]
settingsProxy = Proxy '[]
forall {k} (t :: k). Proxy t
Proxy

------------------------------------------------------------------------------
type App =
  "hello" :> Get '[B.HTML] Html
    :<|> Servant.Raw -- Fallback handler for the static files, in particular the

appProxy :: Proxy App
appProxy :: Proxy App
appProxy = Proxy App
forall {k} (t :: k). Proxy t
Proxy

------------------------------------------------------------------------------
serverT :: FilePath -> ServerT App Handler
serverT :: FilePath -> Server App
serverT FilePath
root =
  Handler Html
showHelloPage
    Handler Html
-> Tagged Handler Application
-> Handler Html :<|> Tagged Handler Application
forall a b. a -> b -> a :<|> b
:<|> FilePath -> Tagged Handler Application
serveStatic FilePath
root

------------------------------------------------------------------------------
showHelloPage :: Handler Html
showHelloPage :: Handler Html
showHelloPage = Html -> Handler Html
forall a. a -> Handler a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Html
"Hello."

------------------------------------------------------------------------------
serveStatic :: FilePath -> Server.Tagged Handler Server.Application
serveStatic :: FilePath -> Tagged Handler Application
serveStatic FilePath
root = StaticSettings -> ServerT Raw Handler
forall (m :: * -> *). StaticSettings -> ServerT Raw m
Servant.serveDirectoryWith StaticSettings
settings
 where
  settings :: StaticSettings
settings = FilePath -> StaticSettings
defaultWebAppSettings FilePath
root