On Tue, Jul 11, 2017 at 06:57:03PM -0700, Bryan Richter wrote: > Much of this patch makes sense to me. I'm pretty sure I know where the > type errors are originating from, too.
I looked at this yesterday, and I realized what really needs to happen
is we get rid of StripeI. It is completely superfluous; I never want
to test at that level.
We should get rid of StripeI, but still make the stripe runner (e.g.
Web.Stripe.stripe) an API parameter.
>
> Throw rocks at me if I don't get to this in the next 24 hours or so...
>
> On Tue, Jul 11, 2017 at 06:16:58AM +0300, fr33domlover wrote:
> > From: fr33domlover <fr33domlo...@riseup.net>
> >
> > This is a new version of the patch, it uses runStripe in appStripe. It
> > avoids the StripeClient mess but still has a type error due to
> > StripeRunner being having the 'forall io' thing. The errors can be fixed
> > using type annotations probably, but using those in every single place
> > 'snowstripe' is used would be ridiculous.
> >
> > Honestly idk much about Rank N types. I read about it and did some web
> > search. And I still don't understand how to properly fix this type error
> > thing. I think the error is simpler now but idk how to *elegantly* fix it.
> > ---
> > crowdmatch/crowdmatch.cabal | 3 ++-
> > crowdmatch/src/Crowdmatch.hs | 7 +++++++
> > website/src/AppDataTypes.hs | 8 ++++----
> > website/src/Application.hs | 7 ++-----
> > website/src/Handler/PaymentInfo.hs | 11 ++---------
> > website/src/Handler/Util.hs | 9 +++++----
> > 6 files changed, 22 insertions(+), 23 deletions(-)
> >
> > diff --git a/crowdmatch/crowdmatch.cabal b/crowdmatch/crowdmatch.cabal
> > index d378766..2c602f1 100644
> > --- a/crowdmatch/crowdmatch.cabal
> > +++ b/crowdmatch/crowdmatch.cabal
> > @@ -28,7 +28,8 @@ library
> > hs-source-dirs: src
> > default-language: Haskell2010
> > build-depends:
> > - base >=4.8 && <4.9
> > + aeson
> > + , base >=4.8 && <4.9
> > , bytestring >= 0.10.6.0
> > , errors
> > , lens
> > diff --git a/crowdmatch/src/Crowdmatch.hs b/crowdmatch/src/Crowdmatch.hs
> > index fe61387..a857c2a 100644
> > --- a/crowdmatch/src/Crowdmatch.hs
> > +++ b/crowdmatch/src/Crowdmatch.hs
> > @@ -58,10 +58,12 @@ import Control.Error (ExceptT(..), runExceptT, note)
> > import Control.Lens ((^.), from, view, Iso', iso)
> > import Control.Monad (void)
> > import Control.Monad.IO.Class (MonadIO, liftIO)
> > +import Data.Aeson (FromJSON)
> > import Data.Function (on)
> > import Data.Int (Int32)
> > import Data.Ratio
> > import Data.Time (UTCTime, getCurrentTime, utctDay)
> > +import Data.Typeable (Typeable)
> > import Database.Persist
> > import Database.Persist.Sql (SqlPersistT)
> > import System.IO
> > @@ -73,6 +75,7 @@ import Web.Stripe.Customer
> > , createCustomer
> > , deleteCustomer)
> > import Web.Stripe.Error (StripeError)
> > +import Web.Stripe.StripeRequest (StripeRequest, StripeReturn)
> >
> > import Crowdmatch.Model hiding (Patron(..))
> > import qualified Crowdmatch.Model as Model
> > @@ -87,6 +90,10 @@ import qualified Crowdmatch.Skeleton as Skeleton
> > -- | A method that runs 'SqlPersistT' values in your environment.
> > type SqlRunner io env = forall a. SqlPersistT io a -> env a
> >
> > +type StripeClient = forall a.
> > + (Typeable (StripeReturn a), FromJSON (StripeReturn a)) =>
> > + StripeConfig -> StripeRequest a -> IO (Either StripeError
> > (StripeReturn a))
> > +
> > -- | A method that runs 'StripeI' instructions in IO. A default that uses
> > -- 'stripe' is provided by 'runStripe'.
> > type StripeRunner = forall io.
> > diff --git a/website/src/AppDataTypes.hs b/website/src/AppDataTypes.hs
> > index 39ea400..50d2526 100644
> > --- a/website/src/AppDataTypes.hs
> > +++ b/website/src/AppDataTypes.hs
> > @@ -16,6 +16,7 @@ import Yesod.Core.Types (Logger)
> > import Yesod.GitRev
> >
> > import AuthSite
> > +import Crowdmatch
> > import Settings
> >
> > -- | The God-object available to every Handler. This is the site's
> > @@ -30,10 +31,9 @@ data App = App
> > , appAuth :: AuthSite
> > -- | The function for doing stripe API calls. Swapped out for a mock
> > -- thing in tests.
> > - , appStripe :: forall a. (Typeable (StripeReturn a), FromJSON
> > (StripeReturn a))
> > - => StripeConfig
> > - -> StripeRequest a
> > - -> IO (Either StripeError (StripeReturn a))
> > + , appStripe :: StripeConfig
> > + -> forall a. StripeI a
> > + -> HandlerT App IO (Either StripeError a)
> > }
> >
> > -- This function generates the route types, and also generates the
> > diff --git a/website/src/Application.hs b/website/src/Application.hs
> > index 761d3f8..b6b20db 100644
> > --- a/website/src/Application.hs
> > +++ b/website/src/Application.hs
> > @@ -33,6 +33,7 @@ import Web.Stripe
> > import Web.Stripe.Error
> > import qualified Yesod.GitRev as G
> >
> > +import Crowdmatch
> > import Handler
> > import Handler.Dashboard
> > import Handler.Discourse
> > @@ -61,11 +62,7 @@ makeFoundation appSettings = do
> > (if appMutableStatic appSettings then staticDevel else static)
> > (appStaticDir appSettings)
> >
> > - let appStripe :: (Typeable (StripeReturn a), FromJSON (StripeReturn a))
> > - => StripeConfig
> > - -> StripeRequest a
> > - -> IO (Either StripeError (StripeReturn a))
> > - appStripe = stripe
> > + let appStripe = runStripe
> >
> > let appAuth = AuthSite
> > -- We need a log function to create a connection pool. We need a
> > connection
> > diff --git a/website/src/Handler/PaymentInfo.hs
> > b/website/src/Handler/PaymentInfo.hs
> > index 80c66b9..f17babd 100644
> > --- a/website/src/Handler/PaymentInfo.hs
> > +++ b/website/src/Handler/PaymentInfo.hs
> > @@ -54,20 +54,14 @@ deletePaymentInfoForm :: Form ()
> > deletePaymentInfoForm =
> > identifyForm delFormId (renderDivsNoLabels deleteFromPost)
> >
> > -stripeConf :: Handler StripeConfig
> > -stripeConf = fmap
> > - (StripeConfig . appStripeSecretKey . appSettings)
> > - getYesod
> > -
> > postPaymentInfoR :: Handler Html
> > postPaymentInfoR = handleDelete delFormId deletePaymentInfoR $ do
> > Entity uid User{..} <- requireAuth
> > - conf <- stripeConf
> > ((formResult, _), _) <-
> > runFormPost (identifyForm modFormId (paymentForm ""))
> > case formResult of
> > FormSuccess token -> do
> > - stripeRes <- runDB $ storePaymentToken (runStripe conf) uid
> > token
> > + stripeRes <- runDB $ storePaymentToken snowstripe uid token
> > case stripeRes of
> > Left e -> stripeError e
> > Right _ -> do
> > @@ -79,9 +73,8 @@ postPaymentInfoR = handleDelete delFormId
> > deletePaymentInfoR $ do
> >
> > deletePaymentInfoR :: Handler Html
> > deletePaymentInfoR = do
> > - conf <- stripeConf
> > Entity uid User {..} <- requireAuth
> > - stripeDeletionHandler =<< runDB (deletePaymentToken (runStripe conf)
> > uid)
> > + stripeDeletionHandler =<< runDB (deletePaymentToken snowstripe uid)
> > redirect DashboardR
> > where
> > stripeDeletionHandler =
> > diff --git a/website/src/Handler/Util.hs b/website/src/Handler/Util.hs
> > index ca100f9..11de8aa 100644
> > --- a/website/src/Handler/Util.hs
> > +++ b/website/src/Handler/Util.hs
> > @@ -1,3 +1,5 @@
> > +{-# LANGUAGE RankNTypes #-}
> > +
> > module Handler.Util
> > ( snowdriftTitle
> > , snowdriftDashTitle
> > @@ -25,10 +27,9 @@ snowdriftDashTitle x y = snowdriftTitle $ x `mappend` "
> > — " `mappend` y
> >
> > snowstripe :: StripeI a -> Handler (Either StripeError a)
> > snowstripe req = do
> > - conf <- fmap
> > - (StripeConfig . appStripeSecretKey . appSettings)
> > - getYesod
> > - liftIO (runStripe conf req)
> > + conf <- getsYesod $ StripeConfig . appStripeSecretKey . appSettings
> > + runner <- getsYesod appStripe
> > + runner conf req
> >
> > -- | The form element that can be inserted to handle a delete.
> > deleteFromPost
> > --
> > 1.9.1
> >
> > _______________________________________________
> > Dev mailing list
> > Dev@lists.snowdrift.coop
> > https://lists.snowdrift.coop/mailman/listinfo/dev
> _______________________________________________
> Dev mailing list
> Dev@lists.snowdrift.coop
> https://lists.snowdrift.coop/mailman/listinfo/dev
signature.asc
Description: Digital signature
_______________________________________________ Dev mailing list Dev@lists.snowdrift.coop https://lists.snowdrift.coop/mailman/listinfo/dev
