{-
 *  Programmer:	Piotr Borek
 *  E-mail:     piotrborek@op.pl
 *  Copyright 2016 Piotr Borek
 *
 *  Distributed under the terms of the GPL (GNU Public License)
 *
 *  This program is free software; you can redistribute it and/or modify
 *  it under the terms of the GNU General Public License as published by
 *  the Free Software Foundation; either version 2 of the License, or
 *  (at your option) any later version.
 *
 *  This program is distributed in the hope that it will be useful,
 *  but WITHOUT ANY WARRANTY; without even the implied warranty of
 *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 *  GNU General Public License for more details.
 *
 *  You should have received a copy of the GNU General Public License
 *  along with this program; if not, write to the Free Software
 *  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ImplicitParams   #-}
{-# LANGUAGE ViewPatterns     #-}

module Simple.UI.Core.UIApp (
    runUIApp,
    runMainLoop,
    runDialogLoop,
    mainLoopQuit,
    mainSchedule,
    mainScheduleAfter,
    mainScheduleRepeat,
    -- reexports
    UIApp,
    UIApp',
    UIAppEvent (..),
    liftUIApp,
    liftUIApp',
    appUserData,
    uniqueIdNew
) where

import           Control.Concurrent
import           Control.Concurrent.STM
import           Control.Lens
import           Control.Monad
import           Control.Monad.Catch
import           Control.Monad.IO.Class
import           Data.Maybe
import           GHC.Stack
import qualified Graphics.Vty                  as Vty

import           Simple.UI.Core.Draw
import           Simple.UI.Core.Internal.UIApp
import           Simple.UI.Core.ListenerList
import           Simple.UI.Widgets.Widget
import           Simple.UI.Widgets.Window

-- core functions

newtype UIAppException = UIAppWindowIsNotTopLevelException CallStack

instance Show UIAppException where
    show :: UIAppException -> String
show (UIAppWindowIsNotTopLevelException CallStack
stack) = String
"UIAppWindowIsNotTopLevelException\n\n" String -> ShowS
forall a. [a] -> [a] -> [a]
++ CallStack -> String
prettyCallStack CallStack
stack

instance Exception UIAppException

runUIApp :: u -> UIApp u () -> IO ()
runUIApp :: u -> UIApp u () -> IO ()
runUIApp u
userData UIApp u ()
app = do
    AppConfig u
appConfig <- IO (AppConfig u)
initAppConfig
    AppState
appState  <- IO AppState
initAppState

    IO ((), AppState) -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ((), AppState) -> IO ()) -> IO ((), AppState) -> IO ()
forall a b. (a -> b) -> a -> b
$ AppConfig u -> AppState -> UIApp u () -> IO ((), AppState)
forall (m :: * -> *) u a.
MonadIO m =>
AppConfig u -> AppState -> UIApp u a -> m (a, AppState)
_runUIApp AppConfig u
appConfig AppState
appState UIApp u ()
app IO ((), AppState) -> IO () -> IO ((), AppState)
forall (m :: * -> *) a b. MonadMask m => m a -> m b -> m a
`finally` Vty -> IO ()
Vty.shutdown (AppConfig u
appConfig AppConfig u -> Getting Vty (AppConfig u) Vty -> Vty
forall s a. s -> Getting a s a -> a
^. Getting Vty (AppConfig u) Vty
forall u. Lens' (AppConfig u) Vty
appVty)
  where
    initAppConfig :: IO (AppConfig u)
initAppConfig = do
        Config
c <- IO Config -> IO Config
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Config
Vty.standardIOConfig
        Vty
v <- IO Vty -> IO Vty
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Vty -> IO Vty) -> IO Vty -> IO Vty
forall a b. (a -> b) -> a -> b
$ Config -> IO Vty
Vty.mkVty Config
c
        TChan UIAppEvent
tasks <- IO (TChan UIAppEvent) -> IO (TChan UIAppEvent)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (TChan UIAppEvent) -> IO (TChan UIAppEvent))
-> IO (TChan UIAppEvent) -> IO (TChan UIAppEvent)
forall a b. (a -> b) -> a -> b
$ STM (TChan UIAppEvent) -> IO (TChan UIAppEvent)
forall a. STM a -> IO a
atomically STM (TChan UIAppEvent)
forall a. STM (TChan a)
newTChan
        IO () -> IO ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Output -> IO ()
