other -> throwError $ Error { status: Just other, message: r.statusText }
parseDatedResponseMay ::
  forall t.
  Traversable t =>
  DecodeJson (t String) =>
  Either AJAX.Error (Response Json) ->
  ExceptT APIError Effect (Maybe (t Instant))
parseDatedResponseMay = case _ of
  Left err -> throwError $ Error { status: Nothing, message: printError err }
  Right r -> case r.status of
    StatusCode 403 -> throwError $ Forbidden
    StatusCode 404 -> pure Nothing
    StatusCode 200 -> withExceptT (ParseFailure r.body) $ Just <<< map fromDateTime <$> decodeDatedJson r.body

import Control.Monad.Except.Trans (ExceptT, runExceptT, except, withExceptT)
import Control.Monad.Error.Class (throwError)
import Data.Argonaut.Core (Json)

import Control.Monad.Except.Trans (runExceptT)
-- import Control.Monad.Except.Trans (ExceptT, runExceptT, except, withExceptT)
-- import Control.Monad.Error.Class (throwError)
-- import Data.Argonaut.Core (Json)

import Data.Bifunctor (lmap)

-- import Data.Bifunctor (lmap)

import Data.Either (Either(..), note)
import Data.Maybe (Maybe(..))

import Data.DateTime.Instant (toDateTime)
import Data.Either (Either(..))
import Data.Foldable (class Foldable, foldMapDefaultR)

import Data.Rational (Rational)
import Data.Time.Duration (Hours, Days)
import Data.Traversable (traverse)
import Data.UUID (parseUUID)
import Effect (Effect)

import Data.Rational (Rational, (%))
import Data.Time.Duration (Hours(..), Days(..))
import Data.Traversable (class Traversable, traverse)
-- import Effect (Effect)

import Affjax (get, printError)
import Affjax.StatusCode (StatusCode(..))

