Engine.hs

{-# LANGUAGE
    ExistentialQuantification,
    Rank2Types
  #-}

-- | Functions for starting QML engines, displaying content in a window.
module Graphics.QML.Engine (
  InitialWindowState(
    ShowWindow,
    ShowWindowWithTitle,
    HideWindow),
  EngineConfig(
    EngineConfig,
    initialURL,
    initialWindowState,
    contextObject),
  defaultEngineConfig,
  createEngine,
  runEngines,
  filePathToURI
) where

import Graphics.QML.Internal.Marshal
import Graphics.QML.Internal.Objects
import Graphics.QML.Internal.Engine
import Graphics.QML.Marshal
import Graphics.QML.Objects

import Data.List
import Data.Maybe
import Data.Typeable
import Foreign.Storable
import System.FilePath (isAbsolute, splitDirectories, pathSeparators)
import Network.URI (URI(URI), URIAuth(URIAuth), nullURI, uriPath)

-- | Specifies the intial state of the display window.
data InitialWindowState
  -- | A visible window should be created for the initial document with a
  -- default title.
  = ShowWindow
  -- | A visible window should be created for the initial document with the
  -- given title.
  | ShowWindowWithTitle String
  -- | A window should be created for the initial document, but it will remain
  -- hidden until made visible by the QML script.
  | HideWindow

-- | Holds parameters for configuring a QML runtime engine.
data EngineConfig a = EngineConfig {
  -- | URL for the first QML document to be loaded.
  initialURL         :: URI,
  -- | Window state for the initial QML document.
  initialWindowState :: InitialWindowState,
  -- | Context 'Object' made available to QML script code.
  contextObject      :: Maybe (ObjRef a)
}

-- | Default engine configuration. Loads @\"main.qml\"@ from the current
-- working directory into a visible window with no context object.
defaultEngineConfig :: EngineConfig a
defaultEngineConfig = EngineConfig {
  initialURL         = nullURI {uriPath = "main.qml"},
  initialWindowState = ShowWindow,
  contextObject      = Nothing
}

isWindowShown :: InitialWindowState -> Bool
isWindowShown ShowWindow = True
isWindowShown (ShowWindowWithTitle _) = True
isWindowShown HideWindow = False

getWindowTitle :: InitialWindowState -> Maybe String
getWindowTitle (ShowWindowWithTitle t) = Just t
getWindowTitle _ = Nothing

-- | Create a QML engine from a specification of its configuration.
createEngine :: (Object a) => EngineConfig a -> IO ()
createEngine config = do
  hsqmlInit
  let hndl = fmap (\(ObjRef h) -> h) $ contextObject config
      url = initialURL config
      state = initialWindowState config
      showWin = isWindowShown state
      maybeTitle = getWindowTitle state
      setTitle = isJust maybeTitle
      titleStr = fromMaybe "" maybeTitle
  mOutAlloc url $ \urlPtr -> do
    mOutAlloc titleStr $ \titlePtr -> do
      hsqmlCreateEngine hndl urlPtr showWin setTitle titlePtr

-- | Enters the Qt event loop and runs until all engines have terminated.
runEngines :: IO ()
runEngines = do
  hsqmlInit
  hsqmlRun

-- | Convenience function for converting local file paths into URIs.
filePathToURI :: FilePath -> URI
filePathToURI fp =
    let ds = splitDirectories fp
        abs = isAbsolute fp
        fixHead =
            (\cs -> if null cs then [] else '/':cs) .
            takeWhile (\c -> not $ c `elem` pathSeparators)
        mapHead _ [] = []
        mapHead f (x:xs) = f x : xs
        afp = intercalate "/" $ mapHead fixHead ds
        rfp = intercalate "/" ds
    in if abs
       then URI "file:" (Just $ URIAuth "" "" "") afp "" ""
       else URI "" Nothing rfp "" ""