Vty.hideCursor (Vty -> Output
Vty.outputIface Vty
v)
        AppConfig u -> IO (AppConfig u)
forall (m :: * -> *) a. Monad m => a -> m a
return AppConfig :: forall u. Vty -> TChan UIAppEvent -> u -> AppConfig u
AppConfig
            { _appVty :: Vty
_appVty = Vty
v
            , _appTasks :: TChan UIAppEvent
_appTasks = TChan UIAppEvent
tasks
            , _appUserData :: u
_appUserData = u
userData
            }

    initAppState :: IO AppState
initAppState = do
        Drawing
d <- Int -> Int -> IO Drawing
forall (m :: * -> *). MonadIO m => Int -> Int -> m Drawing
drawingNew Int
0 Int
0
        AppState -> IO AppState
forall (m :: * -> *) a. Monad m => a -> m a
return AppState :: Integer -> Int -> Int -> Drawing -> Maybe Widget -> AppState
AppState
            { _appIdCounter :: Integer
_appIdCounter = Integer
0
            , _appWidth :: Int
_appWidth     = Int
0
            , _appHeight :: Int
_appHeight    = Int
0
            , _appDrawing :: Drawing
_appDrawing   = Drawing
d
            , _appRoot :: Maybe Widget
_appRoot      = Maybe Widget
forall a. Maybe a
Nothing
            }

runMainLoop :: (HasCallStack, WindowClass w) => w a -> UIApp u ()
runMainLoop :: w a -> UIApp u ()
runMainLoop (w a -> Window a
forall (w :: * -> *) a. WindowClass w => w a -> Window a
castToWindow -> Window a
root) = do
    Bool -> UIApp u () -> UIApp u ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Window a -> WindowType
forall (w :: * -> *) a.
(WindowClass w, WindowClass w) =>
w a -> WindowType
windowType Window a
root WindowType -> WindowType -> Bool
forall a. Eq a => a -> a -> Bool
/= WindowType
WindowTypeTopLevel) (UIApp u () -> UIApp u ()) -> UIApp u () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ UIAppException -> UIApp u ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (UIAppException -> UIApp u ()) -> UIAppException -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ CallStack -> UIAppException
UIAppWindowIsNotTopLevelException ?callStack::CallStack
CallStack
?callStack

    (Maybe Widget -> Identity (Maybe Widget))
-> AppState -> Identity AppState
Lens' AppState (Maybe Widget)
appRoot ((Maybe Widget -> Identity (Maybe Widget))
 -> AppState -> Identity AppState)
-> Maybe Widget -> UIApp u ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Widget -> Maybe Widget
forall a. a -> Maybe a
Just (Widget -> Maybe Widget) -> Widget -> Maybe Widget
forall a b. (a -> b) -> a -> b
$ Window a -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget Window a
root)

    Vty
vty <- Getting Vty (AppConfig u) Vty
-> ReaderT (AppConfig u) (StateT AppState IO) Vty
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Vty (AppConfig u) Vty
forall u. Lens' (AppConfig u) Vty
appVty
    TChan UIAppEvent
tasks <- Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
-> ReaderT (AppConfig u) (StateT AppState IO) (TChan UIAppEvent)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
forall u. Lens' (AppConfig u) (TChan UIAppEvent)
appTasks

    (Int
width, Int
height) <- IO (Int, Int)
-> ReaderT (AppConfig u) (StateT AppState IO) (Int, Int)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Int, Int)
 -> ReaderT (AppConfig u) (StateT AppState IO) (Int, Int))
-> IO (Int, Int)
-> ReaderT (AppConfig u) (StateT AppState IO) (Int, Int)
forall a b. (a -> b) -> a -> b
$ Output -> IO (Int, Int)
Vty.displayBounds (Vty -> Output
Vty.outputIface Vty
vty)
    Int -> Int -> UIApp u ()
forall u. Int -> Int -> UIApp u ()
mainResize Int
width Int
height
    UIApp u ()
forall u. UIApp u ()
mainDraw

    TChan UIAppEvent -> Vty -> UIApp u ()
forall (m :: * -> *). MonadIO m => TChan UIAppEvent -> Vty -> m ()
mainEventThreadRun TChan UIAppEvent
tasks Vty
vty
    Window a -> UIApp u ()
