content: -- | Test case for ReaderT based server
  module Test.Server.Counter (spec) where
  
  import Control.Monad.Reader
  import Data.IORef
  import Data.Maybe
  import Data.Text qualified as Text
  import Mig.Core
  import Mig.Core qualified as Request (Request (..))
  import Network.HTTP.Types.Method (methodPost)
  import Test.Hspec
  import Test.Server.Common
  
  -------------------------------------------------------------------------------------
  -- server definition
  
  newtype Env = Env (IORef Int)
  
  initEnv :: IO Env
  initEnv = Env <$> newIORef 0
  
  newtype App a = App (ReaderT Env IO a)
    deriving newtype (Functor, Applicative, Monad, MonadReader Env, MonadIO)
  
  runApp :: Env -> App a -> IO a
  runApp env (App act) = runReaderT act env
  
  {-| Server has two routes:
  
  * get - to querry current state
  * put - to add some integer to the state
  -}
  server :: Server App
  server =
    "counter"
      /. [ "get" /. handleGet
         , "put" /. handlePut
         ]
  
  -- | Get handler. It logs the call and returns current state
  handleGet :: Get App (Resp Json Int)
  handleGet = Send $ do
    Env ref <- ask
    liftIO $ ok <$> readIORef ref
  
  -- | Put handler. It logs the call and updates the state with integer which is read from URL
  handlePut :: Capture "arg" Int -> Post App (Resp Json ())
  handlePut (Capture val) = Send $ do
    Env ref <- ask
    liftIO $ ok <$> atomicModifyIORef' ref (\cur -> (cur + val, ()))
  
  -------------------------------------------------------------------------------------
  -- test cases
  
  spec :: Spec
  spec = describe "counter server (ReaderT)" $ do
    describe "plain route finder" $ specBy plainApiStrategy
    describe "tree route finder" $ specBy treeApiStrategy
  
  specBy :: FindRoute normalForm App -> Spec
  specBy findRoute =
    it "run accumulator script" $
      script serverFun [1, 2, 3, 4] `shouldReturn` [1, 3, 6, 10]
    where
      serverFun = fromServer findRoute server
  
  {-| Puts inputs to server and returns result of "counter/get" method call
  on each increment
  -}
  script :: ServerFun App -> [Int] -> IO [Int]
  script f inputs = do
    env <- initEnv
    runApp env $ catMaybes <$> mapM go inputs
    where
      go :: Int -> App (Maybe Int)
      go n = fmap (parseResp =<<) $ do
        mRes <- f (putReq n)
        if (isJust mRes)
          then f getReq
          else pure Nothing
  
      putReq :: Int -> Request
      putReq increment =
        emptyReq
          { method = methodPost
          , Request.path = ["counter", "put", Text.pack (show increment)]
          }
  
      getReq :: Request
      getReq = emptyReq{Request.path = ["counter", "get"]}
  