.nvimrc

    "purty": {
      "version": "6.3.0",
      "resolved": "https://registry.npmjs.org/purty/-/purty-6.3.0.tgz",
      "integrity": "sha512-l70uQyz+t5GvCPzOorUbIhRX3oQW9i8Kgwr0LvS6nUq+UM4rMJdYcHazuupcLVInvNsbd290EnpjaRgAITt0dw=="
    },

    "purty": "^6.3.0",

type LoginRequest = { username :: String, password :: String }

type LoginRequest
  = { username :: String, password :: String }

  result <- post RF.ignore "/api/login" (Just <<< RB.Json <<< encodeJson $ { username: user, password : pass })

  result <- post RF.ignore "/api/login" (Just <<< RB.Json <<< encodeJson $ { username: user, password: pass })

       Left err -> log ("Login failed: " <> printError err)
       Right r  -> log ("Login status: " <> show r.status)
  pure $ case result of
    Left err -> LoginError { status: Nothing, message: printError err }
    Right r -> case r.status of
      StatusCode 403 -> LoginForbidden
      StatusCode 200 -> LoginOK
      other -> LoginError { status: Just other, message: r.statusText }

    Left err -> log ("Login failed: " <> printError err)
    Right r -> log ("Login status: " <> show r.status)
  pure
    $ case result of
        Left err -> LoginError { status: Nothing, message: printError err }
        Right r -> case r.status of
          StatusCode 403 -> LoginForbidden
          StatusCode 200 -> LoginOK
          other -> LoginError { status: Just other, message: r.statusText }

      pure $ case r.status of
        StatusCode 200 -> LoginOK
        StatusCode _   -> LoginForbidden

      pure
        $ case r.status of
            StatusCode 200 -> LoginOK
            StatusCode _ -> LoginForbidden

  | RecoverByZAddr String 

  | RecoverByZAddr String

type SignupRequest =
  { username :: String
  , password :: String
  , recoverBy :: RecoverBy
  , captchaToken :: String
  }

type SignupRequest
  = { username :: String
    , password :: String
    , recoverBy :: RecoverBy
    , captchaToken :: String
    }

signupRequest username password recoverBy captchaToken = 
  { username, password, recoverBy, captchaToken }

signupRequest username password recoverBy captchaToken = { username, password, recoverBy, captchaToken }

  result <- get RF.ignore ("/api/validate_zaddr?zaddr=" <> zaddr) 

  result <- get RF.ignore ("/api/validate_zaddr?zaddr=" <> zaddr)

    Right r | r.status == StatusCode 200 -> do
      pure ZAddrCheckValid

    Right r
      | r.status == StatusCode 200 -> do
        pure ZAddrCheckValid

  let signupJSON = encodeJson $ 
        { username: req.username
        , password: req.password
        , recoveryType: case req.recoverBy of
            RecoverByEmail _ -> "email"
            RecoverByZAddr _ -> "zaddr"
        , recoveryEmail: case req.recoverBy of
            RecoverByEmail email -> Just email
            RecoverByZAddr _     -> Nothing
        , recoveryZAddr: case req.recoverBy of
            RecoverByEmail _     -> Nothing
            RecoverByZAddr zaddr -> Just zaddr
        , captchaToken: req.captchaToken
        }

  let
    signupJSON =
      encodeJson
        $ { username: req.username
          , password: req.password
          , recoveryType:
              case req.recoverBy of
                RecoverByEmail _ -> "email"
                RecoverByZAddr _ -> "zaddr"
          , recoveryEmail:
              case req.recoverBy of
                RecoverByEmail email -> Just email
                RecoverByZAddr _ -> Nothing
          , recoveryZAddr:
              case req.recoverBy of
                RecoverByEmail _ -> Nothing
                RecoverByZAddr zaddr -> Just zaddr
          , captchaToken: req.captchaToken
          }

    Right r | r.status == StatusCode 200 -> do
      log "Registration succeeded!"
      pure SignupOK
    Right r | r.status == StatusCode 403 -> do
      log ("Registration failed: Capcha Invalid")
      pure CaptchaInvalid
    Right r | r.status == StatusCode 400 -> do
      log ("Registration failed: Z-Address Invalid")
      pure ZAddrInvalid

    Right r
      | r.status == StatusCode 200 -> do
        log "Registration succeeded!"
        pure SignupOK
    Right r
      | r.status == StatusCode 403 -> do
        log ("Registration failed: Capcha Invalid")
        pure CaptchaInvalid
    Right r
      | r.status == StatusCode 400 -> do
        log ("Registration failed: Z-Address Invalid")
        pure ZAddrInvalid

module Aftok.Api.Recaptcha 