import Affjax (get)

  ( UserId(..)
  , ProjectId(..)

  ( UserId
  , ProjectId

  ( APIError(..) )
import Aftok.Api.Json (parseDate)

  ( APIError )
import Aftok.Api.Json 
  ( decompose
  , parseDatedResponse
  )
data DepreciationFn
  = LinearDepreciation { undep :: Days, dep :: Days }
instance decodeDepreciationFn :: DecodeJson DepreciationFn where
  decodeJson json = do
    x <- decodeJson json
    dtype <- x .: "type"
    args <- x .: "arguments"
    case dtype of
      "LinearDepreciation" -> do
        undep <- Days <$> args .: "undep"
        dep <- Days <$> args .: "dep"
        pure $ LinearDepreciation { undep, dep }
      other -> Left $ "Unrecognized depreciation function: " <> other

  , depFn :: DepreciationFn

derive instance newtypeProject :: Newtype (Project' a) _

derive instance projectNewtype :: Newtype (Project' a) _
derive instance projectFunctor :: Functor Project'
instance projectFoldable :: Foldable Project' where
  foldr f b (Project' p) = f (p.inceptionDate) b
  foldl f b (Project' p) = f b (p.inceptionDate)
  foldMap = foldMapDefaultR
instance projectTraversable :: Traversable Project' where
  traverse f (Project' p) = Project' <<< (\b -> p { inceptionDate = b }) <$> f (p.inceptionDate)
  sequence = traverse identity

data DepreciationFn
  = LinearDepreciation { undep :: Days, dep :: Days }

instance decodeJsonProject :: DecodeJson (Project' String) where
  decodeJson json = do
    x <- decodeJson json
    project <- x .: "project"
    projectId <- x .: "projectId"
    projectName <- project .: "projectName"
    inceptionDate <- project .: "inceptionDate"
    initiator <- project .: "initiator"
    depFn <- project .: "depreciationFn"
    pure $ Project' { projectId, projectName, inceptionDate, initiator, depFn }

newtype ProjectUserData' date 
  = ProjectUserData'
  { userName :: String

newtype Contributor' date
  = Contributor'
  { userId :: UserId
  , handle :: String

  , totalContribution :: Hours
  , currentPayoutRatio :: Rational

  , timeDevoted :: Hours
  , revShare :: Rational

type ProjectUserData = ProjectUserData' DateTime

instance decodeJsonContributor :: DecodeJson (Contributor' String) where
  decodeJson json = do
    x <- decodeJson json
    userId <- x .: "userId"
    handle <- x .: "username"
    joinedOn <- x .: "joinedOn"
    timeDevoted <- Hours <$> x .: "timeDevoted"
    revShareObj <- x .: "revenueShare"
    num <- revShareObj .: "numerator"
    den <- revShareObj .: "denominator"
    let revShare = num % den
    pure $ Contributor' { userId, handle, joinedOn, timeDevoted, revShare }

  , depreciation :: DepreciationFn
  , contributors :: M.Map UserId (ProjectUserData' date)

  , contributors :: M.Map UserId (Contributor' date)

data ProjectEvent
  = ProjectChange Project

type ProjectDetailJson date = 
  { project :: Project' date
  , contributors :: Array (Contributor' date)
  }

instance decodeJsonProject :: DecodeJson (Project' String) where

instance decodeJsonProjectDetail :: DecodeJson (ProjectDetail' String) where

    projectIdStr <- x .: "projectId"
    projectId <- ProjectId <$> (note "Failed to decode project UUID" $ parseUUID projectIdStr)
    projectName <- project .: "projectName"
    inceptionDate <- project .: "inceptionDate"
    initiatorStr <- project .: "initiator"
    initiator <- UserId <$> (note "Failed to decode initiator UUID" $ parseUUID initiatorStr)
    pure $ Project' { projectId, projectName, inceptionDate, initiator }

    contributors <- x .: "contributors"
    pure $ ProjectDetail' { project, contributors }

newtype Member' date
  = Member'
  { userId :: UserId
  , handle :: String
  , joinedOn :: date
  , timeDevoted :: Hours
  , revShareFrac :: Rational
  }

  result <- get RF.json "/api/projects"
  EC.liftEffect <<< runExceptT
    $ case result of
        Left err -> throwError $ Error { status: Nothing, message: printError err }
        Right r -> case r.status of
          StatusCode 403 -> throwError Forbidden
          StatusCode 200 -> do
            records <- except $ lmap (ParseFailure r.body) (decodeJson r.body)
            traverse parseProject records
          other -> throwError $ Error { status: Just other, message: r.statusText }

  response <- get RF.json "/api/projects"
  EC.liftEffect 
    <<< runExceptT
    <<< map decompose
    <<< map (map toDateTime)
    $ parseDatedResponse response

parseProject :: Json -> ExceptT APIError Effect Project
parseProject json = do
  Project' p <- except <<< lmap (ParseFailure json) $ decodeJson json
  pdate <- withExceptT (ParseFailure json) $ parseDate p.inceptionDate
  pure $ Project' (p { inceptionDate = pdate })

-- getProjectDetail :: ProjectId -> Aff (Maybe ProjectDetail)
-- getProjectDetail pid = do
--   response <- get RF.json ("/api/user/projects/" <> pidStr pid)
--   EC.liftEffect
--    <<< map (\dt -> ProjectDetail' { 
--              project: dt.project, 
--              contributors: M.fromFoldable $ map (\c -> (Tuple c.userId c)) dt.contributors
--            })
--    $ parsed

import Data.DateTime (date)

import Data.DateTime (DateTime, date)

  (Project, Project'(..), ProjectEvent(..), ProjectDetail, ProjectDetail'(..)

  (Project, Project'(..), ProjectDetail, ProjectDetail'(..)

  , ProjectUserData'(..)
  , ProjectUserData

  , Contributor'(..)

  = forall query. H.Slot query ProjectEvent id

  = forall query. H.Slot query ProjectList.Event id

  H.Component HH.HTML query OverviewInput ProjectEvent m

  H.Component HH.HTML query OverviewInput ProjectList.Event m

          [ HH.slot _projectList unit (ProjectList.component system pcaps) st.selectedProject (Just <<< ProjectSelected) ]

          [ HH.slot 
              _projectList 
              unit 
              (ProjectList.component system pcaps) 
              st.selectedProject 
              (Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected p)) 
          ]

           depreciationCols detail.depreciation <>
           [ colmd2 ((\(ProjectUserData' p) -> p.userName) <$> M.lookup project.initiator detail.contributors)

           depreciationCols project.depFn <>
           [ colmd2 ((\(Contributor' p) -> p.handle) <$> M.lookup project.initiator detail.contributors)

  contributorCols :: ProjectUserData -> H.ComponentHTML OverviewAction Slots m
  contributorCols (ProjectUserData' pud) = 
    let pct = maybe "N/A" (\f -> F.toString (f * F.fromInt 100)) (F.fromNumber (R.toNumber pud.currentPayoutRatio) :: Maybe (F.Fixed F.P10000)) 

  contributorCols :: Contributor' DateTime -> H.ComponentHTML OverviewAction Slots m
  contributorCols (Contributor' pud) = 
    let pct = maybe "N/A" (\f -> F.toString (f * F.fromInt 100)) (F.fromNumber (R.toNumber pud.revShare) :: Maybe (F.Fixed F.P10000)) 

      [ colmd2 (Just pud.userName)

      [ colmd2 (Just pud.handle)

      , colmd2 (Just $ show (unwrap pud.totalContribution))

      , colmd2 (Just $ show (unwrap pud.timeDevoted))

  eval :: OverviewAction -> H.HalogenM OverviewState OverviewAction Slots ProjectEvent m Unit

  eval :: OverviewAction -> H.HalogenM OverviewState OverviewAction Slots ProjectList.Event m Unit

              H.raise (ProjectChange p)

              H.raise (ProjectList.ProjectChange p)

  setProjectDetail :: ProjectId -> H.HalogenM OverviewState OverviewAction Slots ProjectEvent m Unit

  setProjectDetail :: ProjectId -> H.HalogenM OverviewState OverviewAction Slots ProjectList.Event m Unit

          , depFn: LinearDepreciation { undep: Days 30.0, dep: Days 300.0 }

        , depreciation: LinearDepreciation { undep: Days 30.0, dep: Days 300.0 }
        , contributors: M.singleton uid $ ProjectUserData' 
          { userName: "Joe"

        , contributors: M.singleton uid $ Contributor' 
          { userId: uid
          , handle: "Joe"

          , totalContribution: Hours 100.0
          , currentPayoutRatio: 55 R.% 100

          , timeDevoted: Hours 100.0
          , revShare: 55 R.% 100

type Output 
  = Project

data Event
  = ProjectChange Project

  = forall query. H.Slot query Project id

  = forall query. H.Slot query Event id

  H.Component HH.HTML query Input Output m

  H.Component HH.HTML query Input Event m

  eval :: Action -> H.HalogenM CState Action () Project m Unit

  eval :: Action -> H.HalogenM CState Action () Event m Unit

      traverse_ H.raise (index projects (i - 1))

      traverse_ (H.raise <<< ProjectChange) (index projects (i - 1))

  , ProjectEvent(..)

  = forall query. H.Slot query ProjectEvent id

  = forall query. H.Slot query ProjectList.Event id

  H.Component HH.HTML query Input ProjectEvent m

  H.Component HH.HTML query Input ProjectList.Event m

              [ HH.slot _projectList unit (ProjectList.component system pcaps) st.selectedProject (Just <<< ProjectSelected) ]

              [ HH.slot 
                  _projectList 
                  unit 
                  (ProjectList.component system pcaps) 
                  st.selectedProject 
                  (Just <<< (\(ProjectList.ProjectChange p) -> ProjectSelected p)) 
              ]

  eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit

  eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots ProjectList.Event m Unit

        H.raise (ProjectChange p)

        H.raise (ProjectList.ProjectChange p)

  logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit

  logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectList.Event m Unit

  logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit

  logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectList.Event m Unit

  setStateForProject :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit

  setStateForProject :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectList.Event m Unit

import Data.Argonaut.Decode (class DecodeJson, decodeJson)

import Data.Either (note)

import Data.UUID (UUID, toString)

import Data.UUID (UUID, toString, parseUUID)

derive instance userIdNewtype :: Newtype UserId _

derive instance userIdNewtype :: Newtype UserId _

instance userIdDecodeJson :: DecodeJson UserId where
  decodeJson json = do
    uuidStr <- decodeJson json 
    UserId <$> (note "Failed to decode user UUID" $ parseUUID uuidStr)

derive instance projectIdOrd :: Ord ProjectId
derive instance projectIdNewtype :: Newtype ProjectId _

derive instance projectIdNewtype :: Newtype ProjectId _

instance projectIdDecodeJson :: DecodeJson ProjectId where
  decodeJson json = do
    uuidStr <- decodeJson json 
    ProjectId <$> (note "Failed to decode project UUID" $ parseUUID uuidStr)

import Aftok.Api.Project (Project, ProjectEvent(ProjectChange))

import Aftok.Api.Project (Project)

  | ProjectAction ProjectEvent

  | ProjectAction ProjectList.Event

    ProjectAction (ProjectChange p) -> H.modify_ (_ { selectedProject = Just p })

    ProjectAction (ProjectList.ProjectChange p) -> H.modify_ (_ { selectedProject = Just p })