UIApp.hs

{-
 *  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 RankNTypes      #-}
{-# LANGUAGE TemplateHaskell #-}

module Simple.UI.Core.Internal.UIApp where

import qualified Graphics.Vty                     as Vty

import           Control.Concurrent.STM
import           Control.Lens
import           Control.Monad.IO.Class
import           Control.Monad.State.Class
import           Control.Monad.Trans.Reader
import           Control.Monad.Trans.State.Strict hiding (get, put)

import           Simple.UI.Core.Draw

import {-# SOURCE #-} Simple.UI.Widgets.Widget


type UIApp u = ReaderT (AppConfig u) (StateT AppState IO)

type UIApp' = UIApp ()

data UIAppEvent = UIAppEventResize Int Int
                | UIAppEventKeyPressed Vty.Key [Vty.Modifier]
                | UIAppEventAction (UIApp' ())
                | UIAppEventQuit

type UIAppTasks = TChan UIAppEvent

data AppConfig u = AppConfig
    { _appVty      :: Vty.Vty
    , _appTasks    :: UIAppTasks
    , _appUserData :: u
    }

data AppState = AppState
    { _appIdCounter :: Integer
    , _appWidth     :: Int
    , _appHeight    :: Int
    , _appDrawing   :: Drawing
    , _appRoot      :: Maybe Widget
    }

makeLenses ''AppConfig
makeLenses ''AppState

instance Eq UIAppEvent where
    UIAppEventQuit == UIAppEventQuit = True
    _ == _ = False

uniqueIdNew :: UIApp u Integer
uniqueIdNew = appIdCounter <+= 1

_runUIApp :: MonadIO m => AppConfig u -> AppState -> UIApp u a -> m (a, AppState)
_runUIApp initConfig initState app = liftIO $ runStateT (runReaderT app initConfig) initState

liftUIApp' :: UIApp' a -> UIApp u a
liftUIApp' app = do
    s <- get
    r <- ask
    (x, s') <- _runUIApp (newConf r) s app
    put s'
    return x
  where
    newConf :: AppConfig u -> AppConfig ()
    newConf conf = AppConfig
        { _appVty = _appVty conf
        , _appTasks = _appTasks conf
        , _appUserData = undefined
        }

liftUIApp :: u -> UIApp u a -> UIApp' a
liftUIApp userData app = do
    s <- get
    r <- ask

    let appConf = AppConfig
            { _appVty = _appVty r
            , _appTasks = _appTasks r
            , _appUserData = userData
        }

    (x, s') <- _runUIApp appConf s app
    put s'
    return x