forall w u. WidgetClass w => w -> UIApp u ()
runDialogLoop Window a
root

mainEventThreadRun :: MonadIO m => UIAppTasks -> Vty.Vty -> m ()
mainEventThreadRun :: TChan UIAppEvent -> Vty -> m ()
mainEventThreadRun TChan UIAppEvent
tasks Vty
vty = m ThreadId -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m ThreadId -> m ()) -> m ThreadId -> m ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> m ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId -> m ThreadId) -> IO ThreadId -> m ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    Event
event <- Vty -> IO Event
Vty.nextEvent Vty
vty
    case Event
event of
        Vty.EvKey Key
key [Modifier]
modifiers   -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan UIAppEvent -> UIAppEvent -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan UIAppEvent
tasks (UIAppEvent -> STM ()) -> UIAppEvent -> STM ()
forall a b. (a -> b) -> a -> b
$ Key -> [Modifier] -> UIAppEvent
UIAppEventKeyPressed Key
key [Modifier]
modifiers
        Vty.EvResize Int
width Int
height -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan UIAppEvent -> UIAppEvent -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan UIAppEvent
tasks (UIAppEvent -> STM ()) -> UIAppEvent -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> UIAppEvent
UIAppEventResize Int
width Int
height
        Event
_                         -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

mainDraw :: UIApp u ()
mainDraw :: UIApp u ()
mainDraw = do
    Widget
root <- Maybe Widget -> Widget
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust (Maybe Widget -> Widget)
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe Widget)
-> ReaderT (AppConfig u) (StateT AppState IO) Widget
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting (Maybe Widget) AppState (Maybe Widget)
-> ReaderT (AppConfig u) (StateT AppState IO) (Maybe Widget)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Widget) AppState (Maybe Widget)
Lens' AppState (Maybe Widget)
appRoot
    Vty
vty <- Getting Vty (AppConfig u) Vty
-> ReaderT (AppConfig u) (StateT AppState IO) Vty
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Vty (AppConfig u) Vty
forall u. Lens' (AppConfig u) Vty
appVty

    Drawing
drawing <- Getting Drawing AppState Drawing
-> ReaderT (AppConfig u) (StateT AppState IO) Drawing
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Drawing AppState Drawing
Lens' AppState Drawing
appDrawing
    (Int
width, Int
height) <- Drawing
-> DrawingBuilder (Int, Int)
-> ReaderT (AppConfig u) (StateT AppState IO) (Int, Int)
forall (m :: * -> *) a.
MonadIO m =>
Drawing -> DrawingBuilder a -> m a
drawingRun Drawing
drawing DrawingBuilder (Int, Int)
drawingGetSize

    Widget
-> (Widget -> ListenerList (Drawing -> Int -> Int -> UIApp' ()))
-> (Drawing, Int, Int)
-> UIApp u ()
forall a b w u.
Fire a b =>
w -> (w -> ListenerList a) -> b -> UIApp u ()
fire Widget
root Widget -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Drawing -> Int -> Int -> UIApp' ())
draw (Drawing
drawing, Int
width, Int
height)

    Picture
pic <- Drawing -> ReaderT (AppConfig u) (StateT AppState IO) Picture
forall (m :: * -> *). MonadIO m => Drawing -> m Picture
drawingToPicture Drawing
drawing
    IO () -> UIApp u ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> UIApp u ()) -> IO () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ Vty -> Picture -> IO ()
Vty.update Vty
vty Picture
pic

mainResize :: Int -> Int -> UIApp u ()
mainResize :: Int -> Int -> UIApp u ()
mainResize Int
width Int
height = do
    Drawing
d <- Int -> Int -> ReaderT (AppConfig u) (StateT AppState IO) Drawing
forall (m :: * -> *). MonadIO m => Int -> Int -> m Drawing
drawingNew Int
width Int
height
    (Int -> Identity Int) -> AppState -> Identity AppState
Lens' AppState Int
appWidth ((Int -> Identity Int) -> AppState -> Identity AppState)
-> Int -> UIApp u ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
width
    (Int -> Identity Int) -> AppState -> Identity AppState
Lens' AppState Int
appHeight ((Int -> Identity Int) -> AppState -> Identity AppState)
-> Int -> UIApp u ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Int
height
    (Drawing -> Identity Drawing) -> AppState -> Identity AppState
Lens' AppState Drawing
appDrawing ((Drawing -> Identity Drawing) -> AppState -> Identity AppState)
-> Drawing -> UIApp u ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Drawing
d

runDialogLoop :: WidgetClass w => w -> UIApp u ()
runDialogLoop :: w -> UIApp u ()
runDialogLoop (w -> Widget
forall w. WidgetClass w => w -> Widget
castToWidget -> Widget
widget) = do
    Vty
vty <- Getting Vty (AppConfig u) Vty
-> ReaderT (AppConfig u) (StateT AppState IO) Vty
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Vty (AppConfig u) Vty
forall u. Lens' (AppConfig u) Vty
appVty
    TChan UIAppEvent
tasks <- Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
-> ReaderT (AppConfig u) (StateT AppState IO) (TChan UIAppEvent)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
forall u. Lens' (AppConfig u) (TChan UIAppEvent)
appTasks
    Vty -> TChan UIAppEvent -> UIApp u ()
dialogLoop Vty
vty TChan UIAppEvent
tasks
  where
    dialogLoop :: Vty -> TChan UIAppEvent -> UIApp u ()
dialogLoop Vty
vty TChan UIAppEvent
tasks = do
        UIAppEvent
event <- IO UIAppEvent
-> ReaderT (AppConfig u) (StateT AppState IO) UIAppEvent
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO UIAppEvent
 -> ReaderT (AppConfig u) (StateT AppState IO) UIAppEvent)
