QAC2QJ32ZLAK25KJ7SWT27WOZKD2MMDE7OZPHIRRFP2W2QZW7PBAC
AAALU5A2FQQTNV7ZVAFCU2JTRUONEUWWZKENDUUXDOFUGWHM3KZQC
RSF6UAJKG7CEKILSVXI6C4YZXY7PIYZM2EMA2IXKQ7SADKNVSH7QC
IR75ZMX32SFFMDNV2I2L22X5JTWCOC4UUBCSPU7S6VHR6HFV6ADQC
EA5BFM5GMM7KNMDLTVOSUKVKMSIDD72TAFVHDVGEOUY5VELECU3QC
WRPIYG3EUHZR6N6T74ZXZDXATRMIRLXAQ24UNUNSVTVYGMT2VDSQC
ZIG57EE6RB22JGB3CT33EN2HVYCHCXBT5GROBTBMBLEMDTGQOOBQC
QU5FW67RGCWOWT2YFM4NYMJFFHWIRPQANQBBAHBKZUY7UYMCSIMQC
QMEYU4MWLTSWPWEEOFRLK2IKE64BY3V5X73323WPLCGPP3TPDYGAC
2J37EVJMX255K3XEJHTZGRPEIRMAQ62JQWOA7JU3YTZUB6PUPWVQC
JXG3FCXYBDKMUD77DOM7RCIJYKB7BILC43OHHDZBE7YQRGAMUCCAC
OUR4PAOTXXKXQPMAR5TIYX7MBRRJS2WVTZS7SN4SOGML7SPJIJGQC
NJNMO72S7VIUV22JXB4IFPZMHWTJAOTP6EC6Z4QSKYIROSXT52MQC
J6S23MDGHVSCVVIRB6XRNSY3EGTDNWFJHV7RYLIEHBUK5KU63CFQC
RB2ETNIFLQUA6OA66DAEOXZ25ENMQGNKX5CZRSKEYHTD6BQ6NTFQC
PT4276XCOP5NJ3GRFJLIBZKVNVAOATAY5PLWV7FWK6RZW5FTEP5AC
ARX7SHY5UXL5ZZDY4BJ6LVQSC2XCI5M6FFXQ35MBWDRUHNJNICHQC
BFZN4SUAGYNFFYVAP36BAX32DMO622PK4EPEVQQEAGC2IHTEAAPQC
SAESJLLYCQJUIHKFYFV53AWHFOSGI5SKLVS7DPTQO6BKGITPYPUQC
O2BZOX7MS4JCDS3C6EJQXAWUEQV6HVDCIF2FIN2BCJNRLIU6ZVKAC
import Aftok.Project (ProjectId(..), pidStr)
-- import Aftok.Types (APIError, JsonCompose, decompose, parseDatedResponse)
import Aftok.Types (APIError, decompose, parseDatedResponse)
import Aftok.Types (APIError, decompose, parseDatedResponse, ProjectId(..), pidStr)
module Aftok.Overview where
import Prelude
-- import Control.Alt ((<|>))
-- import Control.Monad.Rec.Class (forever)
-- import Control.Monad.State (State, put, get, evalState)
-- import Control.Monad.Trans.Class (lift)
-- import Control.Monad.Maybe.Trans (MaybeT(..), runMaybeT)
--
-- import Data.Array (reverse, cons)
-- import Data.Date (Date, year, month, day)
-- import Data.DateTime as DT
-- import Data.DateTime (DateTime(..), date)
-- import Data.DateTime.Instant (Instant, unInstant, fromDateTime, toDateTime)
-- import Data.Either (Either(..))
-- import Data.Enum (fromEnum)
import Data.Foldable (any)
-- import Data.Map as M
import Data.Maybe (Maybe(..), isNothing)
import Data.Newtype (unwrap)
import Data.Symbol (SProxy(..))
-- import Data.Time.Duration (Milliseconds(..), Hours(..), Days(..))
-- import Data.Traversable (traverse_, traverse)
-- import Data.Tuple (Tuple(..))
-- import Data.Unfoldable as U
-- -- import Text.Format as F -- (format, zeroFill, width)
-- import Effect.Aff as Aff
import Effect.Aff (Aff)
-- import Effect.Class (liftEffect)
-- import Effect.Exception (error)
-- import Effect.Now (now)
import Halogen as H
-- import Halogen.Query.EventSource (EventSource)
-- import Halogen.Query.EventSource as EventSource
import Halogen.HTML.Core (ClassName(..))
import Halogen.HTML as HH
-- import Halogen.HTML.CSS as CSS
-- import Halogen.HTML.Events as E
import Halogen.HTML.Properties as P
-- import CSS (backgroundColor, clear, clearBoth, border, rgb, solid, borderRadius, marginLeft)
-- import CSS.Display (display, flex)
-- import CSS.Geometry (width, height)
-- import CSS.Size (px, pct)
-- import Aftok.Api.Overview as TL
-- import Aftok.Api.Overview
-- ( OverviewError,
-- Event(..),
-- Interval(..),
-- TimeInterval,
-- KeyedEvent,
-- TimeSpan,
-- start, end, interval,
-- event, eventTime, keyedEvent
-- )
import Aftok.Project as Project
-- import Aftok.Project (Project, Project'(..), ProjectId) --, pidStr)
import Aftok.Types (System, Project, ProjectEvent(..))
type OverviewInput = Maybe Project
type OverviewState =
{ selectedProject :: Maybe Project
}
data Invitation
= InviteByEmail String
| InviteByZaddr String
data OverviewAction
= Initialize
| ProjectSelected Project
| Invite Invitation
type Slot id = forall query. H.Slot query ProjectEvent id
type Slots =
( projectList :: Project.ProjectListSlot Unit
)
_projectList = SProxy :: SProxy "projectList"
type Capability (m :: Type -> Type) =
{
}
component
:: forall query m
. Monad m
=> System m
-> Capability m
-> Project.Capability m
-> H.Component HH.HTML query OverviewInput ProjectEvent m
component system caps pcaps = H.mkComponent
{ initialState
, render
, eval: H.mkEval $ H.defaultEval
{ handleAction = eval
, initialize = Just Initialize
}
} where
initialState :: OverviewInput -> OverviewState
initialState input =
{ selectedProject: input
}
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 <$> ["col-md-5", "text-muted", "text-center", "mx-auto"])]
[HH.text "Your project timeline"]
,HH.div_
[HH.slot _projectList unit (Project.projectListComponent system pcaps) unit (Just <<< ProjectSelected)]
,HH.div
[P.classes (ClassName <$> if isNothing st.selectedProject then ["collapse"] else [])]
[]
]
]
eval :: OverviewAction -> H.HalogenM OverviewState OverviewAction Slots ProjectEvent m Unit
eval action = do
case action of
Initialize -> do
pure unit
Invite _ -> do
pure unit
ProjectSelected p -> do
currentProject <- H.gets (_.selectedProject)
when (any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject) $ do
H.raise (ProjectChange p)
H.modify_ (_ { selectedProject = Just p })
apiCapability :: Capability Aff
apiCapability = { }
mockCapability :: Capability Aff
mockCapability = { }
newtype ProjectId = ProjectId UUID
derive instance projectIdEq :: Eq ProjectId
derive instance projectIdNewtype :: Newtype ProjectId _
pidStr :: ProjectId -> String
pidStr (ProjectId uuid) = toString uuid
newtype Project' date = Project'
{ projectId :: ProjectId
, projectName :: String
, inceptionDate :: date
, initiator :: UUID
}
derive instance newtypeProject :: Newtype (Project' a) _
type Project = Project' DateTime
instance decodeJsonProject :: DecodeJson (Project' String) where
decodeJson json = do
x <- decodeJson json
project <- x .: "project"
projectIdStr <- x .: "projectId"
projectId <- ProjectId <$> (note "Failed to decode project UUID" $ parseUUID projectIdStr)
projectName <- project .: "projectName"
inceptionDate <- project .: "inceptionDate"
initiatorStr <- project .: "initiator"
initiator <- note "Failed to decode initiator UUID" $ parseUUID initiatorStr
pure $ Project' { projectId, projectName, inceptionDate, initiator }
import Aftok.Project (Project, Project'(..), ProjectId) --, pidStr)
import Aftok.Types (System)
import Aftok.Types
( System,
ProjectEvent(..),
Project,
Project'(..),
ProjectId
)
when (oldActive && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
(traverse_ logEnd currentProject)
when (oldActive && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject) $ do
H.raise (ProjectChange p)
(traverse_ logEnd currentProject)
pidStr :: ProjectId -> String
pidStr (ProjectId uuid) = toString uuid
newtype Project' date = Project'
{ projectId :: ProjectId
, projectName :: String
, inceptionDate :: date
, initiator :: UUID
}
derive instance newtypeProject :: Newtype (Project' a) _
type Project = Project' DateTime
data ProjectEvent
= ProjectChange Project
instance decodeJsonProject :: DecodeJson (Project' String) where
decodeJson json = do
x <- decodeJson json
project <- x .: "project"
projectIdStr <- x .: "projectId"
projectId <- ProjectId <$> (note "Failed to decode project UUID" $ parseUUID projectIdStr)
projectName <- project .: "projectName"
inceptionDate <- project .: "inceptionDate"
initiatorStr <- project .: "initiator"
initiator <- note "Failed to decode initiator UUID" $ parseUUID initiatorStr
pure $ Project' { projectId, projectName, inceptionDate, initiator }
type NavItem =
{ label :: String
, path :: String
}
navItem :: forall a s m. NavItem -> H.ComponentHTML a s m
navItem ni =
HH.li
[P.classes (ClassName <$> ["nav-item"]) ]
[ HH.a
[ P.classes (ClassName <$> ["nav-link"])
, P.href ("#" <> ni.path)
]
[ HH.text ni.label ]
]