{-|
Description: Spock actions for interacting with the 'TsWeb.Types.Context'

Various functions for reading data from the current Spock Action's context.
Currently that's just reading URL path info and auth data.
-}
module TsWeb.Action
  ( getPath
  , showPath
  , getExtra
  ) where

import TsWeb.Types (Context(..), TsActionCtxT)

import Data.HVect (AllHave, HVectElim, ListContains, findFirst)
import Data.Text (Text)
import Database.Beam hiding (runSelectReturningList, runSelectReturningOne)
import SuperRecord (FldProxy, Has, get)
import Web.HttpApiData (ToHttpApiData)
import Web.Routing.Combinators (PathState(Open))
import Web.Spock (ActionCtxT, Path, getContext, renderRoute)

-- | Look up a tagged path in a view. If we have a route looking like
--
-- @
--   'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #user ("users" \<//\> var) ('TsWeb.Routing.get' user)
-- @
--
-- then a view could access that user path with
--
-- @
--   users <- getPath #user
--   let txt = 'Web.Spock.renderRoute' users "bob"
-- @
getPath :: (Has l lts v) => FldProxy l -> TsActionCtxT lts xs sess v
getPath tag = SuperRecord.get tag . ctxPaths <$> getContext

-- | Look up a path and render it. This returns a sort-of variadic function
-- that can be provided with the right number of arguments in order to render
-- a path. As with the above example, a route like this:
--
-- @
--   'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #user ("users" \<//\> var) ('TsWeb.Routing.get' user)
-- @
--
-- could be rendered like this:
--
-- @
--   usersfn <- showPath #user
--   let txt = usersfn "bob"
-- @
--
-- or, more succinctly:
--
-- @
--   txt <- ($ "bob") \<$\> showPath $user
-- @
showPath ::
     (AllHave ToHttpApiData as, Has l lts v, v ~ Path as 'Open)
  => FldProxy l
  -> TsActionCtxT lts vec sess (Data.HVect.HVectElim as Text)
showPath tag = do
  path <- getPath tag
  pure $ renderRoute path

-- | Look up data that was put into the 'ctxExtras' part of the action's
-- context. This is pretty bound up with type signatures and other verbosity,
-- but if we have a database-writing view like so:
--
-- @
--   'TsWeb.Routing.runroute' ro rw $ 'TsWeb.Routing.path' #root 'Web.Spock.root' ('TsWeb.Routing.dbwrite' $ 'TsWeb.Routing.get' index)
-- @
--
-- then that index view could be written like so:
--
-- @
--   index :: 'Data.HVect.ListContains' n 'TsWeb.Types.Db.ReadWritePool' xs => 'TsActionCtxT' lts xs sess a
--   index = do
--     db :: ReadWritePool <- getExtra
--     ...
-- @
getExtra :: (MonadIO m, ListContains n v xs) => ActionCtxT (Context lts xs) m v
getExtra = findFirst . ctxExtras <$> getContext