Billing.purs
module Aftok.Billing where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..))
import Data.Maybe (Maybe(..), isNothing)
import Data.Unfoldable as U
import Data.Symbol (SProxy(..))
import Data.Traversable (traverse_)
import Data.Tuple (Tuple(..))
import DOM.HTML.Indexed.ButtonType (ButtonType(..))
import Effect.Aff (Aff)
import Halogen as H
import Halogen.HTML.Core (ClassName(..))
import Halogen.HTML as HH
import Halogen.HTML.Events as E
import Halogen.HTML.Properties as P
import Aftok.Billing.Create as Create
import Aftok.Billing.PaymentRequest as PaymentRequest
import Aftok.ProjectList as ProjectList
import Aftok.Types (System, ProjectId)
import Aftok.Api.Types (APIError(..))
import Aftok.Api.Billing
( BillableId
, Billable
, PaymentRequestId
, PaymentRequest
, listProjectBillables
, listUnpaidPaymentRequests
, recurrenceStr
)
import Aftok.HTML.Classes as C
import Aftok.Zcash (toZEC, zecString)
type BillingInput
= Maybe ProjectId
type BillingState
= { selectedProject :: Maybe ProjectId
, billables :: Array (Tuple BillableId Billable)
, paymentRequests :: Array (Tuple PaymentRequestId PaymentRequest)
}
data BillingAction
= Initialize
| ProjectSelected (Maybe ProjectId)
| OpenBillableModal ProjectId
| BillableCreated BillableId
| OpenPaymentRequestModal ProjectId BillableId
type Slot id
= forall query. H.Slot query ProjectList.Output id
type Slots
= ( projectList :: ProjectList.Slot Unit
, createBillable :: Create.Slot Unit
, createPaymentRequest :: PaymentRequest.Slot Unit
)
_projectList = SProxy :: SProxy "projectList"
_createBillable = SProxy :: SProxy "createBillable"
_createPaymentRequest = SProxy :: SProxy "createPaymentRequest"
type Capability (m :: Type -> Type)
= { createBillable :: Create.Capability m
, createPaymentRequest :: PaymentRequest.Capability m
, listProjectBillables :: ProjectId -> m (Either APIError (Array (Tuple BillableId Billable)))
, listUnpaidPaymentRequests :: BillableId -> m (Either APIError (Array (Tuple PaymentRequestId PaymentRequest)))
}
component ::
forall query m.
Monad m =>
System m ->
Capability m ->
ProjectList.Capability m ->
H.Component HH.HTML query BillingInput ProjectList.Output m
component system caps pcaps =
H.mkComponent
{ initialState
, render
, eval:
H.mkEval
$ H.defaultEval
{ handleAction = handleAction
, initialize = Just Initialize
, receive = Just <<< ProjectSelected
}
}
where
initialState :: BillingInput -> BillingState
initialState input =
{ selectedProject: input
, billables: []
, paymentRequests: []
}
render :: BillingState -> H.ComponentHTML BillingAction Slots m
render st =
HH.section
[ P.classes (ClassName <$> [ "section-border", "border-primary" ]) ]
[ HH.div
[ P.classes (ClassName <$> [ "container", "pt-6" ]) ]
[ HH.h1
[ P.classes (ClassName <$> [ "mb-0", "font-weight-bold", "text-center" ]) ]
[ HH.text "Billing" ]
, HH.p
[ P.classes (ClassName <$> [ "col-md-5", "text-muted", "text-center", "mx-auto" ]) ]
[ HH.text "Your project's payment requests & payments" ]
, HH.div_
[ HH.slot
_projectList
unit
(ProjectList.component system pcaps)
st.selectedProject
(Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected (Just p)))
]
, HH.div
[ P.classes (ClassName <$> if isNothing st.selectedProject then [ "collapse" ] else []) ]
(case st.selectedProject of
Just pid ->
[ renderBillableList pid st.billables
, HH.div
[ P.classes (ClassName <$> [ "col-md-2" ]) ]
[ HH.button
[ P.classes [ C.btn, C.btnPrimary ]
, P.type_ ButtonButton
, E.onClick (\_ -> Just (OpenBillableModal pid))
]
[ HH.text "Create billable" ]
]
, system.portal
_createBillable
unit
(Create.component system caps.createBillable)
unit
Nothing
(\(Create.BillableCreated bid) -> Just (BillableCreated bid))
, system.portal
_createPaymentRequest
unit
(PaymentRequest.component system caps.createPaymentRequest)
unit
Nothing
(const Nothing)
]
Nothing -> []
)
]
]
renderBillableList :: ProjectId -> Array (Tuple BillableId Billable) -> H.ComponentHTML BillingAction Slots m
renderBillableList pid billables =
HH.div
[ P.classes (ClassName <$> [ "container-fluid" ]) ]
[ HH.section
[ P.id_ "projectOverview", P.classes (ClassName <$> [ "pt-3" ]) ]
([ HH.div
-- header
[ P.classes (ClassName <$> [ "row", "pt-3", "font-weight-bold" ]) ]
[ colmd2 (Just "Billable Name")
, colmd2 (Just "Description")
, colmd2 (Just "Amount")
, colmd3 (Just "Recurrence")
, colmd2 Nothing
]
] <> (billableRow <$> billables))
]
where
billableRow (Tuple bid b) =
HH.div
[ P.classes (ClassName <$> [ "row", "border-top" ]) ]
[ colmd2 (Just b.name)
, colmd2 (Just b.description)
, colmd2 (Just (zecString <<< toZEC $ b.amount))
, colmd3 (Just (recurrenceStr b.recurrence))
, HH.div
[ P.classes (ClassName <$> [ "col-md-2" ]) ]
[ HH.button
[ P.classes [ C.btn, C.btnPrimary, C.btnSmall ]
, P.type_ ButtonButton
, E.onClick (\_ -> Just $ OpenPaymentRequestModal pid bid)
]
[ HH.text "New payment request" ]
]
]
colmd2 :: forall i w. Maybe String -> HH.HTML i w
colmd2 xs = HH.div [ P.classes (ClassName <$> [ "col-md-2"]) ] (U.fromMaybe $ HH.text <$> xs)
colmd3 :: forall i w. Maybe String -> HH.HTML i w
colmd3 xs = HH.div [ P.classes (ClassName <$> [ "col-md-3" ]) ] (U.fromMaybe $ HH.text <$> xs)
handleAction :: BillingAction -> H.HalogenM BillingState BillingAction Slots ProjectList.Output m Unit
handleAction action = do
case action of
Initialize -> do
currentPid <- H.gets (_.selectedProject)
traverse_ refreshBillables currentPid
ProjectSelected pidMay -> do
currentPid <- H.gets (_.selectedProject)
traverse_ refreshBillables pidMay
when (currentPid /= pidMay)
$ traverse_ projectSelected pidMay
OpenBillableModal pid -> do
void $ H.query _createBillable unit $ H.tell (Create.OpenModal pid)
BillableCreated _ -> do
currentPid <- H.gets (_.selectedProject)
traverse_ refreshBillables currentPid
OpenPaymentRequestModal pid bid -> do
void $ H.query _createPaymentRequest unit $ H.tell (PaymentRequest.OpenModal pid bid)
where
projectSelected pid = do
H.modify_ (_ { selectedProject = Just pid })
H.raise (ProjectList.ProjectChange pid)
refreshBillables pid = do
billables <- lift $ caps.listProjectBillables pid
case billables of
Left err -> lift $ system.error (show err)
Right b -> H.modify_ (_ { billables = b })
apiCapability :: Capability Aff
apiCapability =
{ createBillable: Create.apiCapability
, createPaymentRequest: PaymentRequest.apiCapability
, listProjectBillables: listProjectBillables
, listUnpaidPaymentRequests: listUnpaidPaymentRequests
}
mockCapability :: Capability Aff
mockCapability =
{ createBillable: Create.mockCapability
, createPaymentRequest: PaymentRequest.mockCapability
, listProjectBillables: \_ -> pure $ Left Forbidden
, listUnpaidPaymentRequests: \_ -> pure $ Left Forbidden
}