-> (STM UIAppEvent -> IO UIAppEvent)
-> STM UIAppEvent
-> ReaderT (AppConfig u) (StateT AppState IO) UIAppEvent
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM UIAppEvent -> IO UIAppEvent
forall a. STM a -> IO a
atomically (STM UIAppEvent
 -> ReaderT (AppConfig u) (StateT AppState IO) UIAppEvent)
-> STM UIAppEvent
-> ReaderT (AppConfig u) (StateT AppState IO) UIAppEvent
forall a b. (a -> b) -> a -> b
$ TChan UIAppEvent -> STM UIAppEvent
forall a. TChan a -> STM a
readTChan TChan UIAppEvent
tasks

        case UIAppEvent
event of
            UIAppEventResize Int
width Int
height      -> Int -> Int -> UIApp u ()
forall u. Int -> Int -> UIApp u ()
mainResize Int
width Int
height
            UIAppEventKeyPressed Key
key [Modifier]
modifiers -> Widget
-> (Widget -> ListenerList (Key -> [Modifier] -> UIApp' ()))
-> (Key, [Modifier])
-> UIApp u ()
forall a b w u.
Fire a b =>
w -> (w -> ListenerList a) -> b -> UIApp u ()
fire Widget
widget Widget -> ListenerList (Key -> [Modifier] -> UIApp' ())
forall w.
WidgetClass w =>
w -> ListenerList (Key -> [Modifier] -> UIApp' ())
keyPressed (Key
key, [Modifier]
modifiers)
            UIAppEventAction UIApp' ()
action            -> UIApp' () -> UIApp u ()
forall a u. UIApp' a -> UIApp u a
liftUIApp' UIApp' ()
action
            UIAppEvent
UIAppEventQuit                     -> () -> UIApp u ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

        UIApp u ()
forall u. UIApp u ()
mainDraw

        if UIAppEvent
event UIAppEvent -> UIAppEvent -> Bool
forall a. Eq a => a -> a -> Bool
== UIAppEvent
UIAppEventQuit
            then () -> UIApp u ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            else Vty -> TChan UIAppEvent -> UIApp u ()
dialogLoop Vty
vty TChan UIAppEvent
tasks

mainLoopQuit :: UIApp u ()
mainLoopQuit :: UIApp u ()
mainLoopQuit = do
    TChan UIAppEvent
tasks <- Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
-> ReaderT (AppConfig u) (StateT AppState IO) (TChan UIAppEvent)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
forall u. Lens' (AppConfig u) (TChan UIAppEvent)
appTasks
    IO () -> UIApp u ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> UIApp u ()) -> (STM () -> IO ()) -> STM () -> UIApp u ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> UIApp u ()) -> STM () -> UIApp u ()
forall a b. (a -> b) -> a -> b
$ TChan UIAppEvent -> UIAppEvent -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan UIAppEvent
tasks UIAppEvent
UIAppEventQuit

mainSchedule :: UIApp' () -> UIApp u ()
mainSchedule :: UIApp' () -> UIApp u ()
mainSchedule UIApp' ()
action = do
    TChan UIAppEvent
tasks <- Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
-> ReaderT (AppConfig u) (StateT AppState IO) (TChan UIAppEvent)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
forall u. Lens' (AppConfig u) (TChan UIAppEvent)
appTasks
    TChan UIAppEvent -> UIApp' () -> UIApp u ()
forall (m :: * -> *).
MonadIO m =>
TChan UIAppEvent -> UIApp' () -> m ()
mainSchedule' TChan UIAppEvent
tasks UIApp' ()
action

mainSchedule' :: MonadIO m => UIAppTasks -> UIApp' () -> m ()
mainSchedule' :: TChan UIAppEvent -> UIApp' () -> m ()
mainSchedule' TChan UIAppEvent
tasks UIApp' ()
action = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TChan UIAppEvent -> UIAppEvent -> STM ()
forall a. TChan a -> a -> STM ()
writeTChan TChan UIAppEvent
tasks (UIAppEvent -> STM ()) -> UIAppEvent -> STM ()
forall a b. (a -> b) -> a -> b
$ UIApp' () -> UIAppEvent
UIAppEventAction UIApp' ()
action

mainScheduleAfter :: Int -> UIApp' () -> UIApp u ()
mainScheduleAfter :: Int -> UIApp' () -> UIApp u ()
mainScheduleAfter Int
timeInMillis UIApp' ()
action = do
    TChan UIAppEvent
tasks <- Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
-> ReaderT (AppConfig u) (StateT AppState IO) (TChan UIAppEvent)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
forall u. Lens' (AppConfig u) (TChan UIAppEvent)
appTasks
    ReaderT (AppConfig u) (StateT AppState IO) ThreadId -> UIApp u ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (AppConfig u) (StateT AppState IO) ThreadId -> UIApp u ())
-> ReaderT (AppConfig u) (StateT AppState IO) ThreadId
-> UIApp u ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> ReaderT (AppConfig u) (StateT AppState IO) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId
 -> ReaderT (AppConfig u) (StateT AppState IO) ThreadId)
