Much of this patch makes sense to me. I'm pretty sure I know where the type errors are originating from, too.
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
signature.asc
Description: Digital signature
_______________________________________________ Dev mailing list Dev@lists.snowdrift.coop https://lists.snowdrift.coop/mailman/listinfo/dev
