module Aftok.Overview where import Prelude import Control.Monad.Trans.Class (lift) import Data.Array (reverse, sortWith) import Data.List as L import Data.DateTime (DateTime, date) import Data.Time.Duration (Hours(..), Days(..)) import Data.Either (Either(..)) import Data.Fixed as F import Data.Ratio as R import Data.Map as M import Data.Maybe (Maybe(..), maybe, isNothing) import Data.Unfoldable as U import Data.Newtype (unwrap) import Data.Symbol (SProxy(..)) import Data.Traversable (traverse_) import Data.UUID (genUUID) import Effect.Aff (Aff) import Effect.Class (liftEffect) import Effect.Now (nowDateTime) import DOM.HTML.Indexed.ButtonType (ButtonType(..)) 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.HTML.Classes as C import Aftok.ProjectList as ProjectList import Aftok.Projects.Invite as Invite import Aftok.Projects.Create as Create import Aftok.Types (System, ProjectId, UserId(..), dateStr) import Aftok.Api.Types (APIError) import Aftok.Api.Project ( Project'(..) , ProjectDetail , ProjectDetail'(..) , DepreciationFn(..) , Contributor'(..) , getProjectDetail ) type OverviewInput = Maybe ProjectId type OverviewState = { selectedProject :: Maybe ProjectId , projectDetail :: Maybe ProjectDetail } data OverviewAction = Initialize | ProjectSelected (Maybe ProjectId) | OpenCreateModal | OpenInviteModal ProjectId type Slot id = forall query. H.Slot query ProjectList.Output id type Slots = ( projectList :: ProjectList.Slot Unit , projectCreateModal :: Create.Slot Unit , invitationModal :: Invite.Slot Unit ) _projectList = SProxy :: SProxy "projectList" _projectCreateModal = SProxy :: SProxy "projectCreateModal" _invitationModal = SProxy :: SProxy "invitationModal" type Capability (m :: Type -> Type) = { getProjectDetail :: ProjectId -> m (Either APIError (Maybe ProjectDetail)) , invitationCaps :: Invite.Capability m , createCaps :: Create.Capability m } component :: forall query m. Monad m => System m -> Capability m -> ProjectList.Capability m -> H.Component HH.HTML query OverviewInput ProjectList.Output m component system caps pcaps = H.mkComponent { initialState , render , eval: H.mkEval $ H.defaultEval { handleAction = handleAction , receive = Just <<< ProjectSelected , initialize = Just Initialize } } where initialState :: OverviewInput -> OverviewState initialState input = { selectedProject: input , projectDetail: Nothing } render :: OverviewState -> H.ComponentHTML OverviewAction 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 "Project Overview" ] , HH.p [ P.classes (ClassName <$> [ "text-muted", "text-center", "mx-auto" ]) ] [ HH.text "Your project details" ] , HH.div_ [ HH.slot _projectList unit (ProjectList.component system pcaps) st.selectedProject (Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected (Just p))) , system.portal _projectCreateModal unit (Create.component system caps.createCaps) unit Nothing (Just <<< (\(Create.ProjectCreated p) -> ProjectSelected (Just p))) ] , HH.div [ P.classes (ClassName <$> if isNothing st.selectedProject then [ "collapse" ] else []) ] (U.fromMaybe $ projectDetail <$> st.projectDetail) , HH.div [ P.classes (ClassName <$> [ "pt-6", "mx-auto" ]) ] [ HH.button [ P.classes [ C.btn, C.btnPrimary ] , P.type_ ButtonButton , E.onClick (\_ -> Just OpenCreateModal) ] [ HH.text "Create a new project" ] ] ] ] projectDetail :: ProjectDetail -> H.ComponentHTML OverviewAction Slots m projectDetail (ProjectDetail' detail) = do let (Project' project) = detail.project 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 "Project Name") , colmd3 (Just "Undepreciated Period") , colmd3 (Just "Depreciation Duration") , colmd2 (Just "Originator") , colmd2 (Just "Origination Date") ] , HH.div [ P.classes (ClassName <$> [ "row", "pt-3" ]) ] ( [ colmd2 (Just project.projectName) ] <> depreciationCols project.depf <> [ colmd2 ((\(Contributor' p) -> p.handle) <$> M.lookup project.initiator detail.contributors) , colmd2 (Just $ dateStr (date project.inceptionDate)) ] ) ] , HH.section [ P.id_ "contributors" ] ( [ HH.div -- header [ P.classes (ClassName <$> [ "row", "pt-3", "font-weight-bold" ]) ] [ colmd2 (Just "Contributor") , colmd2 (Just "Joined") , colmd2 (Just "Contributed") , colmd3 (Just "After Depreciation") , colmd3 (Just "Revenue Share") ] ] <> (contributorCols <$> ( reverse <<< sortWith ((_.revShare) <<< unwrap) <<< L.toUnfoldable $ M.values detail.contributors )) <> [ HH.div [ P.classes (ClassName <$> [ "row", "pt-3", "font-weight-bold" ]) ] [ HH.div [ P.classes (ClassName <$> [ "col-md-2" ]) ] [ HH.button [ P.classes [ C.btn, C.btnPrimary ] , P.type_ ButtonButton , E.onClick (\_ -> Just (OpenInviteModal project.projectId)) ] [ HH.text "Invite a collaborator" ] ] , system.portal _invitationModal unit (Invite.component system caps.invitationCaps) unit Nothing (const Nothing) ] ] ) ] depreciationCols :: DepreciationFn -> Array (H.ComponentHTML OverviewAction Slots m) depreciationCols = case _ of LinearDepreciation obj -> [ colmd3 (Just $ show (unwrap obj.undep) <> " days") , colmd3 (Just $ show (unwrap obj.dep) <> " days") ] contributorCols :: Contributor' DateTime -> H.ComponentHTML OverviewAction Slots m contributorCols (Contributor' pud) = let shareFrac = R.numerator pud.revShare `div` R.denominator pud.revShare pct = maybe "N/A" (\f -> F.toString (f * F.fromInt 100)) (F.fromNumber shareFrac :: Maybe (F.Fixed F.P10000)) in HH.div [ P.classes (ClassName <$> [ "row", "pt-3", "pb-2" ]) ] [ colmd2 (Just pud.handle) , colmd2 (Just $ dateStr (date pud.joinedOn)) , colmd2 (Just $ show (unwrap pud.loggedHours) <> " hours") , colmd3 (Just $ show (unwrap pud.depreciatedHours) <> " hours") , colmd3 (Just $ pct <> "%") ] colmd2 :: Maybe String -> H.ComponentHTML OverviewAction Slots m colmd2 xs = HH.div [ P.classes (ClassName <$> [ "col-md-2" ]) ] (U.fromMaybe $ HH.text <$> xs) colmd3 :: Maybe String -> H.ComponentHTML OverviewAction Slots m colmd3 xs = HH.div [ P.classes (ClassName <$> [ "col-md-3" ]) ] (U.fromMaybe $ HH.text <$> xs) handleAction :: OverviewAction -> H.HalogenM OverviewState OverviewAction Slots ProjectList.Output m Unit handleAction action = do case action of Initialize -> do currentProject <- H.gets (_.selectedProject) traverse_ setProjectDetail currentProject OpenCreateModal -> do void <<< H.query _projectCreateModal unit $ H.tell (Create.OpenModal) OpenInviteModal pid -> do void <<< H.query _invitationModal unit $ H.tell (Invite.OpenModal pid) ProjectSelected pidMay -> do currentProject <- H.gets (_.selectedProject) when (currentProject /= pidMay) $ traverse_ projectSelected pidMay where projectSelected pid = do H.modify_ (_ { selectedProject = Just pid }) setProjectDetail pid H.raise (ProjectList.ProjectChange pid) setProjectDetail :: ProjectId -> H.HalogenM OverviewState OverviewAction Slots ProjectList.Output m Unit setProjectDetail pid = do detail <- lift $ caps.getProjectDetail pid case detail of Left err -> lift $ system.error (show err) Right d -> H.modify_ (_ { projectDetail = d }) apiCapability :: Capability Aff apiCapability = { getProjectDetail: getProjectDetail , invitationCaps: Invite.apiCapability , createCaps: Create.apiCapability } mockCapability :: Capability Aff mockCapability = { getProjectDetail: \pid -> do t <- liftEffect nowDateTime uid <- UserId <$> liftEffect genUUID pure <<< Right <<< Just $ ProjectDetail' { project: Project' { projectId: pid , projectName: "Fake Project" , inceptionDate: t , initiator: uid , depf: LinearDepreciation { undep: Days 30.0, dep: Days 300.0 } } , contributors: M.singleton uid $ Contributor' { userId: uid , handle: "Joe" , joinedOn: t , loggedHours: Hours 100.0 , depreciatedHours: Hours 75.0 , revShare: 55.0 R.% 100.0 } } , invitationCaps: Invite.apiCapability , createCaps: Create.apiCapability }