{-# LANGUAGE TemplateHaskell #-}

module Mensam.Client.UI.Desks where

import Mensam.API.Aeson
import Mensam.API.Data.Desk
import Mensam.API.Data.Reservation
import Mensam.API.Data.Space
import Mensam.API.Route.Api.Reservation qualified as Route.Reservation
import Mensam.API.Route.Api.Space qualified as Route.Space
import Mensam.Client.Application
import Mensam.Client.Application.Event.Class
import Mensam.Client.UI.Brick.Draw
import Mensam.Client.UI.Brick.Events
import Mensam.Client.UI.Brick.Names

import Brick
import Brick.Forms
import Brick.Widgets.Border
import Brick.Widgets.Center
import Brick.Widgets.List
import Control.Monad.Trans.Class
import Data.Bifunctor
import Data.Kind
import Data.Maybe
import Data.Sequence qualified as Seq
import Data.Text qualified as T
import Data.Time qualified as T
import Data.Time.Format.ISO8601 qualified as T
import Graphics.Vty.Input.Events
import Lens.Micro.Platform

desksListInitial :: GenericList ClientName Seq.Seq Route.Space.DeskWithInfo
desksListInitial :: GenericList ClientName Seq DeskWithInfo
desksListInitial =
  ClientName
-> Seq DeskWithInfo
-> Int
-> GenericList ClientName Seq DeskWithInfo
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list
    ClientName
ClientNameSpacesList
    Seq DeskWithInfo
forall a. Monoid a => a
mempty
    Int
1

type NewDeskInfo :: Type
newtype NewDeskInfo = MkNewDeskInfo
  { NewDeskInfo -> Text
_newDeskInfoName :: T.Text
  }
makeLenses ''NewDeskInfo

newDeskFormInitial :: Form NewDeskInfo e ClientName
newDeskFormInitial :: forall e. Form NewDeskInfo e ClientName
newDeskFormInitial =
  [NewDeskInfo -> FormFieldState NewDeskInfo e ClientName]
-> NewDeskInfo -> Form NewDeskInfo e ClientName
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm
    [ (String -> Widget ClientName
forall n. String -> Widget n
str String
"Name: " <+>) (Widget ClientName -> Widget ClientName)
-> (NewDeskInfo -> FormFieldState NewDeskInfo e ClientName)
-> NewDeskInfo
-> FormFieldState NewDeskInfo e ClientName
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' NewDeskInfo Text
-> ClientName
-> Maybe Int
-> NewDeskInfo
-> FormFieldState NewDeskInfo e ClientName
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField (Text -> f Text) -> NewDeskInfo -> f NewDeskInfo
Lens' NewDeskInfo Text
newDeskInfoName ClientName
ClientNameDesksNewDeskName (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
    ]
    MkNewDeskInfo
      { _newDeskInfoName :: Text
_newDeskInfoName = Text
""
      }

type NewReservationInfo :: Type
data NewReservationInfo = MkNewReservationInfo
  { NewReservationInfo -> Text
_newReservationInfoDesk :: T.Text
  , NewReservationInfo -> Text
_newReservationInfoTimeBegin :: T.Text
  , NewReservationInfo -> Text
_newReservationInfoTimeEnd :: T.Text
  }
makeLenses ''NewReservationInfo

newReservationFormInitial :: Desk -> Form NewReservationInfo e ClientName
newReservationFormInitial :: forall e. Desk -> Form NewReservationInfo e ClientName
newReservationFormInitial Desk
desk =
  [NewReservationInfo
 -> FormFieldState NewReservationInfo e ClientName]
-> NewReservationInfo -> Form NewReservationInfo e ClientName
forall s e n. [s -> FormFieldState s e n] -> s -> Form s e n
newForm
    [ (String -> Widget ClientName
forall n. String -> Widget n
str String
"Desk: " <+>) (Widget ClientName -> Widget ClientName)
-> (NewReservationInfo
    -> FormFieldState NewReservationInfo e ClientName)
-> NewReservationInfo
-> FormFieldState NewReservationInfo e ClientName
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' NewReservationInfo Text
-> ClientName
-> Maybe Int
-> NewReservationInfo
-> FormFieldState NewReservationInfo e ClientName
forall n s e.
(Ord n, Show n) =>
Lens' s Text -> n -> Maybe Int -> s -> FormFieldState s e n
editTextField (Text -> f Text) -> NewReservationInfo -> f NewReservationInfo
Lens' NewReservationInfo Text
newReservationInfoDesk ClientName
ClientNameDesksNewReservationDesk (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
    , (String -> Widget ClientName
forall n. String -> Widget n
str String
"Begin: " <+>)
        (Widget ClientName -> Widget ClientName)
-> (NewReservationInfo
    -> FormFieldState NewReservationInfo e ClientName)
-> NewReservationInfo
-> FormFieldState NewReservationInfo e ClientName
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' NewReservationInfo Text
-> ClientName
-> Maybe Int
-> (Text -> Text)
-> ([Text] -> Maybe Text)
-> ([Text] -> Widget ClientName)
-> (Widget ClientName -> Widget ClientName)
-> NewReservationInfo
-> FormFieldState NewReservationInfo e ClientName
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField
          (Text -> f Text) -> NewReservationInfo -> f NewReservationInfo
Lens' NewReservationInfo Text
newReservationInfoTimeBegin
          ClientName
ClientNameDesksNewReservationTimeBegin
          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
          Text -> Text
forall a. a -> a
id
          ( \case
              [Text
line] -> (Text -> TimeOfDay -> Text
forall a b. a -> b -> a
const Text
line <$>) (Maybe TimeOfDay -> Maybe Text)
-> (Text -> Maybe TimeOfDay) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
T.iso8601ParseM @_ @T.TimeOfDay (String -> Maybe TimeOfDay)
-> (Text -> String) -> Text -> Maybe TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
line
              [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing
          )
          (Text -> Widget ClientName
forall n. Text -> Widget n
txt (Text -> Widget ClientName)
-> ([Text] -> Text) -> [Text] -> Widget ClientName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n")
          Widget ClientName -> Widget ClientName
forall a. a -> a
id
    , (String -> Widget ClientName
forall n. String -> Widget n
str String
"End: " <+>)
        (Widget ClientName -> Widget ClientName)
-> (NewReservationInfo
    -> FormFieldState NewReservationInfo e ClientName)
-> NewReservationInfo
-> FormFieldState NewReservationInfo e ClientName
forall n s e.
(Widget n -> Widget n)
-> (s -> FormFieldState s e n) -> s -> FormFieldState s e n
@@= Lens' NewReservationInfo Text
-> ClientName
-> Maybe Int
-> (Text -> Text)
-> ([Text] -> Maybe Text)
-> ([Text] -> Widget ClientName)
-> (Widget ClientName -> Widget ClientName)
-> NewReservationInfo
-> FormFieldState NewReservationInfo e ClientName
forall n s a e.
(Ord n, Show n) =>
Lens' s a
-> n
-> Maybe Int
-> (a -> Text)
-> ([Text] -> Maybe a)
-> ([Text] -> Widget n)
-> (Widget n -> Widget n)
-> s
-> FormFieldState s e n
editField
          (Text -> f Text) -> NewReservationInfo -> f NewReservationInfo
Lens' NewReservationInfo Text
newReservationInfoTimeEnd
          ClientName
ClientNameDesksNewReservationTimeEnd
          (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1)
          Text -> Text
forall a. a -> a
id
          ( \case
              [Text
line] -> (Text -> TimeOfDay -> Text
forall a b. a -> b -> a
const Text
line <$>) (Maybe TimeOfDay -> Maybe Text)
-> (Text -> Maybe TimeOfDay) -> Text -> Maybe Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
T.iso8601ParseM @_ @T.TimeOfDay (String -> Maybe TimeOfDay)
-> (Text -> String) -> Text -> Maybe TimeOfDay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
line
              [Text]
_ -> Maybe Text
forall a. Maybe a
Nothing
          )
          (Text -> Widget ClientName
forall n. Text -> Widget n
txt (Text -> Widget ClientName)
-> ([Text] -> Text) -> [Text] -> Widget ClientName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n")
          Widget ClientName -> Widget ClientName
forall a. a -> a
id
    ]
    MkNewReservationInfo
      { _newReservationInfoDesk :: Text
_newReservationInfoDesk = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ IdentifierDesk -> String
forall a. Show a => a -> String
show (IdentifierDesk -> String) -> IdentifierDesk -> String
forall a b. (a -> b) -> a -> b
$ Desk -> IdentifierDesk
deskId Desk
desk
      , _newReservationInfoTimeBegin :: Text
_newReservationInfoTimeBegin = Text
""
      , _newReservationInfoTimeEnd :: Text
_newReservationInfoTimeEnd = Text
""
      }

type ScreenDesksState :: Type
data ScreenDesksState = MkScreenDesksState
  { ScreenDesksState -> Space
_screenStateDesksSpace :: Space
  , ScreenDesksState -> GenericList ClientName Seq DeskWithInfo
_screenStateDesksList :: GenericList ClientName Seq.Seq Route.Space.DeskWithInfo
  , ScreenDesksState -> Bool
_screenStateDesksShowHelp :: Bool
  , ScreenDesksState
-> Maybe (Form NewReservationInfo ClientEvent ClientName)
_screenStateDesksCreateReservation :: Maybe (Form NewReservationInfo ClientEvent ClientName)
  , ScreenDesksState -> Day
_screenStateDesksPreviewDay :: T.Day
  , ScreenDesksState -> TimeZone
_screenStateDesksTimezone :: T.TimeZone
  , ScreenDesksState -> Maybe (Form NewDeskInfo ClientEvent ClientName)
_screenStateDesksNewDeskForm :: Maybe (Form NewDeskInfo ClientEvent ClientName)
  }
makeLenses ''ScreenDesksState

desksDraw :: ScreenDesksState -> [Widget ClientName]
desksDraw :: ScreenDesksState -> [Widget ClientName]
desksDraw = \case
  s :: ScreenDesksState
s@MkScreenDesksState {_screenStateDesksShowHelp :: ScreenDesksState -> Bool
_screenStateDesksShowHelp = Bool
True} ->
    [ Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
centerLayer (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
        Widget ClientName -> Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget ClientName
forall n. Text -> Widget n
txt Text
"Help") (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
          Int -> Widget ClientName -> Widget ClientName
forall n. Int -> Widget n -> Widget n
cropRightTo Int
80 (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
            Text -> Widget ClientName
forall n. Text -> Widget n
txt
              Text
"? - Toggle Help\n\
              \r - Refresh Desks\n\
              \c - Create new Desk\n\
              \Enter - Toggle reservations for a desk\n\
              \"
    ]
      [Widget ClientName] -> [Widget ClientName] -> [Widget ClientName]
forall a. Semigroup a => a -> a -> a
<> ScreenDesksState -> [Widget ClientName]
desksDraw ScreenDesksState
s {_screenStateDesksShowHelp = False}
  s :: ScreenDesksState
s@MkScreenDesksState {_screenStateDesksCreateReservation :: ScreenDesksState
-> Maybe (Form NewReservationInfo ClientEvent ClientName)
_screenStateDesksCreateReservation = Just Form NewReservationInfo ClientEvent ClientName
form} ->
    [ Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
centerLayer (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Widget ClientName -> Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget ClientName
forall n. Text -> Widget n
txt Text
"New Reservation") (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Int -> Widget ClientName -> Widget ClientName
forall n. Int -> Widget n -> Widget n
cropRightTo Int
80 (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Form NewReservationInfo ClientEvent ClientName -> Widget ClientName
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form NewReservationInfo ClientEvent ClientName
form
    ]
      [Widget ClientName] -> [Widget ClientName] -> [Widget ClientName]
forall a. Semigroup a => a -> a -> a
<> ScreenDesksState -> [Widget ClientName]
desksDraw (ScreenDesksState
s {_screenStateDesksCreateReservation = Nothing})
  s :: ScreenDesksState
s@MkScreenDesksState {_screenStateDesksNewDeskForm :: ScreenDesksState -> Maybe (Form NewDeskInfo ClientEvent ClientName)
_screenStateDesksNewDeskForm = Just Form NewDeskInfo ClientEvent ClientName
form} ->
    [ Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
centerLayer (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Widget ClientName -> Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget ClientName
forall n. Text -> Widget n
txt Text
"New Desk") (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Int -> Widget ClientName -> Widget ClientName
forall n. Int -> Widget n -> Widget n
cropRightTo Int
80 (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Form NewDeskInfo ClientEvent ClientName -> Widget ClientName
forall n s e. Eq n => Form s e n -> Widget n
renderForm Form NewDeskInfo ClientEvent ClientName
form
    ]
      [Widget ClientName] -> [Widget ClientName] -> [Widget ClientName]
forall a. Semigroup a => a -> a -> a
<> ScreenDesksState -> [Widget ClientName]
desksDraw (ScreenDesksState
s {_screenStateDesksNewDeskForm = Nothing})
  MkScreenDesksState
    { _screenStateDesksSpace :: ScreenDesksState -> Space
_screenStateDesksSpace = Space
space
    , _screenStateDesksList :: ScreenDesksState -> GenericList ClientName Seq DeskWithInfo
_screenStateDesksList = GenericList ClientName Seq DeskWithInfo
desksWithInfo
    , _screenStateDesksPreviewDay :: ScreenDesksState -> Day
_screenStateDesksPreviewDay = Day
day
    , _screenStateDesksTimezone :: ScreenDesksState -> TimeZone
_screenStateDesksTimezone = TimeZone
tz
    } ->
      [ [Widget ClientName] -> Widget ClientName
forall n. [Widget n] -> Widget n
vBox
          [ Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
joinBorders (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
              Widget ClientName -> Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n -> Widget n
borderWithLabel (Text -> Widget ClientName
forall n. Text -> Widget n
txt (Text -> Widget ClientName) -> Text -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Text
"Desks (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameSpace -> Text
unNameSpace (Space -> NameSpace
spaceName Space
space) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")") (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
                [Widget ClientName] -> Widget ClientName
forall n. [Widget n] -> Widget n
vBox
                  [ Padding -> Widget ClientName -> Widget ClientName
forall n. Padding -> Widget n -> Widget n
padBottom Padding
Max (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
                      Padding -> Widget ClientName -> Widget ClientName
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$
                        (Bool -> DeskWithInfo -> Widget ClientName)
-> Bool
-> GenericList ClientName Seq DeskWithInfo
-> Widget ClientName
forall (t :: * -> *) n e.
(Traversable t, Splittable t, Ord n, Show n) =>
(Bool -> e -> Widget n) -> Bool -> GenericList n t e -> Widget n
renderList (\Bool
_focus (Route.Space.MkDeskWithInfo {Desk
deskWithInfoDesk :: Desk
deskWithInfoDesk :: DeskWithInfo -> Desk
Route.Space.deskWithInfoDesk, [Reservation]
deskWithInfoReservations :: [Reservation]
deskWithInfoReservations :: DeskWithInfo -> [Reservation]
Route.Space.deskWithInfoReservations}) -> Padding -> Widget ClientName -> Widget ClientName
forall n. Padding -> Widget n -> Widget n
padRight Padding
Max (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Text -> Widget ClientName
forall n. Text -> Widget n
txt (Text -> Widget ClientName) -> Text -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (String
"#" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int64 -> String
forall a. Show a => a -> String
show (IdentifierDesk -> Int64
unIdentifierDesk (IdentifierDesk -> Int64) -> IdentifierDesk -> Int64
forall a b. (a -> b) -> a -> b
$ Desk -> IdentifierDesk
deskId Desk
deskWithInfoDesk) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ") Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NameDesk -> Text
unNameDesk (Desk -> NameDesk
deskName Desk
deskWithInfoDesk) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack ([Reservation] -> String
forall a. Show a => a -> String
show [Reservation]
deskWithInfoReservations)) Bool
True GenericList ClientName Seq DeskWithInfo
desksWithInfo
                  , Widget ClientName
forall n. Widget n
hBorder
                  , let reservations :: [Reservation]
reservations =
                          case GenericList ClientName Seq DeskWithInfo
-> Maybe (Int, DeskWithInfo)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
listSelectedElement GenericList ClientName Seq DeskWithInfo
desksWithInfo of
                            Maybe (Int, DeskWithInfo)
Nothing -> []
                            Just (Int
_index, DeskWithInfo
desk) -> DeskWithInfo -> [Reservation]
Route.Space.deskWithInfoReservations DeskWithInfo
desk
                     in Int -> Widget ClientName -> Widget ClientName
forall n. Int -> Widget n -> Widget n
vLimit Int
3 (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
hCenter (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ ClientName
-> ViewportType -> Widget ClientName -> Widget ClientName
forall n.
(Ord n, Show n) =>
n -> ViewportType -> Widget n -> Widget n
viewport ClientName
ClientNameDesksReservationsViewport ViewportType
Horizontal (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Widget ClientName -> Widget ClientName
forall n. Widget n -> Widget n
visible (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Text -> Widget ClientName
forall n. Text -> Widget n
txt (Text -> Widget ClientName) -> Text -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ TimeZone -> Day -> [Reservation] -> Text
prettyReservations TimeZone
tz Day
day [Reservation]
reservations
                  ]
          , Padding -> Widget ClientName -> Widget ClientName
forall n. Padding -> Widget n -> Widget n
padLeft Padding
Max (Widget ClientName -> Widget ClientName)
-> Widget ClientName -> Widget ClientName
forall a b. (a -> b) -> a -> b
$ Text -> Widget ClientName
forall n. Text -> Widget n
txt Text
footerMenuHelp
          ]
      ]

desksHandleEvent :: BrickEvent ClientName ClientEvent -> ApplicationT (EventM ClientName ScreenDesksState) ()
desksHandleEvent :: BrickEvent ClientName ClientEvent
-> ApplicationT (EventM ClientName ScreenDesksState) ()
desksHandleEvent BrickEvent ClientName ClientEvent
event = do
  ScreenDesksState
s <- EventM ClientName ScreenDesksState ScreenDesksState
-> ApplicationT
     (EventM ClientName ScreenDesksState) ScreenDesksState
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift EventM ClientName ScreenDesksState ScreenDesksState
forall s (m :: * -> *). MonadState s m => m s
get
  case Form NewDeskInfo ClientEvent ClientName -> NewDeskInfo
forall s e n. Form s e n -> s
formState (Form NewDeskInfo ClientEvent ClientName -> NewDeskInfo)
-> Maybe (Form NewDeskInfo ClientEvent ClientName)
-> Maybe NewDeskInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenDesksState -> Maybe (Form NewDeskInfo ClientEvent ClientName)
_screenStateDesksNewDeskForm ScreenDesksState
s of
    Maybe NewDeskInfo
Nothing ->
      case Form NewReservationInfo ClientEvent ClientName
-> NewReservationInfo
forall s e n. Form s e n -> s
formState (Form NewReservationInfo ClientEvent ClientName
 -> NewReservationInfo)
-> Maybe (Form NewReservationInfo ClientEvent ClientName)
-> Maybe NewReservationInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ScreenDesksState
-> Maybe (Form NewReservationInfo ClientEvent ClientName)
_screenStateDesksCreateReservation ScreenDesksState
s of
        Maybe NewReservationInfo
Nothing ->
          case BrickEvent ClientName ClientEvent
event of
            VtyEvent (EvKey (KChar Char
'?') []) -> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventM ClientName ScreenDesksState ()
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$ ScreenDesksState -> EventM ClientName ScreenDesksState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put ScreenDesksState
s {_screenStateDesksShowHelp = not $ _screenStateDesksShowHelp s}
            VtyEvent (EvKey (KChar Char
'r') []) -> ClientEvent -> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent (ClientEvent
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> (ScreenDesksState -> ClientEvent)
-> ScreenDesksState
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Space -> ClientEvent
ClientEventSwitchToScreenDesks (Space -> ClientEvent)
-> (ScreenDesksState -> Space) -> ScreenDesksState -> ClientEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ScreenDesksState -> Space
_screenStateDesksSpace (ScreenDesksState
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> ApplicationT
     (EventM ClientName ScreenDesksState) ScreenDesksState
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< EventM ClientName ScreenDesksState ScreenDesksState
-> ApplicationT
     (EventM ClientName ScreenDesksState) ScreenDesksState
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift EventM ClientName ScreenDesksState ScreenDesksState
forall s (m :: * -> *). MonadState s m => m s
get
            VtyEvent (EvKey (KChar Char
'c') []) -> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventM ClientName ScreenDesksState ()
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$ (Maybe (Form NewDeskInfo ClientEvent ClientName)
 -> Identity (Maybe (Form NewDeskInfo ClientEvent ClientName)))
-> ScreenDesksState -> Identity ScreenDesksState
Lens'
  ScreenDesksState (Maybe (Form NewDeskInfo ClientEvent ClientName))
screenStateDesksNewDeskForm ((Maybe (Form NewDeskInfo ClientEvent ClientName)
  -> Identity (Maybe (Form NewDeskInfo ClientEvent ClientName)))
 -> ScreenDesksState -> Identity ScreenDesksState)
-> (Maybe (Form NewDeskInfo ClientEvent ClientName)
    -> Maybe (Form NewDeskInfo ClientEvent ClientName))
-> EventM ClientName ScreenDesksState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Maybe (Form NewDeskInfo ClientEvent ClientName)
-> Maybe (Form NewDeskInfo ClientEvent ClientName)
-> Maybe (Form NewDeskInfo ClientEvent ClientName)
forall a b. a -> b -> a
const (Form NewDeskInfo ClientEvent ClientName
-> Maybe (Form NewDeskInfo ClientEvent ClientName)
forall a. a -> Maybe a
Just Form NewDeskInfo ClientEvent ClientName
forall e. Form NewDeskInfo e ClientName
newDeskFormInitial)
            VtyEvent (EvKey Key
KEnter []) -> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventM ClientName ScreenDesksState ()
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$ ScreenDesksState -> EventM ClientName ScreenDesksState ()
forall s (m :: * -> *). MonadState s m => s -> m ()
put (ScreenDesksState -> EventM ClientName ScreenDesksState ())
-> ScreenDesksState -> EventM ClientName ScreenDesksState ()
forall a b. (a -> b) -> a -> b
$ ScreenDesksState
s {_screenStateDesksCreateReservation = newReservationFormInitial . Route.Space.deskWithInfoDesk . snd <$> listSelectedElement (_screenStateDesksList s)}
            VtyEvent Event
e -> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventM ClientName ScreenDesksState ()
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed
     (EventM ClientName (GenericList ClientName Seq DeskWithInfo)) ())
  ScreenDesksState
  (GenericList ClientName Seq DeskWithInfo)
-> EventM ClientName (GenericList ClientName Seq DeskWithInfo) ()
-> EventM ClientName ScreenDesksState ()
forall c.
LensLike'
  (Zoomed
     (EventM ClientName (GenericList ClientName Seq DeskWithInfo)) c)
  ScreenDesksState
  (GenericList ClientName Seq DeskWithInfo)
-> EventM ClientName (GenericList ClientName Seq DeskWithInfo) c
-> EventM ClientName ScreenDesksState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom (GenericList ClientName Seq DeskWithInfo
 -> Focusing
      (StateT (EventState ClientName) IO)
      ()
      (GenericList ClientName Seq DeskWithInfo))
-> ScreenDesksState
-> Focusing (StateT (EventState ClientName) IO) () ScreenDesksState
LensLike'
  (Zoomed
     (EventM ClientName (GenericList ClientName Seq DeskWithInfo)) ())
  ScreenDesksState
  (GenericList ClientName Seq DeskWithInfo)
Lens' ScreenDesksState (GenericList ClientName Seq DeskWithInfo)
screenStateDesksList (EventM ClientName (GenericList ClientName Seq DeskWithInfo) ()
 -> EventM ClientName ScreenDesksState ())
-> EventM ClientName (GenericList ClientName Seq DeskWithInfo) ()
-> EventM ClientName ScreenDesksState ()
forall a b. (a -> b) -> a -> b
$ Event
-> EventM ClientName (GenericList ClientName Seq DeskWithInfo) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n) =>
Event -> EventM n (GenericList n t e) ()
handleListEvent Event
e
            BrickEvent ClientName ClientEvent
_ -> () -> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a. a -> ApplicationT (EventM ClientName ScreenDesksState) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just NewReservationInfo
newReservationInfo ->
          case BrickEvent ClientName ClientEvent
event of
            VtyEvent (EvKey Key
KEnter []) ->
              ClientEvent -> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent (ClientEvent
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> ClientEvent
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$
                Space -> RequestReservationCreate -> ClientEvent
ClientEventSendRequestCreateReservation
                  (ScreenDesksState -> Space
_screenStateDesksSpace ScreenDesksState
s)
                  Route.Reservation.MkRequestReservationCreate
                    { requestReservationCreateDesk :: NameOrIdentifier DeskNameWithContext IdentifierDesk
Route.Reservation.requestReservationCreateDesk = IdentifierDesk
-> NameOrIdentifier DeskNameWithContext IdentifierDesk
forall name identifier.
identifier -> NameOrIdentifier name identifier
Identifier (IdentifierDesk
 -> NameOrIdentifier DeskNameWithContext IdentifierDesk)
-> IdentifierDesk
-> NameOrIdentifier DeskNameWithContext IdentifierDesk
forall a b. (a -> b) -> a -> b
$ String -> IdentifierDesk
forall a. Read a => String -> a
read (String -> IdentifierDesk) -> String -> IdentifierDesk
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ NewReservationInfo -> Text
_newReservationInfoDesk NewReservationInfo
newReservationInfo
                    , requestReservationCreateTimeWindow :: IntervalNonDegenerate UTCTime
Route.Reservation.requestReservationCreateTimeWindow =
                        let toUTC :: Text -> UTCTime
toUTC Text
text =
                              ZonedTime -> UTCTime
T.zonedTimeToUTC
                                T.ZonedTime
                                  { zonedTimeToLocalTime :: LocalTime
T.zonedTimeToLocalTime =
                                      T.LocalTime
                                        { localDay :: Day
T.localDay = ScreenDesksState -> Day
_screenStateDesksPreviewDay ScreenDesksState
s
                                        , localTimeOfDay :: TimeOfDay
T.localTimeOfDay = Maybe TimeOfDay -> TimeOfDay
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe TimeOfDay -> TimeOfDay) -> Maybe TimeOfDay -> TimeOfDay
forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) t. (MonadFail m, ISO8601 t) => String -> m t
T.iso8601ParseM @_ @T.TimeOfDay (String -> Maybe TimeOfDay) -> String -> Maybe TimeOfDay
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
text
                                        }
                                  , zonedTimeZone :: TimeZone
T.zonedTimeZone = ScreenDesksState -> TimeZone
_screenStateDesksTimezone ScreenDesksState
s
                                  }
                         in Interval UTCTime -> IntervalNonDegenerate UTCTime
forall a. Interval a -> IntervalNonDegenerate a
MkIntervalNonDegenerateUnsafe (Interval UTCTime -> IntervalNonDegenerate UTCTime)
-> Interval UTCTime -> IntervalNonDegenerate UTCTime
forall a b. (a -> b) -> a -> b
$
                              MkIntervalUnsafe
                                { intervalStart :: UTCTime
intervalStart = Text -> UTCTime
toUTC (Text -> UTCTime) -> Text -> UTCTime
forall a b. (a -> b) -> a -> b
$ NewReservationInfo -> Text
_newReservationInfoTimeBegin NewReservationInfo
newReservationInfo
                                , intervalEnd :: UTCTime
intervalEnd = Text -> UTCTime
toUTC (Text -> UTCTime) -> Text -> UTCTime
forall a b. (a -> b) -> a -> b
$ NewReservationInfo -> Text
_newReservationInfoTimeEnd NewReservationInfo
newReservationInfo
                                }
                    }
            BrickEvent ClientName ClientEvent
_ -> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventM ClientName ScreenDesksState ()
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed
     (EventM
        ClientName (Form NewReservationInfo ClientEvent ClientName))
     ())
  ScreenDesksState
  (Form NewReservationInfo ClientEvent ClientName)
-> EventM
     ClientName (Form NewReservationInfo ClientEvent ClientName) ()
-> EventM ClientName ScreenDesksState ()
forall c.
LensLike'
  (Zoomed
     (EventM
        ClientName (Form NewReservationInfo ClientEvent ClientName))
     c)
  ScreenDesksState
  (Form NewReservationInfo ClientEvent ClientName)
-> EventM
     ClientName (Form NewReservationInfo ClientEvent ClientName) c
-> EventM ClientName ScreenDesksState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Maybe (Form NewReservationInfo ClientEvent ClientName)
 -> Focusing
      (StateT (EventState ClientName) IO)
      ()
      (Maybe (Form NewReservationInfo ClientEvent ClientName)))
-> ScreenDesksState
-> Focusing (StateT (EventState ClientName) IO) () ScreenDesksState
Lens'
  ScreenDesksState
  (Maybe (Form NewReservationInfo ClientEvent ClientName))
screenStateDesksCreateReservation ((Maybe (Form NewReservationInfo ClientEvent ClientName)
  -> Focusing
       (StateT (EventState ClientName) IO)
       ()
       (Maybe (Form NewReservationInfo ClientEvent ClientName)))
 -> ScreenDesksState
 -> Focusing
      (StateT (EventState ClientName) IO) () ScreenDesksState)
-> ((Form NewReservationInfo ClientEvent ClientName
     -> Focusing
          (StateT (EventState ClientName) IO)
          ()
          (Form NewReservationInfo ClientEvent ClientName))
    -> Maybe (Form NewReservationInfo ClientEvent ClientName)
    -> Focusing
         (StateT (EventState ClientName) IO)
         ()
         (Maybe (Form NewReservationInfo ClientEvent ClientName)))
-> (Form NewReservationInfo ClientEvent ClientName
    -> Focusing
         (StateT (EventState ClientName) IO)
         ()
         (Form NewReservationInfo ClientEvent ClientName))
-> ScreenDesksState
-> Focusing (StateT (EventState ClientName) IO) () ScreenDesksState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Form NewReservationInfo ClientEvent ClientName
 -> Focusing
      (StateT (EventState ClientName) IO)
      ()
      (Form NewReservationInfo ClientEvent ClientName))
-> Maybe (Form NewReservationInfo ClientEvent ClientName)
-> Focusing
     (StateT (EventState ClientName) IO)
     ()
     (Maybe (Form NewReservationInfo ClientEvent ClientName))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just) (EventM
   ClientName (Form NewReservationInfo ClientEvent ClientName) ()
 -> EventM ClientName ScreenDesksState ())
-> EventM
     ClientName (Form NewReservationInfo ClientEvent ClientName) ()
-> EventM ClientName ScreenDesksState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> EventM
     ClientName (Form NewReservationInfo ClientEvent ClientName) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent BrickEvent ClientName ClientEvent
event
    Just NewDeskInfo
newDeskInfo ->
      case BrickEvent ClientName ClientEvent
event of
        VtyEvent (EvKey Key
KEnter []) ->
          ClientEvent -> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *). MonadEvent m => ClientEvent -> m ()
sendEvent (ClientEvent
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> ClientEvent
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$
            Space -> RequestDeskCreate -> ClientEvent
ClientEventSendRequestCreateDesk
              (ScreenDesksState -> Space
_screenStateDesksSpace ScreenDesksState
s)
              Route.Space.MkRequestDeskCreate
                { requestDeskCreateName :: NameDesk
Route.Space.requestDeskCreateName = Text -> NameDesk
MkNameDesk (Text -> NameDesk) -> Text -> NameDesk
forall a b. (a -> b) -> a -> b
$ NewDeskInfo
newDeskInfo NewDeskInfo -> Getting Text NewDeskInfo Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text NewDeskInfo Text
Lens' NewDeskInfo Text
newDeskInfoName
                , requestDeskCreateSpace :: NameOrIdentifier NameSpace IdentifierSpace
Route.Space.requestDeskCreateSpace = IdentifierSpace -> NameOrIdentifier NameSpace IdentifierSpace
forall name identifier.
identifier -> NameOrIdentifier name identifier
Identifier (IdentifierSpace -> NameOrIdentifier NameSpace IdentifierSpace)
-> IdentifierSpace -> NameOrIdentifier NameSpace IdentifierSpace
forall a b. (a -> b) -> a -> b
$ Space -> IdentifierSpace
spaceId (Space -> IdentifierSpace) -> Space -> IdentifierSpace
forall a b. (a -> b) -> a -> b
$ ScreenDesksState -> Space
_screenStateDesksSpace ScreenDesksState
s
                , requestDeskCreateLocation :: Maybe LocationDesk
Route.Space.requestDeskCreateLocation = Maybe LocationDesk
forall a. Maybe a
Nothing
                }
        BrickEvent ClientName ClientEvent
_ -> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall (m :: * -> *) a. Monad m => m a -> ApplicationT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EventM ClientName ScreenDesksState ()
 -> ApplicationT (EventM ClientName ScreenDesksState) ())
-> EventM ClientName ScreenDesksState ()
-> ApplicationT (EventM ClientName ScreenDesksState) ()
forall a b. (a -> b) -> a -> b
$ LensLike'
  (Zoomed
     (EventM ClientName (Form NewDeskInfo ClientEvent ClientName)) ())
  ScreenDesksState
  (Form NewDeskInfo ClientEvent ClientName)
-> EventM ClientName (Form NewDeskInfo ClientEvent ClientName) ()
-> EventM ClientName ScreenDesksState ()
forall c.
LensLike'
  (Zoomed
     (EventM ClientName (Form NewDeskInfo ClientEvent ClientName)) c)
  ScreenDesksState
  (Form NewDeskInfo ClientEvent ClientName)
-> EventM ClientName (Form NewDeskInfo ClientEvent ClientName) c
-> EventM ClientName ScreenDesksState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
zoom ((Maybe (Form NewDeskInfo ClientEvent ClientName)
 -> Focusing
      (StateT (EventState ClientName) IO)
      ()
      (Maybe (Form NewDeskInfo ClientEvent ClientName)))
-> ScreenDesksState
-> Focusing (StateT (EventState ClientName) IO) () ScreenDesksState
Lens'
  ScreenDesksState (Maybe (Form NewDeskInfo ClientEvent ClientName))
screenStateDesksNewDeskForm ((Maybe (Form NewDeskInfo ClientEvent ClientName)
  -> Focusing
       (StateT (EventState ClientName) IO)
       ()
       (Maybe (Form NewDeskInfo ClientEvent ClientName)))
 -> ScreenDesksState
 -> Focusing
      (StateT (EventState ClientName) IO) () ScreenDesksState)
-> ((Form NewDeskInfo ClientEvent ClientName
     -> Focusing
          (StateT (EventState ClientName) IO)
          ()
          (Form NewDeskInfo ClientEvent ClientName))
    -> Maybe (Form NewDeskInfo ClientEvent ClientName)
    -> Focusing
         (StateT (EventState ClientName) IO)
         ()
         (Maybe (Form NewDeskInfo ClientEvent ClientName)))
-> (Form NewDeskInfo ClientEvent ClientName
    -> Focusing
         (StateT (EventState ClientName) IO)
         ()
         (Form NewDeskInfo ClientEvent ClientName))
-> ScreenDesksState
-> Focusing (StateT (EventState ClientName) IO) () ScreenDesksState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Form NewDeskInfo ClientEvent ClientName
 -> Focusing
      (StateT (EventState ClientName) IO)
      ()
      (Form NewDeskInfo ClientEvent ClientName))
-> Maybe (Form NewDeskInfo ClientEvent ClientName)
-> Focusing
     (StateT (EventState ClientName) IO)
     ()
     (Maybe (Form NewDeskInfo ClientEvent ClientName))
forall a a' (f :: * -> *).
Applicative f =>
(a -> f a') -> Maybe a -> f (Maybe a')
_Just) (EventM ClientName (Form NewDeskInfo ClientEvent ClientName) ()
 -> EventM ClientName ScreenDesksState ())
-> EventM ClientName (Form NewDeskInfo ClientEvent ClientName) ()
-> EventM ClientName ScreenDesksState ()
forall a b. (a -> b) -> a -> b
$ BrickEvent ClientName ClientEvent
-> EventM ClientName (Form NewDeskInfo ClientEvent ClientName) ()
forall n e s. Eq n => BrickEvent n e -> EventM n (Form s e n) ()
handleFormEvent BrickEvent ClientName ClientEvent
event

prettyReservations :: T.TimeZone -> T.Day -> [Reservation] -> T.Text
prettyReservations :: TimeZone -> Day -> [Reservation] -> Text
prettyReservations TimeZone
tz Day
day [Reservation]
reservations = String -> Text
T.pack String
out
 where
  [Integer]
hours :: [Integer] = [Integer
0 .. Integer
23]
  [Integer]
minutes :: [Integer] = [Integer
0, Integer
15, Integer
30, Integer
45]
  diffTimes :: [DiffTime]
diffTimes = Integer -> DiffTime
T.secondsToDiffTime (Integer -> DiffTime)
-> (Integer -> Integer) -> Integer -> DiffTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer
60 *) (Integer -> DiffTime) -> [Integer] -> [DiffTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer -> [Integer]) -> [Integer] -> [Integer]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\Integer
hour -> (Integer
hour Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60 +) (Integer -> Integer) -> [Integer] -> [Integer]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Integer]
minutes) [Integer]
hours
  diffTimeWindows :: [(DiffTime, DiffTime)]
diffTimeWindows = [DiffTime] -> [DiffTime] -> [(DiffTime, DiffTime)]
forall a b. [a] -> [b] -> [(a, b)]
zip [DiffTime]
diffTimes ((DiffTime -> DiffTime -> DiffTime
forall a. Num a => a -> a -> a
+ Integer -> DiffTime
T.secondsToDiffTime (Integer
15 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
60)) (DiffTime -> DiffTime) -> [DiffTime] -> [DiffTime]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [DiffTime]
diffTimes)
  toUTC :: DiffTime -> UTCTime
toUTC DiffTime
diffTime =
    ZonedTime -> UTCTime
T.zonedTimeToUTC
      T.ZonedTime
        { zonedTimeToLocalTime :: LocalTime
T.zonedTimeToLocalTime =
            T.LocalTime
              { localDay :: Day
T.localDay = Day
day
              , localTimeOfDay :: TimeOfDay
T.localTimeOfDay = DiffTime -> TimeOfDay
T.timeToTimeOfDay DiffTime
diffTime
              }
        , zonedTimeZone :: TimeZone
T.zonedTimeZone = TimeZone
tz
        }
  utcTimeWindows :: [(UTCTime, UTCTime)]
utcTimeWindows = (DiffTime -> UTCTime)
-> (DiffTime -> UTCTime)
-> (DiffTime, DiffTime)
-> (UTCTime, UTCTime)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap DiffTime -> UTCTime
toUTC DiffTime -> UTCTime
toUTC ((DiffTime, DiffTime) -> (UTCTime, UTCTime))
-> [(DiffTime, DiffTime)] -> [(UTCTime, UTCTime)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(DiffTime, DiffTime)]
diffTimeWindows
  utcTimeWindowReservedByOne :: (UTCTime, UTCTime) -> Reservation -> Bool
utcTimeWindowReservedByOne (UTCTime
begin, UTCTime
end) MkReservation {UTCTime
reservationTimeBegin :: UTCTime
reservationTimeBegin :: Reservation -> UTCTime
reservationTimeBegin, UTCTime
reservationTimeEnd :: UTCTime
reservationTimeEnd :: Reservation -> UTCTime
reservationTimeEnd} =
    UTCTime
reservationTimeBegin UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
< UTCTime
end Bool -> Bool -> Bool
&& UTCTime
reservationTimeEnd UTCTime -> UTCTime -> Bool
forall a. Ord a => a -> a -> Bool
>= UTCTime
begin
  utcTimeWindowReservedByAny :: (UTCTime, UTCTime) -> Bool
utcTimeWindowReservedByAny (UTCTime, UTCTime)
window = (Reservation -> Bool) -> [Reservation] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((UTCTime, UTCTime) -> Reservation -> Bool
utcTimeWindowReservedByOne (UTCTime, UTCTime)
window) [Reservation]
reservations
  reserved :: [Bool]
reserved = (UTCTime, UTCTime) -> Bool
utcTimeWindowReservedByAny ((UTCTime, UTCTime) -> Bool) -> [(UTCTime, UTCTime)] -> [Bool]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(UTCTime, UTCTime)]
utcTimeWindows
  markers :: String
markers = (\Bool
x -> if Bool
x then Char
'▀' else Char
' ') (Bool -> Char) -> [Bool] -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Bool]
reserved
  out :: String
out =
    [String] -> String
unlines
      [ String
"0   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15  16  17  18  19  20  21  22  23  24"
      , String
"┠───┴───┴───┼───┴───┴───╂───┴───┴───┼───┴───┴───╂───┴───┴───┼───┴───┴───╂───┴───┴───┼───┴───┴───┨"
      , String
markers
      ]