module Aftok.Projects.Create where
import Prelude
import Control.Monad.Trans.Class (lift)
import Data.Either (Either(..), note)
import Data.Foldable (any)
import Data.Maybe (Maybe(..))
import Data.Number (fromString) as Number
import Data.Time.Duration (Days(..))
import Data.Validation.Semigroup (V(..), toEither)
import Effect.Aff (Aff)
import DOM.HTML.Indexed.ButtonType (ButtonType(..))
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
import Halogen.HTML.Properties.ARIA as ARIA
import Aftok.Api.Project (ProjectCreateRequest, DepreciationFn(..), createProject)
import Aftok.Api.Types (APIError(..))
import Aftok.HTML.Classes as C
import Aftok.Modals.ModalFFI as ModalFFI
import Aftok.Types (System, ProjectId)
data Field
= NameField
| UndepField
| DepField
derive instance fieldEq :: Eq Field
derive instance fieldOrd :: Ord Field
type CState =
{ projectName :: Maybe String
, undep :: Maybe Days
, dep :: Maybe Days
, fieldErrors :: Array Field
}
data Query a
= OpenModal a
data Output
= ProjectCreated ProjectId
data Action
= SetName String
| SetUndepDays String
| SetDepDays String
| Save
| Close
type Slot id
= H.Slot Query Output id
type Capability (m :: Type -> Type)
= { createProject :: ProjectCreateRequest -> m (Either APIError ProjectId)
}
modalId :: String
modalId = "createProject"
component ::
forall input m.
Monad m =>
System m ->
Capability m ->
H.Component HH.HTML Query input Output m
component system caps =
H.mkComponent
{ initialState: const initialState
, render
, eval: H.mkEval
$ H.defaultEval
{ handleAction = handleAction
, handleQuery = handleQuery
}
}
where
initialState :: CState
initialState =
{ projectName : Nothing
, undep : Nothing
, dep : Nothing
, fieldErrors : []
}
render :: forall slots. CState -> H.ComponentHTML Action slots m
render st =
HH.div
[ P.classes [ C.modal ]
, P.id_ modalId
, P.tabIndex (negate 1)
, ARIA.role "dialog"
, ARIA.labelledBy (modalId <> "Title")
, ARIA.hidden "true"
]
[ HH.div
[ P.classes [C.modalDialog], ARIA.role "document" ]
[ HH.div
[ P.classes [C.modalContent] ]
[ HH.div
[ P.classes [C.modalHeader] ]
[ HH.h5 [P.classes [C.modalTitle], P.id_ (modalId <>"Title") ] [HH.text "Create a new project"]
, HH.button
[ P.classes [ C.close ]
, ARIA.label "Close"
, P.type_ ButtonButton
, E.onClick (\_ -> Just Close)
]
[ HH.span [ARIA.hidden "true"] [HH.text "×"]]
]
, HH.div
[ P.classes [C.modalBody] ]
[ HH.form_
[ formGroup st
[ NameField ]
[ HH.label
[ P.for "projectName"]
[ HH.text "Project Name" ]
, HH.input
[ P.type_ P.InputText
, P.classes [ C.formControl, C.formControlSm ]
, P.id_ "projectName"
, P.placeholder "My awesome new project!!!"
, E.onValueInput (Just <<< SetName)
]
]
, formGroup st
[ UndepField ]
[ HH.label
[ P.for "undepDays"]
[ HH.text "Number of days before a share begins to depreciate" ]
, HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl, C.formControlXs, C.formControlFlush, C.marginX2 ]
, P.id_ "undepDays"
, P.placeholder "180"
, E.onValueInput (Just <<< SetUndepDays)
]
]
, formGroup st
[ DepField ]
[ HH.label
[ P.for "undepDays"]
[ HH.text "Number of days over which a share depreciates" ]
, HH.input
[ P.type_ P.InputNumber
, P.classes [ C.formControl, C.formControlXs, C.formControlFlush, C.marginX2 ]
, P.id_ "undepDays"
, P.placeholder "1800"
, E.onValueInput (Just <<< SetDepDays)
]
]
]
]
, HH.div
[ P.classes [C.modalFooter] ]
[ HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnSecondary]
, E.onClick (\_ -> Just Close)
]
[ HH.text "Close" ]
, HH.button
[ P.type_ ButtonButton
, P.classes [ C.btn, C.btnPrimary ]
, E.onClick (\_ -> Just Save)
]
[ HH.text "Create project"]
]
]
]
]
formGroup :: forall i a. CState -> Array Field -> Array (HH.HTML i a) -> HH.HTML i a
formGroup st fields body =
HH.div
[ P.classes [C.formGroup] ]
(body <> (fieldError st =<< fields))
fieldError :: forall i a. CState -> Field -> Array (HH.HTML i a)
fieldError st field =
if any (_ == field) st.fieldErrors
then case field of
NameField -> err "The name field is required"
UndepField -> err "A number of days before depreciation starts is required"
DepField -> err "The number of days over which a share depreciates is required"
else []
where
err str =
[ HH.div_
[ HH.span
[ P.classes (ClassName <$> [ "badge", "badge-danger-soft" ]) ] [ HH.text str ] ]
]
-- we use a query to initialize, since this is a modal that doesn't actually get unloaded.
handleQuery :: forall slots a. Query a -> H.HalogenM CState Action slots Output m (Maybe a)
handleQuery = case _ of
OpenModal a -> do
H.modify_ (const initialState)
lift $ system.toggleModal modalId ModalFFI.ShowModal
pure (Just a)
handleAction :: forall slots. Action -> H.HalogenM CState Action slots Output m Unit
handleAction = case _ of
SetName name ->
H.modify_ (_ { projectName = Just name })
SetUndepDays days ->
case Number.fromString days of
(Just n) -> H.modify_ (_ { undep = Just $ Days n })
(Nothing) -> pure unit
SetDepDays days ->
case Number.fromString days of
(Just n) -> H.modify_ (_ { dep = Just $ Days n })
(Nothing) -> pure unit
Save -> do
nameV <- V <<< note [NameField] <$> H.gets (_.projectName)
undepV <- V <<< note [UndepField] <$> H.gets (_.undep)
depV <- V <<< note [DepField] <$> H.gets (_.dep)
let req = { projectName: _
, depf : _
}
reqV =
req <$> nameV
<*> (LinearDepreciation <$> ({ undep: _, dep: _ } <$> undepV <*> depV))
case toEither reqV of
Right req' -> do
res <- lift $ caps.createProject req'
case res of
Right pid -> do
H.raise (ProjectCreated pid)
handleAction Close
Left errs -> do
lift $ system.error (show errs)
Left errors -> do
H.modify_ (_ { fieldErrors = errors })
Close -> do
H.modify_ (const initialState) -- wipe the state for safety
lift $ system.toggleModal modalId ModalFFI.HideModal
apiCapability :: Capability Aff
apiCapability =
{ createProject: createProject
}
mockCapability :: Capability Aff
mockCapability =
{ createProject: \_ -> pure $ Left Forbidden }