-> IO ThreadId
-> ReaderT (AppConfig u) (StateT AppState IO) ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
        Int -> IO ()
threadDelay (Int
timeInMillis Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)
        TChan UIAppEvent -> UIApp' () -> IO ()
forall (m :: * -> *).
MonadIO m =>
TChan UIAppEvent -> UIApp' () -> m ()
mainSchedule' TChan UIAppEvent
tasks UIApp' ()
action

mainScheduleRepeat :: Int -> UIApp' () -> UIApp u ()
mainScheduleRepeat :: Int -> UIApp' () -> UIApp u ()
mainScheduleRepeat Int
timeInMillis UIApp' ()
action = do
    TChan UIAppEvent
tasks <- Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
-> ReaderT (AppConfig u) (StateT AppState IO) (TChan UIAppEvent)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting (TChan UIAppEvent) (AppConfig u) (TChan UIAppEvent)
forall u. Lens' (AppConfig u) (TChan UIAppEvent)
appTasks
    ReaderT (AppConfig u) (StateT AppState IO) ThreadId -> UIApp u ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT (AppConfig u) (StateT AppState IO) ThreadId -> UIApp u ())
-> ReaderT (AppConfig u) (StateT AppState IO) ThreadId
-> UIApp u ()
forall a b. (a -> b) -> a -> b
$ IO ThreadId -> ReaderT (AppConfig u) (StateT AppState IO) ThreadId
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO ThreadId
 -> ReaderT (AppConfig u) (StateT AppState IO) ThreadId)
-> IO ThreadId
-> ReaderT (AppConfig u) (StateT AppState IO) ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        TChan UIAppEvent -> UIApp' () -> IO ()
forall (m :: * -> *).
MonadIO m =>
TChan UIAppEvent -> UIApp' () -> m ()
mainSchedule' TChan UIAppEvent
tasks UIApp' ()
action
        Int -> IO ()
threadDelay (Int
timeInMillis Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1000)