Retrying an Aff

retryAff.purs

module Main where

import Control.Monad.Aff
import Control.Monad.Eff.Console
import Control.Monad.Eff
import Network.HTTP.Affjax
import Network.HTTP.StatusCode
import Data.Functor
import Network.HTTP.Affjax.Response
import Control.Monad
import Prelude
import Data.Either
import Control.Monad.Except.Trans
{--import Control.Monad.Eff.Class--}
{--import Control.Monad.Trans.Class--}
import Control.Monad.Eff.Random

type ExceptionableAff e a = ExceptT String (Aff e) a
type ExceptionableEff e a = ExceptT String (Eff e) a

{--respCode :: ∀ e. String → ExceptT String (Aff (ajax :: AJAX | e)) StatusCode--}
{--respCode url = ExceptT $ map (\r → codeOrErrMessage r.status) (get url :: Affjax _ String)--}

{--codeOrErrMessage sc@(StatusCode 200) = Right sc--}
{--codeOrErrMessage _ = Left "Non 200 Response"--}

{--combinedStatusCodes = do--}
  {--(StatusCode y) ← respCode "http://juspay.in"--}
  {--(StatusCode x) ← respCode "http://juspay.in"--}
  {--pure $ x + y--}

{--retry :: forall m a. Monad m => m a -> (a -> Boolean) -> Int -> String -> m (Either String a)--}
{--retry action cond i errMsg = go i--}
  {--where--}
    {--go :: Int -> m (Either String a)--}
    {--go i'--}
      {--| i <= 0 = pure (Left errMsg)--}
      {--| otherwise = do--}
          {--result <- action--}
          {--if cond result then pure (Right result) else go (i - 1)--}
retry :: ∀ e a. Eff e a → (a → Boolean) → Int → String → ExceptionableEff e a
retry e cond 0 errMsg = ExceptT $ map (\_ → Left errMsg) e
{--[>retry e cond i errMsg = ifM (ExceptT $ map (\a → Right (cond a)) e) (retry e cond (i-1) errMsg) (ExceptT $ map Right e)<]--}
retry e cond i errMsg = ifM (ExceptT $ (cond >>> pure) <$> e)  (ExceptT $ map Right e) (retry e cond (i-1) errMsg)

retry' :: ∀ e a. Aff e a → (a → Boolean) → Int → String → ExceptionableAff e a
retry' action cond i errMsg = ExceptT $ retry'' action cond i errMsg
                              where retry'' action cond i errMsg | i <= 0 = map (\_ → Left errMsg) action
                                                                 | otherwise = do
                                                                     res ← action
                                                                     if cond res then pure $ Right res else retry'' action cond (i-1) errMsg
                                                       {--| otherwise = ifM ((cond <$> e) >>= (\b → (logShow b >>= (\_ → pure b)))) (Right <$> e) (retry'' e cond (i-1) errMsg)--}

randAndLog = random >>= (\x → (logShow x) >>= (\_ → pure x))
{--x = retry' randAndLog ((>)0.5) 10 "Can't get it"--}
{--(runExceptT x) >>= logShow--}


{--main = launchAff do--}
  {--sc ← runExceptT combinedStatusCodes--}
  {--liftEff' $ logShow sc--}

f url = retry' (get url) (\r → r.status == StatusCode 200)
combinedResponse :: forall e. ExceptT String (Aff (ajax :: AJAX | e)) String
combinedResponse = do
  r1 ← retry' (get "/api1") (\r → r.status == StatusCode 200) 3 "API1 Error"
  r2 ← retry' (get "/api2") (\r → r.status == StatusCode 200) 3 "API2 Error"
  pure (r1.response <> r2.response)

main = launchAff $ runExceptT combinedResponse