module Aftok.Api.Recaptcha

    Nothing  -> getRecaptchaResponseInternal false ""

    Nothing -> getRecaptchaResponseInternal false ""

  StopEvent t  -> t

  StopEvent t -> t

    StopEvent a  -> StopEvent  <$> f a

    StopEvent a -> StopEvent <$> f a

  stop' <-  traverse (_ .: "eventTime") =<< ev .:? "stop"
  note "Only 'stop' and 'start' events are supported." $
    (StartEvent <$> start') <|>
    (StopEvent  <$> stop')

  stop' <- traverse (_ .: "eventTime") =<< ev .:? "stop"
  note "Only 'stop' and 'start' events are supported."
    $ (StartEvent <$> start')
    <|> (StopEvent <$> stop')

newtype KeyedEvent i = KeyedEvent

newtype KeyedEvent i
  = KeyedEvent

newtype Interval i = Interval

newtype Interval i
  = Interval

type TimeInterval = Interval Instant

type TimeInterval
  = Interval Instant

type TimeSpan = TimeSpan' DateTime

type TimeSpan
  = TimeSpan' DateTime

    After  a -> f a b

    After a -> f a b

    After  a -> f b a

    After a -> f b a

    After  a -> After <$> f a

    After a -> After <$> f a

  let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }

  let
    requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }

  liftEffect <<< runExceptT $ do
    kev <- withExceptT LogFailure $ parseDatedResponse response
    case event kev of
      StartEvent _ -> pure kev
      StopEvent _  -> throwError <<< Unexpected $ "Expected start event, got stop."

  liftEffect <<< runExceptT
    $ do
        kev <- withExceptT LogFailure $ parseDatedResponse response
        case event kev of
          StartEvent _ -> pure kev
          StopEvent _ -> throwError <<< Unexpected $ "Expected start event, got stop."

  let requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }

  let
    requestBody = Just <<< RB.Json <<< encodeJson $ { schemaVersion: "2.0" }

  liftEffect <<< runExceptT $ do
    kev <- withExceptT LogFailure $ parseDatedResponse response
    case event kev of
      StartEvent _ -> throwError <<< Unexpected $ "Expected stop event, got start."
      StopEvent _  -> pure kev

  liftEffect <<< runExceptT
    $ do
        kev <- withExceptT LogFailure $ parseDatedResponse response
        case event kev of
          StartEvent _ -> throwError <<< Unexpected $ "Expected stop event, got start."
          StopEvent _ -> pure kev

newtype ListIntervalsResponse a = ListIntervalsResponse

newtype ListIntervalsResponse a
  = ListIntervalsResponse

    let traverseCreditRow r' = ({ intervals: _ }) <$> traverse f r'.intervals
     in (ListIntervalsResponse <<< ({ workIndex: _ })) <$> traverse traverseCreditRow r.workIndex

    let
      traverseCreditRow r' = ({ intervals: _ }) <$> traverse f r'.intervals
    in
      (ListIntervalsResponse <<< ({ workIndex: _ })) <$> traverse traverseCreditRow r.workIndex

  let queryElements = case ts' of
        Before t -> ["before=" <> t, "limit=100"]
        During (Interval x) -> ["after=" <> x.start, "before=" <> x.end, "limit=100"]
        After  t -> ["after=" <> t, "limit=100"]

  let
    queryElements = case ts' of
      Before t -> [ "before=" <> t, "limit=100" ]
      During (Interval x) -> [ "after=" <> x.start, "before=" <> x.end, "limit=100" ]
      After t -> [ "after=" <> t, "limit=100" ]

      $ parseDatedResponse response

    $ parseDatedResponse response

      $ parseDatedResponse response

    $ parseDatedResponse response

  = Forbidden 

  = Forbidden

type LoginState =
  { username :: String
  , password :: String
  , loginError :: Maybe LoginError
  }

type LoginState
  = { username :: String
    , password :: String
    , loginError :: Maybe LoginError
    }

data LoginResult 

data LoginResult

type Slot id = forall query. H.Slot query LoginResult id

type Slot id
  = forall query. H.Slot query LoginResult id

type Capability m = 
  { login :: String -> String -> m LoginResponse
  , checkLogin :: m LoginResponse
  , logout :: m Unit
  }

type Capability m
  = { login :: String -> String -> m LoginResponse
    , checkLogin :: m LoginResponse
    , logout :: m Unit
    }

component 
  :: forall query input m
  .  Monad m
  => System m
  -> Capability m 
  -> H.Component HH.HTML query input LoginResult m
component system caps = H.mkComponent
  { initialState
  , render
  , eval: H.mkEval $ H.defaultEval { handleAction = eval }
  } where
    initialState :: input -> LoginState
    initialState _ = { username: "", password: "", loginError: Nothing }

component ::
  forall query input m.
  Monad m =>
  System m ->
  Capability m ->
  H.Component HH.HTML query input LoginResult m
component system caps =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval { handleAction = eval }
    }
  where
  initialState :: input -> LoginState
  initialState _ = { username: "", password: "", loginError: Nothing }

    render :: forall slots. LoginState -> H.ComponentHTML LoginAction slots m
    render st =
      Card.component $
        HH.div
          [ P.classes (ClassName <$> ["row", "no-gutters", "container"]) ]

  render :: forall slots. LoginState -> H.ComponentHTML LoginAction slots m
  render st =
    Card.component
      $ HH.div
          [ P.classes (ClassName <$> [ "row", "no-gutters", "container" ]) ]

            [ P.classes (ClassName <$> ["col-12", "col-md-6", "bg-cover", "card-img-left"])
            , CSS.style $ backgroundImage (url "/assets/img/photos/latch.jpg")
            ]
            [
              HH.div
                [ P.classes (ClassName <$> ["shape", "shape-right", "shape-fluid-y", "svg-shim", "text-white", "d-none", "d-md-block"])]
                [ HH.img [ P.src "/assets/img/shapes/curves/curve-4.svg" ]]
            ]

              [ P.classes (ClassName <$> [ "col-12", "col-md-6", "bg-cover", "card-img-left" ])
              , CSS.style $ backgroundImage (url "/assets/img/photos/latch.jpg")
              ]
              [ HH.div
                  [ P.classes (ClassName <$> [ "shape", "shape-right", "shape-fluid-y", "svg-shim", "text-white", "d-none", "d-md-block" ]) ]
                  [ HH.img [ P.src "/assets/img/shapes/curves/curve-4.svg" ] ]
              ]

            [ P.classes (ClassName <$> ["col-12", "col-md-6"]) ]
            [ HH.div
              [ P.classes (ClassName <$> ["card-body"]) ]
              [ HH.h2
                [ P.classes (ClassName <$> ["mb-0", "font-weight-bold", "text-center"])]
                [ HH.text "Sign In"]
              , HH.form
                [ P.classes (ClassName <$> ["mb-6"])
                , E.onSubmit (Just <<< Login)
                ]
                [ HH.div
                  [ P.classes (ClassName <$> ["form-group"])]
                  [ HH.label
                    [ P.classes (ClassName <$> ["sr-only"])
                    , P.for "modalSigninHorizontalUsername"
                    ]
                    [ HH.text "Username" ]
                  , HH.input
                    [ P.type_ P.InputText
                    , P.classes (ClassName <$> ["form-control"])
                    , P.id_ "modalSigninHorizontalUsername"
                    , P.placeholder "Username"
                    , P.required true
                    , P.autofocus true
                    , P.value st.username
                    , E.onValueInput (Just <<< SetUsername)
                    ]

              [ P.classes (ClassName <$> [ "col-12", "col-md-6" ]) ]
              [ HH.div
                  [ P.classes (ClassName <$> [ "card-body" ]) ]
                  [ HH.h2
                      [ P.classes (ClassName <$> [ "mb-0", "font-weight-bold", "text-center" ]) ]
                      [ HH.text "Sign In" ]
                  , HH.form
                      [ P.classes (ClassName <$> [ "mb-6" ])
                      , E.onSubmit (Just <<< Login)
                      ]
                      [ HH.div
                          [ P.classes (ClassName <$> [ "form-group" ]) ]
                          [ HH.label
                              [ P.classes (ClassName <$> [ "sr-only" ])
                              , P.for "modalSigninHorizontalUsername"
                              ]
                              [ HH.text "Username" ]
                          , HH.input
                              [ P.type_ P.InputText
                              , P.classes (ClassName <$> [ "form-control" ])
                              , P.id_ "modalSigninHorizontalUsername"
                              , P.placeholder "Username"
                              , P.required true
                              , P.autofocus true
                              , P.value st.username
                              , E.onValueInput (Just <<< SetUsername)
                              ]
                          ]
                      , HH.div
                          [ P.classes (ClassName <$> [ "form-group" ]) ]
                          [ HH.label
                              [ P.classes (ClassName <$> [ "sr-only" ])
                              , P.for "modalSigninHorizontalPassword"
                              ]
                              [ HH.text "Password" ]
                          , HH.input
                              [ P.type_ P.InputPassword
                              , P.classes (ClassName <$> [ "form-control" ])
                              , P.id_ "modalSigninHorizontalPassword"
                              , P.placeholder "Password"
                              , P.required true
                              , P.value st.password
                              , E.onValueInput (Just <<< SetPassword)
                              ]
                          ]
                      , case st.loginError of
                          Nothing -> HH.div_ []
                          Just err ->
                            let
                              message = case err of
                                Forbidden -> "Login failed. Check your username and password."
                                ServerError -> "Login failed due to an internal error. Please contact support."
                            in
                              HH.div
                                [ P.classes (ClassName <$> [ "alert alert-danger" ]) ]
                                [ HH.text message ]
                      , HH.button
                          [ P.classes (ClassName <$> [ "btn", "btn-block", "btn-primary" ]) ]
                          [ HH.text "Sign in" ]
                      ]

                , HH.div
                  [ P.classes (ClassName <$> ["form-group"])]
                  [ HH.label
                    [ P.classes (ClassName <$> ["sr-only"])
                    , P.for "modalSigninHorizontalPassword"
                    ]
                    [ HH.text "Password" ]
                  , HH.input
                    [ P.type_ P.InputPassword
                    , P.classes (ClassName <$> ["form-control"])
                    , P.id_ "modalSigninHorizontalPassword"
                    , P.placeholder "Password"
                    , P.required true
                    , P.value st.password
                    , E.onValueInput (Just <<< SetPassword)
                    ]

              , HH.p
                  [ P.classes (ClassName <$> [ "mb-0", "font-size-sm", "text-center", "text-muted" ]) ]
                  [ HH.text "Need an account? "
                  , HH.a
                      [ P.href "#signup" ]
                      [ HH.text "Sign up" ]

                , case st.loginError of
                    Nothing ->
                      HH.div_ []
                    Just err -> 
                      let message = case err of
                            Forbidden -> "Login failed. Check your username and password."
                            ServerError -> "Login failed due to an internal error. Please contact support."
                       in HH.div
                            [ P.classes (ClassName <$> ["alert alert-danger"]) ]
                            [ HH.text message ]
                , HH.button
                  [ P.classes (ClassName <$> ["btn", "btn-block", "btn-primary"]) ]
                  [ HH.text "Sign in" ]
                ]

              , HH.p  
                [ P.classes (ClassName <$> ["mb-0", "font-size-sm", "text-center", "text-muted"]) ]
                [ HH.text "Need an account? " 
                , HH.a 
                  [ P.href "#signup" ]
                  [ HH.text "Sign up" ]
                ]
            ]

    eval :: LoginAction -> H.HalogenM LoginState LoginAction () LoginResult m Unit
    eval = case _ of
      SetUsername user -> H.modify_ (_ { username = user })
      SetPassword pass -> H.modify_ (_ { password = pass })
      Login ev -> do
        lift $ system.preventDefault ev
        user <- H.gets (_.username)
        pass <- H.gets (_.password)
        response <- lift (caps.login user pass)
        case response of
          LoginOK        -> H.raise (LoginComplete { username: user })
          LoginForbidden -> H.modify_ (_ { loginError = Just Forbidden })
          LoginError _   -> H.modify_ (_ { loginError = Just ServerError })

  eval :: LoginAction -> H.HalogenM LoginState LoginAction () LoginResult m Unit
  eval = case _ of
    SetUsername user -> H.modify_ (_ { username = user })
    SetPassword pass -> H.modify_ (_ { password = pass })
    Login ev -> do
      lift $ system.preventDefault ev
      user <- H.gets (_.username)
      pass <- H.gets (_.password)
      response <- lift (caps.login user pass)
      case response of
        LoginOK -> H.raise (LoginComplete { username: user })
        LoginForbidden -> H.modify_ (_ { loginError = Just Forbidden })
        LoginError _ -> H.modify_ (_ { loginError = Just ServerError })

mockCapability = 
  { login: \_ _ -> pure LoginOK 

mockCapability =
  { login: \_ _ -> pure LoginOK

type OverviewInput = Maybe Project

type OverviewInput
  = Maybe Project

type OverviewState =
  { selectedProject :: Maybe Project
  }

type OverviewState
  = { selectedProject :: Maybe Project
    }

type Slot id = forall query. H.Slot query ProjectEvent id

type Slot id
  = forall query. H.Slot query ProjectEvent id

type Slots =
  ( projectList :: Project.ProjectListSlot Unit
  )

type Slots
  = ( projectList :: Project.ProjectListSlot Unit
    )

type Capability (m :: Type -> Type) =
  { 
  }

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
      }

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) st.selectedProject (Just <<< ProjectSelected)]
          ,HH.div
            [P.classes (ClassName <$> if isNothing st.selectedProject then ["collapse"] else [])]
            []

  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) st.selectedProject (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

  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 (all (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
          $ do
              H.raise (ProjectChange p)
              H.modify_ (_ { selectedProject = Just p })

        Invite _ -> do
          pure unit
        ProjectSelected p -> do
          currentProject <- H.gets (_.selectedProject)
          
          when (all (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject) $ do
            H.raise (ProjectChange p) 
            H.modify_ (_ { selectedProject = Just p })

apiCapability = { }

apiCapability = {}

mockCapability = { }

mockCapability = {}

import Aftok.Types 

import Aftok.Types

type ProjectInput = Maybe Project

type ProjectInput
  = Maybe Project

type ProjectCState =
  { selectedProject :: Maybe Project
  , projects :: Array Project
  }

type ProjectCState
  = { selectedProject :: Maybe Project
    , projects :: Array Project
    }

data ProjectAction 

data ProjectAction

type ProjectListSlot id = forall query. H.Slot query Project id

type ProjectListSlot id
  = forall query. H.Slot query Project id

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

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

projectListComponent
  :: forall query input m
  .  Monad m
  => System m
  -> Capability m 
  -> H.Component HH.HTML query ProjectInput Project m
projectListComponent console caps = H.mkComponent
  { initialState
  , render
  , eval: H.mkEval $ H.defaultEval 
      { handleAction = eval
      , initialize = Just Initialize 
      }
  } where
    initialState :: ProjectInput -> ProjectCState
    initialState input = { selectedProject: input, projects: [] }

projectListComponent ::
  forall query input m.
  Monad m =>
  System m ->
  Capability m ->
  H.Component HH.HTML query ProjectInput Project m
projectListComponent console caps =
  H.mkComponent
    { initialState
    , render
    , eval:
        H.mkEval
          $ H.defaultEval
              { handleAction = eval
              , initialize = Just Initialize
              }
    }
  where
  initialState :: ProjectInput -> ProjectCState
  initialState input = { selectedProject: input, projects: [] }

    render :: forall slots. ProjectCState -> H.ComponentHTML ProjectAction slots m
    render st = 
      HH.div
        [P.classes (ClassName <$> ["form-group"])]
        [ HH.label
          [ P.classes (ClassName <$> ["sr-only"])

  render :: forall slots. ProjectCState -> H.ComponentHTML ProjectAction slots m
  render st =
    HH.div
      [ P.classes (ClassName <$> [ "form-group" ]) ]
      [ HH.label
          [ P.classes (ClassName <$> [ "sr-only" ])

        , HH.select
          [P.classes (ClassName <$> ["form-control"])
          ,P.id_ "projectSelect"
          ,E.onSelectedIndexChange (Just <<< Select)

      , HH.select
          [ P.classes (ClassName <$> [ "form-control" ])
          , P.id_ "projectSelect"
          , E.onSelectedIndexChange (Just <<< Select)

          ( [HH.option [P.selected (isNothing st.selectedProject), P.disabled true] [HH.text "Select a project"]] 
            <> map renderOption st.projects

          ( [ HH.option [ P.selected (isNothing st.selectedProject), P.disabled true ] [ HH.text "Select a project" ] ]
              <> map renderOption st.projects

      ]
    where
    renderOption (Project' p) =
      HH.option
        [ P.selected (any (\(Project' p') -> p'.projectId == p.projectId) st.selectedProject)
        , P.value $ pidStr p.projectId

      where
        renderOption (Project' p) =
          HH.option 
            [ P.selected (any (\(Project' p') -> p'.projectId == p.projectId) st.selectedProject)
            , P.value $ pidStr p.projectId
            ]
            [HH.text p.projectName]

        [ HH.text p.projectName ]

    eval :: ProjectAction -> H.HalogenM ProjectCState ProjectAction () Project m Unit
    eval = case _ of
      Initialize -> do
        res <- lift caps.listProjects
        case res of 
            Left _ -> lift <<< console.error $ "Could not retrieve project list."
            Right projects -> H.modify_ (_ { projects = projects })

  eval :: ProjectAction -> H.HalogenM ProjectCState ProjectAction () Project m Unit
  eval = case _ of
    Initialize -> do
      res <- lift caps.listProjects
      case res of
        Left _ -> lift <<< console.error $ "Could not retrieve project list."
        Right projects -> H.modify_ (_ { projects = projects })
    Select i -> do
      projects <- H.gets (_.projects)
      lift <<< console.log $ "Selected project index " <> show i
      traverse_ H.raise (index projects (i - 1))

      Select i -> do
        projects <- H.gets (_.projects)
        lift <<< console.log $ "Selected project index " <> show i
        traverse_ H.raise (index projects (i - 1))

  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 }

  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 }

type SignupState =
  { username :: Maybe String
  , password :: Maybe String
  , passwordConfirm :: Maybe String
  , recoveryType :: RecoveryType
  , recoveryEmail :: Maybe String
  , recoveryZAddr :: Maybe String
  , signupErrors :: Array SignupError
  }

type SignupState
  = { username :: Maybe String
    , password :: Maybe String
    , passwordConfirm :: Maybe String
    , recoveryType :: RecoveryType
    , recoveryEmail :: Maybe String
    , recoveryZAddr :: Maybe String
    , signupErrors :: Array SignupError
    }

data SignupResult 
  = SignupComplete String 

data SignupResult
  = SignupComplete String

type Slot id = forall query. H.Slot query SignupResult id

type Slot id
  = forall query. H.Slot query SignupResult id

type Capability m = 
  { checkUsername :: String -> m Acc.UsernameCheckResponse
  , checkZAddr :: String -> m Acc.ZAddrCheckResponse
  , signup :: SignupRequest -> m SignupResponse
  , getRecaptchaResponse :: Maybe String -> m (Maybe String)
  }

type Capability m
  = { checkUsername :: String -> m Acc.UsernameCheckResponse
    , checkZAddr :: String -> m Acc.ZAddrCheckResponse
    , signup :: SignupRequest -> m SignupResponse
    , getRecaptchaResponse :: Maybe String -> m (Maybe String)
    }

type Config =
  { recaptchaKey :: String
  }

type Config
  = { recaptchaKey :: String
    }

component 
  :: forall query input m
  .  Monad m
  => System m
  -> Capability m 
  -> Config
  -> H.Component HH.HTML query input SignupResult m
component system caps conf = H.mkComponent
  { initialState
  , render
  , eval: H.mkEval $ H.defaultEval { handleAction = eval }
  } where
    initialState :: input -> SignupState
    initialState _ = 
      { username: Nothing
      , password: Nothing
      , passwordConfirm: Nothing
      , recoveryType: RecoveryEmail
      , recoveryEmail: Nothing
      , recoveryZAddr: Nothing
      , signupErrors: []
      }

component ::
  forall query input m.
  Monad m =>
  System m ->
  Capability m ->
  Config ->
  H.Component HH.HTML query input SignupResult m
component system caps conf =
  H.mkComponent
    { initialState
    , render
    , eval: H.mkEval $ H.defaultEval { handleAction = eval }
    }
  where
  initialState :: input -> SignupState
  initialState _ =
    { username: Nothing
    , password: Nothing
    , passwordConfirm: Nothing
    , recoveryType: RecoveryEmail
    , recoveryEmail: Nothing
    , recoveryZAddr: Nothing
    , signupErrors: []
    }

    render :: forall slots. SignupState -> H.ComponentHTML SignupAction slots m
    render st = 
      HH.section
        [ P.classes (ClassName <$> ["section-border", "border-primary"]) ]
        [ HH.div
          [ P.classes (ClassName <$> ["container", "d-flex", "flex-column"]) ]

  render :: forall slots. SignupState -> H.ComponentHTML SignupAction slots m
  render st =
    HH.section
      [ P.classes (ClassName <$> [ "section-border", "border-primary" ]) ]
      [ HH.div
          [ P.classes (ClassName <$> [ "container", "d-flex", "flex-column" ]) ]

            [ P.classes (ClassName <$> ["align-items-center", "pt-6"]) ]
            [ HH.h1 
              [ P.classes (ClassName <$> ["mb-0", "font-weight-bold", "text-center"]) ]
              [ HH.text "Sign up" ]
            , HH.p 
              [ P.classes (ClassName <$> ["text-center", "text-muted", "col-md-5", "mx-auto"]) ]
              [ HH.text "You can use either an email address or zcash payment address for account recovery." ]
            ]  

              [ P.classes (ClassName <$> [ "align-items-center", "pt-6" ]) ]
              [ HH.h1
                  [ P.classes (ClassName <$> [ "mb-0", "font-weight-bold", "text-center" ]) ]
                  [ HH.text "Sign up" ]
              , HH.p
                  [ P.classes (ClassName <$> [ "text-center", "text-muted", "col-md-5", "mx-auto" ]) ]
                  [ HH.text "You can use either an email address or zcash payment address for account recovery." ]
              ]

            [ P.classes (ClassName <$> ["row", "align-items-center", "justify-content-center", "no-gutters"]) ]
            [ HH.div
              [ P.classes (ClassName <$> ["col-12", "col-lg-4", "py-8", "py-md-0"]) ]
              [ HH.form 
                [ P.classes (ClassName <$> ["mb-6"]) 
                , E.onSubmit (Just <<< Signup)
                ]
                [ HH.div
                  [ P.classes (ClassName <$> ["form-group"]) ]
                  [ HH.label [ P.for "username" ] [ HH.text "Username" ]
                  , HH.input 
                    [ P.type_ P.InputText
                    , P.classes (ClassName <$> ["form-control"])
                    , P.id_ "username"
                    , P.placeholder "Choose a handle (username)"
                    , P.required true
                    , P.autofocus true
                    , P.value (fromMaybe "" st.username)
                    , E.onValueInput (Just <<< SetUsername)
                    ]
                  ]
                , HH.div
                  [ P.classes (ClassName <$> ["form-group"]) ]
                  [ HH.label [ P.for "password" ] [ HH.text "Password" ]
                  , HH.input 
                    [ P.type_ P.InputPassword
                    , P.classes (ClassName <$> ["form-control"])
                    , P.id_ "password"
                    , P.placeholder "Enter a unique password"
                    , P.required true
                    , P.value (fromMaybe "" st.password)
                    , E.onValueInput (Just <<< SetPassword)
                    ]
                  , HH.input 
                    [ P.type_ P.InputPassword
                    , P.classes (ClassName <$> ["form-control"])
                    , P.id_ "passwordConfirm"
                    , P.placeholder "Enter a unique password"
                    , P.required true
                    , P.value (fromMaybe "" st.passwordConfirm)
                    , E.onValueInput (Just <<< ConfirmPassword)
                    ]
                  ]
                , recoverySwitch st.recoveryType
                , recoveryField st
                , HH.div
                  [ P.classes (ClassName <$> ["form-group", "mb-3"]) ]
                  [ HH.div
                    [ P.classes (ClassName <$> ["g-recaptcha", "mx-auto"]) 
                    , P.attr (AttrName "data-sitekey") conf.recaptchaKey
                    ] []

              [ P.classes (ClassName <$> [ "row", "align-items-center", "justify-content-center", "no-gutters" ]) ]
              [ HH.div
                  [ P.classes (ClassName <$> [ "col-12", "col-lg-4", "py-8", "py-md-0" ]) ]
                  [ HH.form
                      [ P.classes (ClassName <$> [ "mb-6" ])
                      , E.onSubmit (Just <<< Signup)
                      ]
                      [ HH.div
                          [ P.classes (ClassName <$> [ "form-group" ]) ]
                          [ HH.label [ P.for "username" ] [ HH.text "Username" ]
                          , HH.input
                              [ P.type_ P.InputText
                              , P.classes (ClassName <$> [ "form-control" ])
                              , P.id_ "username"
                              , P.placeholder "Choose a handle (username)"
                              , P.required true
                              , P.autofocus true
                              , P.value (fromMaybe "" st.username)
                              , E.onValueInput (Just <<< SetUsername)
                              ]
                          ]
                      , HH.div
                          [ P.classes (ClassName <$> [ "form-group" ]) ]
                          [ HH.label [ P.for "password" ] [ HH.text "Password" ]
                          , HH.input
                              [ P.type_ P.InputPassword
                              , P.classes (ClassName <$> [ "form-control" ])
                              , P.id_ "password"
                              , P.placeholder "Enter a unique password"
                              , P.required true
                              , P.value (fromMaybe "" st.password)
                              , E.onValueInput (Just <<< SetPassword)
                              ]
                          , HH.input
                              [ P.type_ P.InputPassword
                              , P.classes (ClassName <$> [ "form-control" ])
                              , P.id_ "passwordConfirm"
                              , P.placeholder "Enter a unique password"
                              , P.required true
                              , P.value (fromMaybe "" st.passwordConfirm)
                              , E.onValueInput (Just <<< ConfirmPassword)
                              ]
                          ]
                      , recoverySwitch st.recoveryType
                      , recoveryField st
                      , HH.div
                          [ P.classes (ClassName <$> [ "form-group", "mb-3" ]) ]
                          [ HH.div
                              [ P.classes (ClassName <$> [ "g-recaptcha", "mx-auto" ])
                              , P.attr (AttrName "data-sitekey") conf.recaptchaKey
                              ]
                              []
                          ]
                      , HH.button
                          [ P.classes (ClassName <$> [ "btn", "btn-block", "btn-primary" ]) ]
                          [ HH.text "Sign up" ]
                      ]
                  , HH.p
                      [ P.classes (ClassName <$> [ "mb-0", "font-size-sm", "text-center", "text-muted" ]) ]
                      [ HH.text "Already have an account? "
                      , HH.a
                          [ P.href "#login" ]
                          [ HH.text "Sign in" ]
                      ]

                , HH.button
                  [ P.classes (ClassName <$> ["btn", "btn-block", "btn-primary"]) ]
                  [ HH.text "Sign up" ]
                ]
              , HH.p  
                [ P.classes (ClassName <$> ["mb-0", "font-size-sm", "text-center", "text-muted"]) ]
                [ HH.text "Already have an account? " 
                , HH.a 
                  [ P.href "#login" ]
                  [ HH.text "Sign in" ]
                ]

            ]

        ]

      ]

    eval :: SignupAction -> H.HalogenM SignupState SignupAction () SignupResult m Unit
    eval = case _ of
      SetUsername user -> do
        ures <- lift $ caps.checkUsername user
        H.modify_ (_ { username = Just user })
        case ures of
          Acc.UsernameCheckOK    -> pure unit
          Acc.UsernameCheckTaken -> H.modify_ (_ { signupErrors = [UsernameTaken] })
      SetPassword pass -> do
        H.modify_ (_ { password = Just pass })
        confirm <- H.gets (_.passwordConfirm)
        when (any (notEq pass) confirm) (H.modify_ (_ { signupErrors = [PasswordMismatch] }))
           
      ConfirmPassword confirm -> do
        H.modify_ (_ { passwordConfirm = Just confirm })
        password <- H.gets (_.password)
        when (any (notEq confirm) password) (H.modify_ (_ { signupErrors = [PasswordMismatch] }))
      SetRecoveryType t -> H.modify_ (_ { recoveryType = t })
      SetRecoveryEmail email -> H.modify_ (_ { recoveryEmail = Just email })
      SetRecoveryZAddr addr -> do
        lift $ system.log "Switching to signin..."
        zres <- lift $ caps.checkZAddr addr
        H.modify_ (_ { recoveryZAddr = Just addr })
        case zres of
          Acc.ZAddrCheckValid -> pure unit
          Acc.ZAddrCheckInvalid -> H.modify_ (_ { signupErrors = [ZAddrInvalid] })
      Signin ev -> do 
        lift $ system.log "Switching to signin..."
        lift $ system.preventDefault (ME.toEvent ev)
        H.raise SigninNav

  eval :: SignupAction -> H.HalogenM SignupState SignupAction () SignupResult m Unit
  eval = case _ of
    SetUsername user -> do
      ures <- lift $ caps.checkUsername user
      H.modify_ (_ { username = Just user })
      case ures of
        Acc.UsernameCheckOK -> pure unit
        Acc.UsernameCheckTaken -> H.modify_ (_ { signupErrors = [ UsernameTaken ] })
    SetPassword pass -> do
      H.modify_ (_ { password = Just pass })
      confirm <- H.gets (_.passwordConfirm)
      when (any (notEq pass) confirm) (H.modify_ (_ { signupErrors = [ PasswordMismatch ] }))
    ConfirmPassword confirm -> do
      H.modify_ (_ { passwordConfirm = Just confirm })
      password <- H.gets (_.password)
      when (any (notEq confirm) password) (H.modify_ (_ { signupErrors = [ PasswordMismatch ] }))
    SetRecoveryType t -> H.modify_ (_ { recoveryType = t })
    SetRecoveryEmail email -> H.modify_ (_ { recoveryEmail = Just email })
    SetRecoveryZAddr addr -> do
      lift $ system.log "Switching to signin..."
      zres <- lift $ caps.checkZAddr addr
      H.modify_ (_ { recoveryZAddr = Just addr })
      case zres of
        Acc.ZAddrCheckValid -> pure unit
        Acc.ZAddrCheckInvalid -> H.modify_ (_ { signupErrors = [ ZAddrInvalid ] })
    Signin ev -> do
      lift $ system.log "Switching to signin..."
      lift $ system.preventDefault (ME.toEvent ev)
      H.raise SigninNav
    Signup ev -> do
      lift $ system.preventDefault ev
      recType <- H.gets (_.recoveryType)
      usernameV <- V <<< note [ UsernameRequired ] <$> H.gets (_.username)
      pwdFormV <- V <<< note [ PasswordRequired ] <$> H.gets (_.password)
      pwdConfV <- V <<< note [ ConfirmRequired ] <$> H.gets (_.passwordConfirm)
      recoveryType <- H.gets (_.recoveryType)
      recoveryV <- case recoveryType of
        RecoveryEmail -> V <<< note [ EmailRequired ] <<< map Acc.RecoverByEmail <$> H.gets (_.recoveryEmail)
        RecoveryZAddr -> V <<< note [ ZAddrRequired ] <<< map Acc.RecoverByZAddr <$> H.gets (_.recoveryZAddr)
      recapV <- lift $ V <<< note [ CaptchaError ] <$> caps.getRecaptchaResponse Nothing
      lift $ system.log "Sending signup request..."
      let
        reqV :: V (Array SignupError) Acc.SignupRequest
        reqV =
          signupRequest <$> usernameV
            <*> ( (eq <$> pwdFormV <*> pwdConfV)
                  `andThen`
                    (if _ then pwdFormV else invalid [ PasswordMismatch ])
              )
            <*> recoveryV
            <*> recapV
      case toEither reqV of
        Left errors -> do
          lift $ system.log "Got signup HTTP error."
          H.modify_ (_ { signupErrors = errors })
        Right req -> do
          response <- lift (caps.signup req)
          lift <<< system.log $ "Got signup response " <> show response
          case response of
            Acc.SignupOK -> H.raise (SignupComplete $ req.username)
            Acc.CaptchaInvalid -> H.modify_ (_ { signupErrors = [ CaptchaError ] })
            Acc.ZAddrInvalid -> H.modify_ (_ { signupErrors = [ ZAddrInvalid ] })
            Acc.UsernameTaken -> H.modify_ (_ { signupErrors = [ UsernameTaken ] })
            Acc.ServiceError c m -> H.modify_ (_ { signupErrors = [ APIError { status: c, message: m } ] })

      Signup ev -> do
        lift $ system.preventDefault ev
        recType <- H.gets (_.recoveryType)
        usernameV <- V <<< note [UsernameRequired] <$> H.gets (_.username)
        pwdFormV  <- V <<< note [PasswordRequired] <$> H.gets (_.password)
        pwdConfV  <- V <<< note [ConfirmRequired ] <$> H.gets (_.passwordConfirm)
        recoveryType <- H.gets (_.recoveryType)
        recoveryV <- case recoveryType of
          RecoveryEmail -> 
            V <<< note [EmailRequired] <<< map Acc.RecoverByEmail <$> H.gets (_.recoveryEmail)
          RecoveryZAddr -> 
            V <<< note [ZAddrRequired] <<< map Acc.RecoverByZAddr <$> H.gets (_.recoveryZAddr)
        recapV <- lift $ V <<< note [CaptchaError] <$> caps.getRecaptchaResponse Nothing
        lift $ system.log "Sending signup request..."
        let reqV :: V (Array SignupError) Acc.SignupRequest
            reqV = signupRequest <$> usernameV
                                 <*> ((eq <$> pwdFormV <*> pwdConfV) `andThen` 
                                      (if _ then pwdFormV else invalid [PasswordMismatch]))
                                 <*> recoveryV
                                 <*> recapV
        case toEither reqV of
          Left errors -> do
            lift $ system.log "Got signup HTTP error."
            H.modify_ (_ { signupErrors = errors })
          Right req -> do
            response <- lift (caps.signup req)
            lift <<< system.log $ "Got signup response " <> show response
            case response of
              Acc.SignupOK         -> H.raise (SignupComplete $ req.username)
              Acc.CaptchaInvalid   -> H.modify_ (_ { signupErrors = [CaptchaError] })
              Acc.ZAddrInvalid     -> H.modify_ (_ { signupErrors = [ZAddrInvalid] })
              Acc.UsernameTaken    -> H.modify_ (_ { signupErrors = [UsernameTaken] })
              Acc.ServiceError c m -> H.modify_ (_ { signupErrors = [APIError { status: c, message: m }]})

recoverySwitch rt = 

recoverySwitch rt =

    [ P.classes (ClassName <$> ["form-group", "mb-3"]) ]
    [ HH.label 
      [ P.for "recoverySwitch" ] 
      [ HH.text "Choose a recovery method" ]

    [ P.classes (ClassName <$> [ "form-group", "mb-3" ]) ]
    [ HH.label
        [ P.for "recoverySwitch" ]
        [ HH.text "Choose a recovery method" ]

      [ P.classes (ClassName <$> ["form-group", "mb-3"]) 
      , CSS.style do
          display flex
          flexFlow row nowrap
      ]
      [ HH.span 
        [ P.classes (ClassName <$> [ if rt == RecoveryEmail then "text-success" else "text-muted"]) ] 
        [ HH.text "Email" ]
      , HH.div
        [ P.classes (ClassName <$> ["custom-control", "custom-switch", "custom-switch-light", "mx-3"]) ]
        [ HH.input 
          [ P.type_ P.InputCheckbox
          , P.classes (ClassName <$> ["custom-control-input"])
          , P.id_ "recoverySwitch"
          , E.onChecked (\b -> Just <<< SetRecoveryType $ if b then RecoveryZAddr else RecoveryEmail)
          ]
        , HH.label [ P.classes (ClassName <$> [ "custom-control-label" ]), P.for "recoverySwitch" ] []

        [ P.classes (ClassName <$> [ "form-group", "mb-3" ])
        , CSS.style do
            display flex
            flexFlow row nowrap
        ]
        [ HH.span
            [ P.classes (ClassName <$> [ if rt == RecoveryEmail then "text-success" else "text-muted" ]) ]
            [ HH.text "Email" ]
        , HH.div
            [ P.classes (ClassName <$> [ "custom-control", "custom-switch", "custom-switch-light", "mx-3" ]) ]
            [ HH.input
                [ P.type_ P.InputCheckbox
                , P.classes (ClassName <$> [ "custom-control-input" ])
                , P.id_ "recoverySwitch"
                , E.onChecked (\b -> Just <<< SetRecoveryType $ if b then RecoveryZAddr else RecoveryEmail)
                ]
            , HH.label [ P.classes (ClassName <$> [ "custom-control-label" ]), P.for "recoverySwitch" ] []
            ]
        , HH.span
            [ P.classes (ClassName <$> [ if rt == RecoveryZAddr then "text-success" else "text-muted" ]) ]
            [ HH.text "Z-Address" ]

      , HH.span 
        [ P.classes (ClassName <$> [if rt == RecoveryZAddr then "text-success" else "text-muted"]) ] 
        [ HH.text "Z-Address" ]
      ]

  RecoveryEmail -> 
    HH.div 

  RecoveryEmail ->
    HH.div

      , HH.input 
        [ P.type_ P.InputEmail
        , P.classes (ClassName <$> ["form-control"])
        , P.id_ "email"
        , P.placeholder "name@address.com"
        , P.value (fromMaybe "" st.recoveryEmail)
        , E.onValueInput (Just <<< SetRecoveryEmail)
        ]

      , HH.input
          [ P.type_ P.InputEmail
          , P.classes (ClassName <$> [ "form-control" ])
          , P.id_ "email"
          , P.placeholder "name@address.com"
          , P.value (fromMaybe "" st.recoveryEmail)
          , E.onValueInput (Just <<< SetRecoveryEmail)
          ]

    HH.div 

    HH.div

      [ HH.label 
        [ P.for "zaddr" ] 
        [ HH.text "Zcash Shielded Address" 
        , HH.a 
          [ P.attr (AttrName "data-toggle") "modal" 
          , P.href "#modalAboutZAddr"

      [ HH.label
          [ P.for "zaddr" ]
          [ HH.text "Zcash Shielded Address"
          , HH.a
              [ P.attr (AttrName "data-toggle") "modal"
              , P.href "#modalAboutZAddr"
              ]
              [ HH.img [ P.src "/assets/img/icons/duotone-icons/Code/Info-circle.svg" ]
              ]

          [ HH.img [ P.src "/assets/img/icons/duotone-icons/Code/Info-circle.svg" ]

      , HH.input
          [ P.type_ P.InputText
          , P.classes (ClassName <$> [ "form-control" ])
          , P.id_ "email"
          , P.placeholder "Enter a Zcash shielded address"
          , P.value (fromMaybe "" st.recoveryZAddr)
          , E.onValueInput (Just <<< SetRecoveryZAddr)

        ]
      , HH.input 
        [ P.type_ P.InputText
        , P.classes (ClassName <$> ["form-control"])
        , P.id_ "email"
        , P.placeholder "Enter a Zcash shielded address"
        , P.value (fromMaybe "" st.recoveryZAddr)
        , E.onValueInput (Just <<< SetRecoveryZAddr)
        ]

apiCapability = 

apiCapability =

  , getRecaptchaResponse: liftEffect <<< getRecaptchaResponse 

  , getRecaptchaResponse: liftEffect <<< getRecaptchaResponse

mockCapability = 

mockCapability =

  , getRecaptchaResponse: liftEffect <<< getRecaptchaResponse 

  , getRecaptchaResponse: liftEffect <<< getRecaptchaResponse

import Aftok.Api.Timeline 
  ( TimelineError, 
    Event(..),
    Interval(..), 
    TimeInterval, 
    KeyedEvent,
    TimeSpan, 
    start, end, interval,
    event, eventTime, keyedEvent
    )

import Aftok.Api.Timeline
  ( TimelineError
  , Event(..)
  , Interval(..)
  , TimeInterval
  , KeyedEvent
  , TimeSpan
  , start
  , end
  , interval
  , event
  , eventTime
  , keyedEvent
  )

import Aftok.Types 
  ( System, 
    ProjectEvent(..), 
    Project, 
    Project'(..), 
    ProjectId
    )

import Aftok.Types
  ( System
  , ProjectEvent(..)
  , Project
  , Project'(..)
  , ProjectId
  )

type TimelineLimits =
  { bounds  :: TimeInterval
  , current :: Instant
  }

type TimelineLimits
  = { bounds :: TimeInterval
    , current :: Instant
    }

type DayIntervals = 
  { dayBounds :: TimeInterval
  , loggedIntervals :: Array (Interval TimelineEvent)
  }

type DayIntervals
  = { dayBounds :: TimeInterval
    , loggedIntervals :: Array (Interval TimelineEvent)
    }

type History = M.Map Date DayIntervals

type History
  = M.Map Date DayIntervals

type TimelineInput = Maybe Project

type TimelineInput
  = Maybe Project

type TimelineState =
  { selectedProject :: Maybe Project
  , history :: M.Map Date DayIntervals
  , active  :: Maybe (Interval TimelineEvent)
  , activeHistory :: M.Map Date DayIntervals
  }

type TimelineState
  = { selectedProject :: Maybe Project
    , history :: M.Map Date DayIntervals
    , active :: Maybe (Interval TimelineEvent)
    , activeHistory :: M.Map Date DayIntervals
    }

type Slot id = forall query. H.Slot query ProjectEvent id

type Slot id
  = forall query. H.Slot query ProjectEvent id

type Slots =
  ( projectList :: Project.ProjectListSlot Unit
  )

type Slots
  = ( projectList :: Project.ProjectListSlot Unit
    )

type Capability m =
  { timer :: EventSource m TimelineAction
  , logStart :: ProjectId -> m (Either TimelineError (KeyedEvent Instant))
  , logEnd :: ProjectId -> m (Either TimelineError (KeyedEvent Instant))
  , listIntervals :: ProjectId -> TimeSpan -> m (Either TimelineError (Array (Interval (KeyedEvent Instant))))
  , getLatestEvent :: ProjectId -> m (Either TimelineError (Maybe (KeyedEvent Instant)))
  }

type Capability m
  = { timer :: EventSource m TimelineAction
    , logStart :: ProjectId -> m (Either TimelineError (KeyedEvent Instant))
    , logEnd :: ProjectId -> m (Either TimelineError (KeyedEvent Instant))
    , listIntervals :: ProjectId -> TimeSpan -> m (Either TimelineError (Array (Interval (KeyedEvent Instant))))
    , getLatestEvent :: ProjectId -> m (Either TimelineError (Maybe (KeyedEvent Instant)))
    }

component
  :: forall query m
  .  Monad m
  => System m
  -> Capability m
  -> Project.Capability m
  -> H.Component HH.HTML query TimelineInput ProjectEvent m
component system caps pcaps = H.mkComponent
  { initialState
  , render
  , eval: H.mkEval $ H.defaultEval
      { handleAction = eval
      , initialize = Just Initialize
      }
  } where
    initialState :: TimelineInput -> TimelineState
    initialState input =
      { selectedProject: input
      , history: M.empty
      , active: Nothing
      , activeHistory: M.empty
      }

component ::
  forall query m.
  Monad m =>
  System m ->
  Capability m ->
  Project.Capability m ->
  H.Component HH.HTML query TimelineInput ProjectEvent m
component system caps pcaps =
  H.mkComponent
    { initialState
    , render
    , eval:
        H.mkEval
          $ H.defaultEval
              { handleAction = eval
              , initialize = Just Initialize
              }
    }
  where
  initialState :: TimelineInput -> TimelineState
  initialState input =
    { selectedProject: input
    , history: M.empty
    , active: Nothing
    , activeHistory: M.empty
    }

    render :: TimelineState -> H.ComponentHTML TimelineAction 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 "Time Tracker"]
          ,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) st.selectedProject (Just <<< ProjectSelected)]
          ,HH.div
            [P.classes (ClassName <$> if isNothing st.selectedProject then ["collapse"] else [])]
            ([HH.div_
              [HH.button
                [P.classes (ClassName <$> ["btn", "btn-primary", "float-left", "my-2"])
                ,E.onClick \_ -> Just Start
                ,P.disabled (isJust st.active)

  render :: TimelineState -> H.ComponentHTML TimelineAction 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 "Time Tracker" ]
          , 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) st.selectedProject (Just <<< ProjectSelected) ]
          , HH.div
              [ P.classes (ClassName <$> if isNothing st.selectedProject then [ "collapse" ] else []) ]
              ( [ HH.div_
                    [ HH.button
                        [ P.classes (ClassName <$> [ "btn", "btn-primary", "float-left", "my-2" ])
                        , E.onClick \_ -> Just Start
                        , P.disabled (isJust st.active)
                        ]
                        [ HH.text "Start Work" ]
                    , HH.button
                        [ P.classes (ClassName <$> [ "btn", "btn-primary", "float-right", "my-2" ])
                        , E.onClick \_ -> Just Stop
                        , P.disabled (isNothing st.active)
                        ]
                        [ HH.text "Stop Work" ]
                    ]

                [HH.text "Start Work"]
              ,HH.button
                [P.classes (ClassName <$> ["btn", "btn-primary", "float-right", "my-2"])
                ,E.onClick \_ -> Just Stop
                ,P.disabled (isNothing st.active)
                ]
                [HH.text "Stop Work"]
              ]
             ] <> (historyLine <$> reverse (M.toUnfoldable $ unionHistories st.history st.activeHistory))
            )

                  <> (historyLine <$> reverse (M.toUnfoldable $ unionHistories st.history st.activeHistory))
              )

        ]

      ]

    eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
    eval action = do
      case action of
        Initialize -> do
          void $ H.subscribe caps.timer
          currentProject <- H.gets (_.selectedProject)
          traverse_ setStateForProject currentProject
        ProjectSelected p -> do
          oldActive <- isJust <$> H.gets (_.active)
          currentProject <- H.gets (_.selectedProject)
          
          -- End any active intervals when switching projects.
          when (oldActive && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject) $ do
            (traverse_ logEnd currentProject)
          H.raise (ProjectChange p) 
          setStateForProject p
        Start   -> do
          project <- H.gets (_.selectedProject)
          traverse_ logStart project
        Stop    -> do
          currentProject <- H.gets (_.selectedProject)
          traverse_ logEnd currentProject
        Refresh -> do
          t <- lift $ system.now
          H.modify_ (refresh t)
      -- common updates, irrespective of action
      active <- H.gets (_.active)
      activeHistory <- lift <<< map (fromMaybe M.empty) <<< runMaybeT $ toHistory system (U.fromMaybe active)
      H.modify_ (_ { activeHistory = activeHistory })
    logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
    logStart (Project' p) = do
      logged <- lift $ caps.logStart p.projectId
      case logged of
        Left err -> lift <<< system.log $ "Failed to start timer: " <> show err
        Right t -> H.modify_ (updateStart t)
    logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
    logEnd (Project' p) = do
      logged <- lift $ caps.logEnd p.projectId
      case logged of
        Left err -> lift <<< system.log $ "Failed to stop timer: " <> show err
        Right t -> do
          currentState <- H.get
          updatedState <- lift $ updateStop system t currentState
          H.put updatedState

  eval :: TimelineAction -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
  eval action = do
    case action of
      Initialize -> do
        void $ H.subscribe caps.timer
        currentProject <- H.gets (_.selectedProject)
        traverse_ setStateForProject currentProject
      ProjectSelected p -> do
        oldActive <- isJust <$> H.gets (_.active)
        currentProject <- H.gets (_.selectedProject)
        -- End any active intervals when switching projects.
        when (oldActive && any (\p' -> (unwrap p').projectId /= (unwrap p).projectId) currentProject)
          $ do
              (traverse_ logEnd currentProject)
        H.raise (ProjectChange p)
        setStateForProject p
      Start -> do
        project <- H.gets (_.selectedProject)
        traverse_ logStart project
      Stop -> do
        currentProject <- H.gets (_.selectedProject)
        traverse_ logEnd currentProject
      Refresh -> do
        t <- lift $ system.now
        H.modify_ (refresh t)
    -- common updates, irrespective of action
    active <- H.gets (_.active)
    activeHistory <- lift <<< map (fromMaybe M.empty) <<< runMaybeT $ toHistory system (U.fromMaybe active)
    H.modify_ (_ { activeHistory = activeHistory })

    setStateForProject :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
    setStateForProject p = do
      timeSpan <- TL.Before <$> lift system.nowDateTime -- FIXME, should come from a form control
      intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
      intervals <- lift $ case intervals' of
            Left err -> 
              (system.log $ "Error occurred listing intervals" <> show err ) *>
              pure [] 
            Right ivals -> 
              pure $ map (map LoggedEvent) ivals

  logStart :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
  logStart (Project' p) = do
    logged <- lift $ caps.logStart p.projectId
    case logged of
      Left err -> lift <<< system.log $ "Failed to start timer: " <> show err
      Right t -> H.modify_ (updateStart t)

      history' <- lift <<< runMaybeT $ toHistory system intervals
      hist <- case history' of
          Nothing -> lift $ system.log "Project history was empty." *> pure M.empty
          Just h -> pure h

  logEnd :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
  logEnd (Project' p) = do
    logged <- lift $ caps.logEnd p.projectId
    case logged of
      Left err -> lift <<< system.log $ "Failed to stop timer: " <> show err
      Right t -> do
        currentState <- H.get
        updatedState <- lift $ updateStop system t currentState
        H.put updatedState

      latestEventResponse <- lift $ caps.getLatestEvent (unwrap p).projectId
      now <- lift $ system.now
      active <- lift $ case latestEventResponse of
          Left err -> 
            (system.log $ "Error occurred retrieving the latest event: " <> show err) *>
            pure Nothing
          Right latestEvent -> do
            let activeInterval :: TL.KeyedEvent Instant -> m (Maybe (Interval TimelineEvent))

  setStateForProject :: Project -> H.HalogenM TimelineState TimelineAction Slots ProjectEvent m Unit
  setStateForProject p = do
    timeSpan <- TL.Before <$> lift system.nowDateTime -- FIXME, should come from a form control
    intervals' <- lift $ caps.listIntervals (unwrap p).projectId timeSpan
    intervals <-
      lift
        $ case intervals' of
            Left err ->
              (system.log $ "Error occurred listing intervals" <> show err)
                *> pure []
            Right ivals -> pure $ map (map LoggedEvent) ivals
    history' <- lift <<< runMaybeT $ toHistory system intervals
    hist <- case history' of
      Nothing -> lift $ system.log "Project history was empty." *> pure M.empty
      Just h -> pure h
    latestEventResponse <- lift $ caps.getLatestEvent (unwrap p).projectId
    now <- lift $ system.now
    active <-
      lift
        $ case latestEventResponse of
            Left err ->
              (system.log $ "Error occurred retrieving the latest event: " <> show err)
                *> pure Nothing
            Right latestEvent -> do
              let
                activeInterval :: TL.KeyedEvent Instant -> m (Maybe (Interval TimelineEvent))

                  TL.StartEvent i -> 
                    (system.log $ "Project has an open active interval starting " <> show i) *>
                    (Just <<< interval (LoggedEvent ev) <<< PhantomEvent <$> system.now)
                  TL.StopEvent _  -> 
                    pure Nothing
            join <$> traverse activeInterval latestEvent 

                  TL.StartEvent i ->
                    (system.log $ "Project has an open active interval starting " <> show i)
                      *> (Just <<< interval (LoggedEvent ev) <<< PhantomEvent <$> system.now)
                  TL.StopEvent _ -> pure Nothing
              join <$> traverse activeInterval latestEvent
    H.modify_ (_ { selectedProject = Just p, history = hist, active = active })

      H.modify_ (_ { selectedProject = Just p, history = hist, active = active })
historyLine 
  :: forall w i
  .  Tuple Date DayIntervals
  -> HH.HTML w i
historyLine (Tuple d xs) = 
  datedLine d xs.dayBounds xs.loggedIntervals

historyLine ::
  forall w i.
  Tuple Date DayIntervals ->
  HH.HTML w i
historyLine (Tuple d xs) = datedLine d xs.dayBounds xs.loggedIntervals

datedLine 
  :: forall w i
  .  Date
  -> TimeInterval 
  -> Array (Interval TimelineEvent)
  -> HH.HTML w i

datedLine ::
  forall w i.
  Date ->
  TimeInterval ->
  Array (Interval TimelineEvent) ->
  HH.HTML w i

        clear clearBoth 

        clear clearBoth

      [ CSS.style do
          border solid (px 3.0) (rgb 0x00 0xFF 0x00)
          borderRadius px5 px5 px5 px5
          height (px $ 44.0)
          display flex
      , P.classes (ClassName <$> ["my-2"])
      ]
      (evalState (traverse (intervalHtml dateBounds) xs) 0.0)

        [ CSS.style do
            border solid (px 3.0) (rgb 0x00 0xFF 0x00)
            borderRadius px5 px5 px5 px5
            height (px $ 44.0)
            display flex
        , P.classes (ClassName <$> [ "my-2" ])
        ]
        (evalState (traverse (intervalHtml dateBounds) xs) 0.0)

  where 
    px5 = px 5.0

  where
  px5 = px 5.0

dateStr d = (show <<< fromEnum $ year d) <> "-" 
         <> (show <<< fromEnum $ month d) <> "-" 
         <> (show <<< fromEnum $ day d)

dateStr d =
  (show <<< fromEnum $ year d) <> "-"
    <> (show <<< fromEnum $ month d)
    <> "-"
    <> (show <<< fromEnum $ day d)

intervalHtml
  :: forall w i 
  .  TimeInterval
  -> Interval TimelineEvent
  -> State Number (HH.HTML w i)

intervalHtml ::
  forall w i.
  TimeInterval ->
  Interval TimelineEvent ->
  State Number (HH.HTML w i)

  let maxWidth = ilen limits.start limits.end
      ileft = ilen limits.start (tlEventTime i.start)
      iwidth = ilen (tlEventTime i.start) (tlEventTime i.end)
      px5 = px (5.0)
      toPct n = 100.0 * n / maxWidth

  let
    maxWidth = ilen limits.start limits.end
    ileft = ilen limits.start (tlEventTime i.start)
    iwidth = ilen (tlEventTime i.start) (tlEventTime i.end)
    px5 = px (5.0)
    toPct n = 100.0 * n / maxWidth

  pure $ HH.div
    [ CSS.style do
        backgroundColor (rgb 0xf0 0x98 0x18)
        marginLeft (pct $ toPct ileft - offset)
        width (pct $ max (toPct iwidth) 0.5)
        borderRadius px5 px5 px5 px5
    ]
    []

  pure
    $ HH.div
        [ CSS.style do
            backgroundColor (rgb 0xf0 0x98 0x18)
            marginLeft (pct $ toPct ileft - offset)
            width (pct $ max (toPct iwidth) 0.5)
            borderRadius px5 px5 px5 px5
        ]
        []

timer = EventSource.affEventSource \emitter -> do
  fiber <- Aff.forkAff $ forever do
    Aff.delay $ Aff.Milliseconds 10000.0
    EventSource.emit emitter Refresh
  pure $ EventSource.Finalizer do
    Aff.killFiber (error "Event source finalized") fiber

timer =
  EventSource.affEventSource \emitter -> do
    fiber <-
      Aff.forkAff
        $ forever do
            Aff.delay $ Aff.Milliseconds 10000.0
            EventSource.emit emitter Refresh
    pure
      $ EventSource.Finalizer do
          Aff.killFiber (error "Event source finalized") fiber

updateStart ev s = 
  s { active = s.active <|> Just (TL.interval (LoggedEvent ev) (PhantomEvent <<< eventTime <<< event $ ev)) }

updateStart ev s = s { active = s.active <|> Just (TL.interval (LoggedEvent ev) (PhantomEvent <<< eventTime <<< event $ ev)) }

updateStop 
  :: forall m
  .  Monad m
  => System m 
  -> KeyedEvent Instant 
  -> TimelineState 
  -> m TimelineState

updateStop ::
  forall m.
  Monad m =>
  System m ->
  KeyedEvent Instant ->
  TimelineState ->
  m TimelineState

  let updateHistory i = runMaybeT $ toHistory system [TL.interval (start i) (LoggedEvent ev)]

  let
    updateHistory i = runMaybeT $ toHistory system [ TL.interval (start i) (LoggedEvent ev) ]

  pure { selectedProject: st.selectedProject
       , history: maybe st.history (unionHistories st.history) newHistory 
       , active: Nothing
       , activeHistory: M.empty
       }

  pure
    { selectedProject: st.selectedProject
    , history: maybe st.history (unionHistories st.history) newHistory
    , active: Nothing
    , activeHistory: M.empty
    }

  s { active = map (\i -> TL.interval (start i) (PhantomEvent t)) s.active

  s
    { active = map (\i -> TL.interval (start i) (PhantomEvent t)) s.active

  let n (Milliseconds x) = x
  in  n (unInstant _end) - n (unInstant _start)

  let
    n (Milliseconds x) = x
  in
    n (unInstant _end) - n (unInstant _start)

apiCapability = 

apiCapability =

  , logEnd: TL.apiLogEnd 

  , logEnd: TL.apiLogEnd

  , logEnd:   \_ -> Right <<< keyedEvent "" <<< StopEvent <$> liftEffect now

  , logEnd: \_ -> Right <<< keyedEvent "" <<< StopEvent <$> liftEffect now

utcDayBounds :: Instant -> TimeInterval 

utcDayBounds :: Instant -> TimeInterval

  let startOfDay = DateTime (date $ toDateTime i)  bottom
      endOfDay = DT.adjust (Days 1.0) startOfDay
      startInstant = fromDateTime startOfDay
   in TL.interval startInstant (maybe startInstant fromDateTime endOfDay)

  let
    startOfDay = DateTime (date $ toDateTime i) bottom
    endOfDay = DT.adjust (Days 1.0) startOfDay

localDayBounds 
  :: forall m
  .  Monad m
  => System m
  -> Instant 
  -> MaybeT m (Tuple Date TimeInterval)

    startInstant = fromDateTime startOfDay
  in
    TL.interval startInstant (maybe startInstant fromDateTime endOfDay)
localDayBounds ::
  forall m.
  Monad m =>
  System m ->
  Instant ->
  MaybeT m (Tuple Date TimeInterval)

  nextNoon <- MaybeT <<< pure $  
    fromDateTime <$> (
      DT.adjust (Hours 12.0) <=< DT.adjust (Days 1.0) $
      (toDateTime start)
    )

  nextNoon <-
    MaybeT <<< pure
      $ fromDateTime
      <$> ( DT.adjust (Hours 12.0) <=< DT.adjust (Days 1.0)
            $ (toDateTime start)
        )

splitInterval 
  :: forall m
  .  Monad m
  => System m
  -> Interval TimelineEvent 
  -> MaybeT m (Array (Tuple Date DayIntervals))

splitInterval ::
  forall m.
  Monad m =>
  System m ->
  Interval TimelineEvent ->
  MaybeT m (Array (Tuple Date DayIntervals))

  split <- if tlEventTime (end i) < end bounds
    then do

  split <-
    if tlEventTime (end i) < end bounds then do

      pure [Tuple date { dayBounds: bounds, loggedIntervals: [i] }]

      pure [ Tuple date { dayBounds: bounds, loggedIntervals: [ i ] } ]

      let splitEvent = PhantomEvent (end bounds)
          currInterval = Tuple date { dayBounds: bounds, loggedIntervals: [interval (start i) splitEvent] }
          nextInterval = interval splitEvent (end i)

      let
        splitEvent = PhantomEvent (end bounds)
        currInterval = Tuple date { dayBounds: bounds, loggedIntervals: [ interval (start i) splitEvent ] }
        nextInterval = interval splitEvent (end i)