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