{-# OPTIONS_GHC -fno-warn-missing-signatures -fno-warn-unused-matches #-} module MustacheTemplates where import Data.Monoid import Data.Text.Buildable (build) import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TL import Records haskadesBindinghsc escapeFunction ctx@(Template {headerPath=headerPath, modul=modul, toUItypes=toUItypes, toUI=toUI, fromUI=fromUI}) = mconcat [ {-# LINE 1 "HaskadesBinding.hsc.mustache" #-} build "{", {-# LINE 1 "HaskadesBinding.hsc.mustache" #-} build "-# LANGUAGE ForeignFunctionInterface #-}\n", {-# LINE 2 "HaskadesBinding.hsc.mustache" #-} build "{", {-# LINE 2 "HaskadesBinding.hsc.mustache" #-} build "-# OPTIONS_GHC -fno-warn-unused-imports #-}\nmodule HaskadesBinding (\n#ifdef USE_SENSORS\n\tAccelerationMode,\n\tAxesOrientationMode,\n\taccelerometerStart,\n#endif\n\thaskadesRun,\n\temit\n) where\n\n#include \"", {-# LINE 13 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build headerPath, {-# LINE 13 "HaskadesBinding.hsc.mustache" #-} build "\"\n\nimport Control.Applicative (pure, (<*>))\nimport Control.Monad (when, ap, join, forever)\nimport Control.Monad.IO.Class (MonadIO, liftIO)\nimport Control.Concurrent (forkIO, killThread)\nimport System.Exit (exitWith, ExitCode(ExitFailure))\n\nimport Foreign.Storable\nimport Foreign.C.Types\nimport Foreign.C.String\nimport Foreign.Ptr\n\nimport Data.Time.Clock (UTCTime)\nimport Data.Time.Clock.POSIX (posixSecondsToUTCTime, utcTimeToPOSIXSeconds)\nimport qualified Data.Text as Text\nimport qualified Data.Text.Encoding as Text\nimport qualified Data.Text.Lazy as LText\nimport qualified Data.Text.Lazy.Encoding as LText\nimport qualified Data.ByteString as ByteString\n\nimport ", {-# LINE 34 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build modul, {-# LINE 34 "HaskadesBinding.hsc.mustache" #-} build "\n\nforeign import ccall safe \"haskades_run.cpp haskades_run\"\n\tc_haskades_run ::\n\tCString ->\n\t-- ^ QML file to load and render\n\tIO CInt\n\nforeign import ccall unsafe \"haskades_run.cpp emit_ToUIEvent\"\n\tc_emit_ToUIEvent ::\n\tCInt -> ", {-# LINE 44 "HaskadesBinding.hsc.mustache" #-} mconcat $ map (toUItypes0 escapeFunction) toUItypes, {-# LINE 45 "HaskadesBinding.hsc.mustache" #-} build "\tIO ()\n\nforeign import ccall safe \"haskades_run.cpp pop_SignalFromUI\"\n\tc_pop_SignalFromUI ::\n\tIO (Ptr SignalFromUI)\n\nemit :: (MonadIO m) => SignalToUI -> m ()\n", {-# LINE 52 "HaskadesBinding.hsc.mustache" #-} mconcat $ map (toUI1 escapeFunction) toUI, {-# LINE 58 "HaskadesBinding.hsc.mustache" #-} build "\npopSignalFromUI :: (MonadIO m) => m SignalFromUI\npopSignalFromUI = liftIO (c_pop_SignalFromUI >>= peekFromUI)\n\npeekFromUI :: Ptr SignalFromUI -> IO SignalFromUI\npeekFromUI ptr = do\n\ttag <- #", {-# LINE 64 "HaskadesBinding.hsc.mustache" #-} build "{", {-# LINE 64 "HaskadesBinding.hsc.mustache" #-} build "peek struct SignalFromUI, tag} ptr\n\tcase (tag :: CInt) of\n", {-# LINE 66 "HaskadesBinding.hsc.mustache" #-} mconcat $ map (fromUI4 escapeFunction) fromUI, {-# LINE 71 "HaskadesBinding.hsc.mustache" #-} build "\t\t_ -> error \"Corrupt SignalFromUI in peekFromUI (HaskadesBinding)\"\n\nhaskadesRun :: (MonadIO m) => String -> (SignalFromUI -> IO ()) -> m ()\nhaskadesRun qmlPath handler = liftIO $ do\n\n\tthreadId <- forkIO (forever $ popSignalFromUI >>= handler)\n\n\tcode <- ByteString.useAsCString (Text.encodeUtf8 $ Text.pack qmlPath) (\\qmlPath ->\n\t\t\tc_haskades_run qmlPath\n\t\t)\n\n\tkillThread threadId\n\n\twhen (code /= 0) (exitWith $ ExitFailure $ fromIntegral code)\n\treturn ()\n\n#ifdef USE_SENSORS\ndata AccelerationMode = AccelerationGravity | AccelerationUser | AccelerationCombined deriving (Show, Read, Eq, Enum)\ndata AxesOrientationMode = AxesOrientationFixed | AxesOrientationAutomatic | AxesOrientationUser deriving (Show, Read, Eq, Enum)\n\nforeign import ccall \"wrapper\" _wrap_accelerometerCallback :: (CDouble -> CDouble -> CDouble -> IO CInt) -> IO (FunPtr (CDouble -> CDouble -> CDouble -> IO CInt))\n\nforeign import ccall safe \"haskades_run.cpp accelerometer_start\"\n\tc_accelerometer_start ::\n\tCInt -> CInt -> FunPtr (CDouble -> CDouble -> CDouble -> IO CInt) ->\n\tIO ()\n\nenumToCInt :: (Enum a) => a -> CInt\nenumToCInt = fromIntegral . fromEnum\n\naccelerometerStart :: AccelerationMode -> AxesOrientationMode -> ((Double, Double, Double) -> IO Bool) -> IO ()\naccelerometerStart accelM axesM cb = _wrap_accelerometerCallback cb' >>= c_accelerometer_start (enumToCInt accelM) (enumToCInt axesM)\n\twhere\n\tcb' x y z = fmap enumToCInt $ cb $! (realToFrac $! x, realToFrac $! y, realToFrac $! z)\n#endif\n" ] where toUItypes0 escapeFunction ctx@(SignalType {csigtype=csigtype, qtsigtype=qtsigtype, qtwrapsig=qtwrapsig, lowcsigtype=lowcsigtype, sigtypename=sigtypename}) = mconcat [ {-# LINE 44 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build csigtype, {-# LINE 44 "HaskadesBinding.hsc.mustache" #-} build " -> " ] toUI1 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} build "emit (", {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} build " ", {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} mconcat $ map (sigargs2 escapeFunction) sigargs, {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} build ") = liftIO (\n\t\t", {-# LINE 54 "HaskadesBinding.hsc.mustache" #-} if mempty /= sigcwrap then sigcwrap3 escapeFunction ctx else mempty, {-# LINE 55 "HaskadesBinding.hsc.mustache" #-} build "\t\t(c_emit_ToUIEvent ", {-# LINE 55 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigevent, {-# LINE 55 "HaskadesBinding.hsc.mustache" #-} build ")\n\t)\n" ] where sigargs2 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build siganame, {-# LINE 53 "HaskadesBinding.hsc.mustache" #-} build " " ] sigcwrap3 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 54 "HaskadesBinding.hsc.mustache" #-} build "(", {-# LINE 54 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigcwrap, {-# LINE 54 "HaskadesBinding.hsc.mustache" #-} build ")" ] fromUI4 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 67 "HaskadesBinding.hsc.mustache" #-} build "\t\t", {-# LINE 67 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigevent, {-# LINE 67 "HaskadesBinding.hsc.mustache" #-} build " ->\n\t\t\tpure ", {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} mconcat $ map (sigargs5 escapeFunction) sigargs, {-# LINE 69 "HaskadesBinding.hsc.mustache" #-} build "\n" ] where sigargs5 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build " <*> ((", {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigargfromc, {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build ") (#", {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build "{", {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build "peek struct SignalFromUI, ", {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build ".", {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build siganame, {-# LINE 68 "HaskadesBinding.hsc.mustache" #-} build "} ptr))" ] haskades_runcpp escapeFunction ctx@(Template {headerPath=headerPath, modul=modul, toUItypes=toUItypes, toUI=toUI, fromUI=fromUI}) = mconcat [ {-# LINE 1 "haskades_run.cpp.mustache" #-} build "#include \n#include \n#include \n\n#include \n#include \n#include \n\n#include \n#include \n#include \n\n#ifdef USE_SENSORS\n#include \n#endif\n\n#ifdef USE_NOTIFICATIONS\n#include \n#include \n#endif\n\n#include \"", {-# LINE 22 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build headerPath, {-# LINE 22 "haskades_run.cpp.mustache" #-} build "\"\n\nQEvent::Type toUIEventType;\n\ntemplate class ThreadSafeQueue ", {-# LINE 26 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 26 "haskades_run.cpp.mustache" #-} build "\npublic:\n\tThreadSafeQueue() : semFree(32), semUsed(0) ", {-# LINE 28 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 28 "haskades_run.cpp.mustache" #-} build " }\n\n\tvoid enqueue(const T &value) ", {-# LINE 30 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 30 "haskades_run.cpp.mustache" #-} build "\n\t\tsemFree.acquire(1);\n\t\tmutex.lock();\n\t\tqueue.enqueue(value);\n\t\tmutex.unlock();\n\t\tsemUsed.release(1);\n\t}\n\n\tT dequeue() ", {-# LINE 38 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 38 "haskades_run.cpp.mustache" #-} build "\n\t\tsemUsed.acquire(1);\n\t\tmutex.lock();\n\t\tT val = queue.dequeue();\n\t\tmutex.unlock();\n\t\tsemFree.release(1);\n\t\treturn val;\n\t}\n\nprotected:\n\tQQueue queue;\n\tQSemaphore semFree;\n\tQSemaphore semUsed;\n\tQMutex mutex;\n};\n\nThreadSafeQueue signalFromUIQ;\n\nclass ToUIEvent : public QEvent ", {-# LINE 56 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 56 "haskades_run.cpp.mustache" #-} build "\n\npublic:\n\tToUIEvent(int signalEvent", {-# LINE 59 "haskades_run.cpp.mustache" #-} mconcat $ map (toUItypes0 escapeFunction) toUItypes, {-# LINE 59 "haskades_run.cpp.mustache" #-} build ") : QEvent(toUIEventType) ", {-# LINE 59 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 59 "haskades_run.cpp.mustache" #-} build "\n\t\tthis->signalEvent = signalEvent;\n", {-# LINE 61 "haskades_run.cpp.mustache" #-} mconcat $ map (toUItypes1 escapeFunction) toUItypes, {-# LINE 64 "haskades_run.cpp.mustache" #-} build "\t}\n\n\tint signalEvent;\n", {-# LINE 67 "haskades_run.cpp.mustache" #-} mconcat $ map (toUItypes2 escapeFunction) toUItypes, {-# LINE 70 "haskades_run.cpp.mustache" #-} build "};\n\nclass AppWrapper: public QObject ", {-# LINE 72 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 72 "haskades_run.cpp.mustache" #-} build "\nQ_OBJECT\n\npublic:\n\t// This is our constructor that sets up the recipe.\n\tAppWrapper(QString qml_path) : qmlPath(qml_path) ", {-# LINE 77 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 77 "haskades_run.cpp.mustache" #-} build "\n#ifdef USE_NOTIFICATIONS\n\t\tqmlRegisterType(\"bb.platform\", 1, 0, \"Notification\");\n\t\tqmlRegisterType(\"bb.platform\", 1, 0, \"NotificationDialog\");\n#endif\n\t}\n\n\tvirtual void ready() ", {-# LINE 84 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 84 "haskades_run.cpp.mustache" #-} build "\n\t\t// Obtain a QMLDocument and load it into the qml variable, using build patterns.\n\t\tbb::cascades::QmlDocument *qml = bb::cascades::QmlDocument::create(this->qmlPath);\n\n\t\t// If the QML document is valid, we process it.\n\t\tif(!qml->hasErrors()) ", {-# LINE 89 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 89 "haskades_run.cpp.mustache" #-} build "\n\t\t\tqml->setContextProperty(\"app\", this);\n\n\t\t\t// Create the application root from QMLDocument\n\t\t\tbb::cascades::AbstractPane *appPage = qml->createRootObject();\n\n\t\t\tif (appPage) ", {-# LINE 95 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 95 "haskades_run.cpp.mustache" #-} build "\n\t\t\t\t// Set the main scene for the application to the Page.\n\t\t\t\tbb::cascades::Application::instance()->setScene(appPage);\n\t\t\t}\n\t\t} else ", {-# LINE 99 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 99 "haskades_run.cpp.mustache" #-} build "\n\t\t\tqCritical() << qml->errors();\n\t\t}\n\t}\n\n\tvirtual bool event(QEvent *e) ", {-# LINE 104 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 104 "haskades_run.cpp.mustache" #-} build "\n\t\tif(e->type() == toUIEventType) ", {-# LINE 105 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 105 "haskades_run.cpp.mustache" #-} build "\n\t\t\tToUIEvent *ev = (ToUIEvent*)e;\n\t\t\tswitch(ev->signalEvent) ", {-# LINE 107 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 107 "haskades_run.cpp.mustache" #-} build "\n", {-# LINE 108 "haskades_run.cpp.mustache" #-} mconcat $ map (toUI3 escapeFunction) toUI, {-# LINE 114 "haskades_run.cpp.mustache" #-} build "\t\t\t}\n\t\t\treturn false;\n\t\t} else ", {-# LINE 116 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 116 "haskades_run.cpp.mustache" #-} build "\n\t\t\treturn QObject::event(e);\n\t\t}\n\t}\n\n", {-# LINE 121 "haskades_run.cpp.mustache" #-} mconcat $ map (fromUI6 escapeFunction) fromUI, {-# LINE 131 "haskades_run.cpp.mustache" #-} build "\nsignals:\n", {-# LINE 133 "haskades_run.cpp.mustache" #-} mconcat $ map (toUI10 escapeFunction) toUI, {-# LINE 136 "haskades_run.cpp.mustache" #-} build "\nprotected:\n\tQString qmlPath;\n};\n\n#ifdef USE_SENSORS\nclass AccelerometerHandler : public QObject ", {-# LINE 142 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 142 "haskades_run.cpp.mustache" #-} build "\nQ_OBJECT\n\npublic:\n\tAccelerometerHandler(QtMobility::QAccelerometer::AccelerationMode accelM, QtMobility::QAccelerometer::AxesOrientationMode axesM, int (*cb)(double, double, double)) : _cb(cb) ", {-# LINE 146 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 146 "haskades_run.cpp.mustache" #-} build "\n\t\t_accel.setAccelerationMode(accelM);\n\t\t_accel.setAxesOrientationMode(axesM);\n\n\t\tconnect(&_accel, SIGNAL(readingChanged()), SLOT(callback()));\n\n\t\tif(!_accel.connectToBackend()) ", {-# LINE 152 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 152 "haskades_run.cpp.mustache" #-} build "\n\t\t\tqCritical() << \"CONNECT TO ACCELEROMETER BACKEND FAILED!\";\n\t\t} else if(!_accel.start()) ", {-# LINE 154 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 154 "haskades_run.cpp.mustache" #-} build "\n\t\t\tqCritical() << \"ACCELEROMETER START FAILED!\";\n\t\t}\n\t}\n\npublic slots:\n\tvoid callback() ", {-# LINE 160 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 160 "haskades_run.cpp.mustache" #-} build "\n\t\tQtMobility::QAccelerometerReading *r = _accel.reading();\n\t\tif(!_cb((double)r->x(), (double)r->y(), (double)r->z())) ", {-# LINE 162 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 162 "haskades_run.cpp.mustache" #-} build "\n\t\t\t_accel.stop();\n\t\t\tdelete this;\n\t\t}\n\t}\n\nprotected:\n\tQtMobility::QAccelerometer _accel;\n\tint (*_cb)(double, double, double);\n};\n#endif\n\nextern \"C\" ", {-# LINE 174 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 174 "haskades_run.cpp.mustache" #-} build "\n\nQObject *mainAppGlobal;\n\nQ_DECL_EXPORT void emit_ToUIEvent(int signalEvent", {-# LINE 178 "haskades_run.cpp.mustache" #-} mconcat $ map (toUItypes13 escapeFunction) toUItypes, {-# LINE 178 "haskades_run.cpp.mustache" #-} build ") ", {-# LINE 178 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 178 "haskades_run.cpp.mustache" #-} build "\n\tQEvent *e = (QEvent *)new ToUIEvent(signalEvent", {-# LINE 179 "haskades_run.cpp.mustache" #-} mconcat $ map (toUItypes14 escapeFunction) toUItypes, {-# LINE 179 "haskades_run.cpp.mustache" #-} build ");\n\tQCoreApplication::postEvent(mainAppGlobal, e);\n}\n\nvoid destroySignalFromUI(SignalFromUI *s) ", {-# LINE 183 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 183 "haskades_run.cpp.mustache" #-} build "\n\tswitch(s->tag) ", {-# LINE 184 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 184 "haskades_run.cpp.mustache" #-} build "\n", {-# LINE 185 "haskades_run.cpp.mustache" #-} mconcat $ map (fromUI15 escapeFunction) fromUI, {-# LINE 194 "haskades_run.cpp.mustache" #-} build "\t}\n\n\tfree(s);\n}\n\nSignalFromUI *lastFromUI = NULL;\n\nQ_DECL_EXPORT SignalFromUI *pop_SignalFromUI(void) ", {-# LINE 201 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 201 "haskades_run.cpp.mustache" #-} build "\n\tif(lastFromUI) destroySignalFromUI(lastFromUI);\n\tlastFromUI = signalFromUIQ.dequeue();\n\treturn lastFromUI;\n}\n\nQ_DECL_EXPORT int haskades_run(char *qml_path) ", {-# LINE 207 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 207 "haskades_run.cpp.mustache" #-} build "\n\tint argc = 0;\n\tchar *argv[] = ", {-# LINE 209 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 209 "haskades_run.cpp.mustache" #-} build " NULL };\n\t// Instantiate the main application constructor.\n\tbb::cascades::Application app(argc, argv);\n\n\t// Set up the translator.\n\tQTranslator translator;\n\tQString locale_string = QLocale().name();\n\tQString filename = QString(\"sample_%1\").arg(locale_string); // TODO\n\tif (translator.load(filename, \"app/native/qm\")) ", {-# LINE 217 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 217 "haskades_run.cpp.mustache" #-} build "\n\t\tapp.installTranslator(&translator);\n\t}\n\n\ttoUIEventType = (QEvent::Type)QEvent::registerEventType();\n\n\t// Initialize our application.\n\tAppWrapper mainApp(QString::fromUtf8(qml_path));\n\tmainAppGlobal = (QObject*)&mainApp;\n\tmainApp.ready();\n\n\t// We complete the transaction started in the main application constructor and start the\n\t// client event loop here. When loop is exited the Application deletes the scene which\n\t// deletes all its children.\n\treturn bb::cascades::Application::exec();\n}\n\n#ifdef USE_SENSORS\nvoid accelerometer_start(int accelM, int axesM, int (*cb)(double, double, double)) ", {-# LINE 235 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 235 "haskades_run.cpp.mustache" #-} build "\n\tQtMobility::QAccelerometer::AccelerationMode _accelM;\n\tQtMobility::QAccelerometer::AxesOrientationMode _axesM;\n\n\tswitch(accelM) ", {-# LINE 239 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 239 "haskades_run.cpp.mustache" #-} build "\n\t\tcase 0:\n\t\t\t_accelM = QtMobility::QAccelerometer::Gravity;\n\t\t\tbreak;\n\t\tcase 1:\n\t\t\t_accelM = QtMobility::QAccelerometer::User;\n\t\t\tbreak;\n\t\tcase 2:\n\t\t\t_accelM = QtMobility::QAccelerometer::Combined;\n\t\t\tbreak;\n\t\tdefault:\n\t\t\tqWarning() << \"Unknown AccelerationMode, defaulting to Combined\";\n\t\t\t_accelM = QtMobility::QAccelerometer::Combined;\n\t}\n\n\tswitch(axesM) ", {-# LINE 254 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 254 "haskades_run.cpp.mustache" #-} build "\n\t\tcase 0:\n\t\t\t_axesM = QtMobility::QAccelerometer::FixedOrientation;\n\t\t\tbreak;\n\t\tcase 1:\n\t\t\t_axesM = QtMobility::QAccelerometer::AutomaticOrientation;\n\t\t\tbreak;\n\t\tcase 2:\n\t\t\t_axesM = QtMobility::QAccelerometer::UserOrientation;\n\t\t\tbreak;\n\t\tdefault:\n\t\t\tqWarning() << \"Unknown AxesOrientationMode, defaulting to Automatic\";\n\t\t\t_axesM = QtMobility::QAccelerometer::AutomaticOrientation;\n\t}\n\n\tnew AccelerometerHandler(_accelM, _axesM, cb);\n}\n#endif\n\n}\n\n// Tell MOC to run on this file\n#include \"haskades_run.moc\"\n" ] where toUItypes0 escapeFunction ctx@(SignalType {csigtype=csigtype, qtsigtype=qtsigtype, qtwrapsig=qtwrapsig, lowcsigtype=lowcsigtype, sigtypename=sigtypename}) = mconcat [ {-# LINE 59 "haskades_run.cpp.mustache" #-} build ", ", {-# LINE 59 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build qtsigtype, {-# LINE 59 "haskades_run.cpp.mustache" #-} build " ", {-# LINE 59 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigtypename ] toUItypes1 escapeFunction ctx@(SignalType {csigtype=csigtype, qtsigtype=qtsigtype, qtwrapsig=qtwrapsig, lowcsigtype=lowcsigtype, sigtypename=sigtypename}) = mconcat [ {-# LINE 62 "haskades_run.cpp.mustache" #-} build "\t\tthis->", {-# LINE 62 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigtypename, {-# LINE 62 "haskades_run.cpp.mustache" #-} build " = ", {-# LINE 62 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigtypename, {-# LINE 62 "haskades_run.cpp.mustache" #-} build ";\n" ] toUItypes2 escapeFunction ctx@(SignalType {csigtype=csigtype, qtsigtype=qtsigtype, qtwrapsig=qtwrapsig, lowcsigtype=lowcsigtype, sigtypename=sigtypename}) = mconcat [ {-# LINE 68 "haskades_run.cpp.mustache" #-} build "\t", {-# LINE 68 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build qtsigtype, {-# LINE 68 "haskades_run.cpp.mustache" #-} build " ", {-# LINE 68 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigtypename, {-# LINE 68 "haskades_run.cpp.mustache" #-} build ";\n" ] toUI3 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 109 "haskades_run.cpp.mustache" #-} build "\t\t\t\tcase TOUI_", {-# LINE 109 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 109 "haskades_run.cpp.mustache" #-} build ":\n\t\t\t\t\temit ", {-# LINE 110 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 110 "haskades_run.cpp.mustache" #-} build "(", {-# LINE 110 "haskades_run.cpp.mustache" #-} mconcat $ map (sigargs4 escapeFunction) sigargs, {-# LINE 110 "haskades_run.cpp.mustache" #-} build ");\n\t\t\t\t\treturn true;\n\t\t\t\t\tbreak;\n" ] where sigargs4 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 110 "haskades_run.cpp.mustache" #-} if mempty == (Any sigargfirst) then sigargfirst5 escapeFunction ctx else mempty, {-# LINE 110 "haskades_run.cpp.mustache" #-} build "ev->", {-# LINE 110 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigargsigtypename ] where sigargfirst5 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 110 "haskades_run.cpp.mustache" #-} build ", " ] fromUI6 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 122 "haskades_run.cpp.mustache" #-} build "\tQ_INVOKABLE void ", {-# LINE 122 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 122 "haskades_run.cpp.mustache" #-} build "(", {-# LINE 122 "haskades_run.cpp.mustache" #-} mconcat $ map (sigargs7 escapeFunction) sigargs, {-# LINE 122 "haskades_run.cpp.mustache" #-} build ") ", {-# LINE 122 "haskades_run.cpp.mustache" #-} build "{", {-# LINE 122 "haskades_run.cpp.mustache" #-} build "\n\t\tSignalFromUI *s = new SignalFromUI;\n\t\ts->tag = ", {-# LINE 124 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigevent, {-# LINE 124 "haskades_run.cpp.mustache" #-} build ";\n", {-# LINE 125 "haskades_run.cpp.mustache" #-} mconcat $ map (sigargs9 escapeFunction) sigargs, {-# LINE 128 "haskades_run.cpp.mustache" #-} build "\t\tsignalFromUIQ.enqueue(s);\n\t}\n" ] where sigargs7 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 122 "haskades_run.cpp.mustache" #-} if mempty == (Any sigargfirst) then sigargfirst8 escapeFunction ctx else mempty, {-# LINE 122 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build qtsigargtype, {-# LINE 122 "haskades_run.cpp.mustache" #-} build " ", {-# LINE 122 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build siganame ] where sigargfirst8 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 122 "haskades_run.cpp.mustache" #-} build ", " ] sigargs9 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 126 "haskades_run.cpp.mustache" #-} build "\t\ts->", {-# LINE 126 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 126 "haskades_run.cpp.mustache" #-} build ".", {-# LINE 126 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build siganame, {-# LINE 126 "haskades_run.cpp.mustache" #-} build " = ", {-# LINE 126 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigargfromqt, {-# LINE 126 "haskades_run.cpp.mustache" #-} build ";\n" ] toUI10 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 134 "haskades_run.cpp.mustache" #-} build "\tvoid ", {-# LINE 134 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 134 "haskades_run.cpp.mustache" #-} build "(", {-# LINE 134 "haskades_run.cpp.mustache" #-} mconcat $ map (sigargs11 escapeFunction) sigargs, {-# LINE 134 "haskades_run.cpp.mustache" #-} build ");\n" ] where sigargs11 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 134 "haskades_run.cpp.mustache" #-} if mempty == (Any sigargfirst) then sigargfirst12 escapeFunction ctx else mempty, {-# LINE 134 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build qtsigargtype ] where sigargfirst12 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 134 "haskades_run.cpp.mustache" #-} build ", " ] toUItypes13 escapeFunction ctx@(SignalType {csigtype=csigtype, qtsigtype=qtsigtype, qtwrapsig=qtwrapsig, lowcsigtype=lowcsigtype, sigtypename=sigtypename}) = mconcat [ {-# LINE 178 "haskades_run.cpp.mustache" #-} build ", ", {-# LINE 178 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build lowcsigtype, {-# LINE 178 "haskades_run.cpp.mustache" #-} build " ", {-# LINE 178 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigtypename ] toUItypes14 escapeFunction ctx@(SignalType {csigtype=csigtype, qtsigtype=qtsigtype, qtwrapsig=qtwrapsig, lowcsigtype=lowcsigtype, sigtypename=sigtypename}) = mconcat [ {-# LINE 179 "haskades_run.cpp.mustache" #-} build ", ", {-# LINE 179 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build qtwrapsig ] fromUI15 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 186 "haskades_run.cpp.mustache" #-} build "\t\t\tcase FROMUI_", {-# LINE 186 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 186 "haskades_run.cpp.mustache" #-} build ":\n", {-# LINE 187 "haskades_run.cpp.mustache" #-} mconcat $ map (sigargs16 escapeFunction) sigargs, {-# LINE 192 "haskades_run.cpp.mustache" #-} build "\t\t\t\tbreak;\n" ] where sigargs16 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 188 "haskades_run.cpp.mustache" #-} if mempty /= sigargdestroy then sigargdestroy17 escapeFunction ctx else mempty ] where sigargdestroy17 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 189 "haskades_run.cpp.mustache" #-} build "\t\t\t\t", {-# LINE 189 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigargdestroy, {-# LINE 189 "haskades_run.cpp.mustache" #-} build "(s->", {-# LINE 189 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 189 "haskades_run.cpp.mustache" #-} build ".", {-# LINE 189 "haskades_run.cpp.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build siganame, {-# LINE 189 "haskades_run.cpp.mustache" #-} build ");\n" ] haskades_runh escapeFunction ctx@(Template {headerPath=headerPath, modul=modul, toUItypes=toUItypes, toUI=toUI, fromUI=fromUI}) = mconcat [ {-# LINE 1 "haskades_run.h.mustache" #-} build "#ifndef _HASKADES_RUN_H\n#define _HASKADES_RUN_H\n\n", {-# LINE 4 "haskades_run.h.mustache" #-} mconcat $ map (toUI0 escapeFunction) toUI, {-# LINE 7 "haskades_run.h.mustache" #-} build "\n", {-# LINE 8 "haskades_run.h.mustache" #-} mconcat $ map (fromUI1 escapeFunction) fromUI, {-# LINE 11 "haskades_run.h.mustache" #-} build "\nstruct SignalFromUI ", {-# LINE 12 "haskades_run.h.mustache" #-} build "{", {-# LINE 12 "haskades_run.h.mustache" #-} build "\n\tunsigned int tag;\n\tunion ", {-# LINE 14 "haskades_run.h.mustache" #-} build "{", {-# LINE 14 "haskades_run.h.mustache" #-} build "\n\t\t", {-# LINE 15 "haskades_run.h.mustache" #-} mconcat $ map (fromUI2 escapeFunction) fromUI, {-# LINE 22 "haskades_run.h.mustache" #-} build "\t};\n};\n\n#endif /* _HASKADES_RUN_H */\n" ] where toUI0 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 5 "haskades_run.h.mustache" #-} build "#define TOUI_", {-# LINE 5 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 5 "haskades_run.h.mustache" #-} build " ", {-# LINE 5 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigevent, {-# LINE 5 "haskades_run.h.mustache" #-} build "\n" ] fromUI1 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 9 "haskades_run.h.mustache" #-} build "#define FROMUI_", {-# LINE 9 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 9 "haskades_run.h.mustache" #-} build " ", {-# LINE 9 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build sigevent, {-# LINE 9 "haskades_run.h.mustache" #-} build "\n" ] fromUI2 escapeFunction ctx@(Signal {sigfirst=sigfirst, signame=signame, sigargs=sigargs, sigevent=sigevent, sigcwrap=sigcwrap}) = mconcat [ {-# LINE 16 "haskades_run.h.mustache" #-} build "\t\tstruct ", {-# LINE 16 "haskades_run.h.mustache" #-} build "{", {-# LINE 16 "haskades_run.h.mustache" #-} build "\n\t\t\t", {-# LINE 17 "haskades_run.h.mustache" #-} mconcat $ map (sigargs3 escapeFunction) sigargs, {-# LINE 20 "haskades_run.h.mustache" #-} build "\t\t} ", {-# LINE 20 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build signame, {-# LINE 20 "haskades_run.h.mustache" #-} build ";\n\t\t" ] where sigargs3 escapeFunction ctx@(SignalArg {sigargfirst=sigargfirst, siganame=siganame, qtsigargtype=qtsigargtype, csigargtype=csigargtype, sigargfromc=sigargfromc, sigargfromqt=sigargfromqt, sigargdestroy=sigargdestroy, sigargsigtypename=sigargsigtypename}) = mconcat [ {-# LINE 18 "haskades_run.h.mustache" #-} build "\t\t\t", {-# LINE 18 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build csigargtype, {-# LINE 18 "haskades_run.h.mustache" #-} build " ", {-# LINE 18 "haskades_run.h.mustache" #-} build $ escapeFunction $ TL.unpack $ TL.toLazyText $ build siganame, {-# LINE 18 "haskades_run.h.mustache" #-} build ";\n\t\t\t" ]