-----------------------------------------------------------------------------
--
-- Module      :  Uniform.Webserver
--
-- | a miniaml set of
-----------------------------------------------------------------------------
-- {-# LANGUAGE BangPatterns          #-}
{-# LANGUAGE DoAndIfThenElse       #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings     #-}
-- {-# LANGUAGE PackageImports        #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE TypeFamilies          #-}
-- {-# LANGUAGE TypeSynonymInstances  #-}
{-# LANGUAGE UndecidableInstances  #-}

-- {-# OPTIONS_GHC  -fno-warn-warnings-deprecations #-}
    -- runErrorT is  but used in monads-tf
{-# OPTIONS_GHC -w #-}


module Uniform.WebServer (module Uniform.WebServer
        , Port 
        )  where

import UniformBase hiding ((</>), (<.>), S)
-- import           Uniform.Strings hiding ((</>), (<.>), S)
import           Web.Scotty hiding (File)
import           Network.Wai.Middleware.Static  ( staticPolicy
                                                , addBase
                                                )
import           Network.Wai.Handler.Warp       ( Port ) -- .Warp.Types
-- import Uniform.FileIO

runScotty :: Port -> Path Abs Dir -> Path Rel File -> ErrIO () 
-- run scotty at the port for the directory with the given landing page 
runScotty :: Port -> Path Abs Dir -> Path Rel File -> ErrIO ()
runScotty Port
port Path Abs Dir
bakedPath Path Rel File
landingFile = forall a. IO a -> ErrIO a
callIO forall a b. (a -> b) -> a -> b
$ do 
    Port -> ScottyM () -> IO ()
scotty Port
port (Path Abs Dir -> Path Rel File -> ScottyM ()
site Path Abs Dir
bakedPath Path Rel File
landingFile)

site :: Path Abs Dir -> Path Rel File -> ScottyM ()
-- for get, return the page from baked
-- for post return error
-- the bakedPath is the origin for the relative url
-- the landing is the rel page name for the landing page 
site :: Path Abs Dir -> Path Rel File -> ScottyM ()
site Path Abs Dir
bakedPath Path Rel File
landing = do
    RoutePattern -> ActionM () -> ScottyM ()
get RoutePattern
"/" forall a b. (a -> b) -> a -> b
$ FilePath -> ActionM ()
file (forall b t. Path b t -> FilePath
toFilePath forall a b. (a -> b) -> a -> b
$ Path Rel File -> Path Abs Dir -> Path Abs File
makeLandingPage Path Rel File
landing Path Abs Dir
bakedPath)
    Middleware -> ScottyM ()
middleware forall a b. (a -> b) -> a -> b
$ Policy -> Middleware
staticPolicy forall a b. (a -> b) -> a -> b
$ FilePath -> Policy
addBase (forall b t. Path b t -> FilePath
toFilePath Path Abs Dir
bakedPath)

makeLandingPage :: Path Rel File -> Path Abs Dir -> Path Abs File 
makeLandingPage :: Path Rel File -> Path Abs Dir -> Path Abs File
makeLandingPage Path Rel File
landingFn Path Abs Dir
bakedPath =
     forall fp file.
Filenames3 fp file =>
fp -> file -> FileResultT fp file
addFileName Path Abs Dir
bakedPath Path Rel File
landingFn 
            -- (makeRelFile "landingPage.html")