Fork channel

Create a new channel as a copy of main.

Rename channel

Rename main to:

Delete channel

Delete main? This cannot be undone.

ProjectList.purs
module Aftok.ProjectList where

import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Array (index)
import Data.Either (Either(..))
import Data.Foldable (any)
import Data.Maybe (Maybe(..), isNothing)
import Data.Newtype (unwrap)
import Data.Traversable (traverse_)
import Effect.Aff (Aff)
import Aftok.Types
  ( System
  , ProjectId
  , pidStr
  )
import Aftok.Api.Types
  ( APIError
  )
import Aftok.Api.Project
  ( Project'(..)
  , Project
  , listProjects
  )
import Halogen as H
import Halogen.HTML as HH
import Halogen.HTML.Core (ClassName(..))
import Halogen.HTML.Events as E
import Halogen.HTML.Properties as P

type Input
  = Maybe ProjectId

data Query a
  = ProjectCreated ProjectId a

data Output
  = ProjectChange ProjectId

type Slot id
  = H.Slot Query Output id

type CState
  = { selectedPid :: Maybe ProjectId
    , projects :: Array Project
    }

data Action
  = Initialize (Maybe ProjectId)
  | Select Int

type Capability m
  = { listProjects :: m (Either APIError (Array Project))
    }

component ::
  forall m.
  Monad m =>
  System m ->
  Capability m ->
  H.Component HH.HTML Query Input Output m
component console caps =
  H.mkComponent
    { initialState
    , render
    , eval:
        H.mkEval
          $ H.defaultEval
              { handleAction = handleAction
              , handleQuery = handleQuery
              , initialize = Just (Initialize Nothing)
              , receive = Just <<< Initialize
              }
    }
  where
  initialState :: Input -> CState
  initialState input = { selectedPid: input, projects: [] }

  render :: forall slots. CState -> H.ComponentHTML Action slots m
  render st =
    HH.div
      [ P.classes (ClassName <$> [ "form-group" ]) ]
      [ HH.label
          [ P.classes (ClassName <$> [ "sr-only" ])
          , P.for "projectSelect"
          ]
          [ HH.text "Project" ]
      , HH.select
          [ P.classes (ClassName <$> [ "form-control" ])
          , P.id_ "projectSelect"
          , E.onSelectedIndexChange (Just <<< Select)
          ]
          ( [ HH.option [ P.selected (isNothing st.selectedPid), P.disabled true ] [ HH.text "Select a project" ] ]
              <> map renderOption st.projects
          )
      ]
    where
    renderOption (Project' p) =
      HH.option
        [ P.selected (any (p.projectId == _) st.selectedPid)
        , P.value $ pidStr p.projectId
        ]
        [ HH.text p.projectName ]

  handleQuery :: forall slots a. Query a -> H.HalogenM CState Action slots Output m (Maybe a)
  handleQuery = case _ of
    ProjectCreated pid a -> do
      handleAction (Initialize (Just pid))
      pure (Just a)

  handleAction :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
  handleAction = case _ of
    Initialize pidMay -> do
      res <- lift caps.listProjects
      case res of
        Left _ -> lift <<< console.error $ "Could not retrieve project list."
        Right projects -> H.modify_ (_ { projects = projects, selectedPid = pidMay })
    Select i -> do
      projects <- H.gets (_.projects)
      traverse_ projectSelected (index projects (i - 1))
    where
      projectSelected p = do
        let pid = (unwrap p).projectId
        H.modify_ (_ { selectedPid = Just pid })
        H.raise $ ProjectChange pid

apiCapability :: Capability Aff
apiCapability = { listProjects }

mockCapability :: forall m. Applicative m => Capability m
mockCapability = { listProjects: pure (Right []) }