hsqml 0.3.3.0 → 0.3.4.0
raw patch · 30 files changed
+1181/−172 lines, 30 filesdep ~QuickCheckdep ~filepathdep ~taggedsetup-changed
Dependency ranges changed: QuickCheck, filepath, tagged, transformers
Files
- CHANGELOG +18/−0
- LICENSE +1/−1
- Setup.hs +39/−17
- SetupNoTH.hs +33/−17
- cbits/Canvas.cpp +1/−0
- cbits/Class.cpp +31/−17
- cbits/Class.h +1/−0
- cbits/Engine.cpp +143/−23
- cbits/Engine.h +39/−8
- cbits/Intrinsics.cpp +1/−0
- cbits/Manager.cpp +88/−22
- cbits/Manager.h +19/−9
- cbits/Model.cpp +339/−0
- cbits/Model.h +85/−0
- cbits/Object.cpp +19/−9
- cbits/Object.h +2/−2
- cbits/hsqml.h +19/−4
- hsqml.cabal +17/−7
- src/Graphics/QML/Engine.hs +77/−24
- src/Graphics/QML/Internal/BindCanvas.chs +1/−1
- src/Graphics/QML/Internal/BindCore.chs +28/−0
- src/Graphics/QML/Internal/BindObj.chs +3/−3
- src/Graphics/QML/Internal/Marshal.hs +3/−1
- src/Graphics/QML/Model.hs +57/−0
- test/Graphics/QML/Test/AutoListTest.hs +107/−0
- test/Graphics/QML/Test/Harness.hs +1/−0
- test/Graphics/QML/Test/ScriptDSL.hs +4/−4
- test/Graphics/QML/Test/SignalTest.hs +1/−1
- test/Graphics/QML/Test/SimpleTest.hs +1/−1
- test/Test1.hs +3/−1
CHANGELOG view
@@ -1,5 +1,23 @@ HsQML - Release History +release-0.3.4.0 - 2016.02.24++ * Added AutoListModel component.+ * Added functions for joining and killing engines.+ * Added functions to manipulate Qt's command-line arguments.+ * Added exception handler to callbacks.+ * Relaxed Cabal dependency constraint on 'filepath', 'tagged', 'transformers',+ and 'QuickCheck'.+ * Changed runEngineLoop to pass through command line arguments by default.+ * Fixed class at same address as deleted class causing inaccessible objects.+ * Fixed memory corruption bug prior to Qt 5.2 with workaround.+ * Fixed building with Fedora-style moc executable names (non-qtselect).+ * Fixed building GHCi objects with GHC 7.10.+ * Fixed missing strong reference on engine context objects.+ * Fixed missing include breaking compilation with Qt 5.0.+ * Fixed switch compiler warnings.+ * Fixed imports to support older GHCs.+ release-0.3.3.0 - 2015.01.20 * Added support for Cabal 1.22 API.
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c)2010-2015, Robin KAY+Copyright (c)2010-2016, Robin KAY All rights reserved.
Setup.hs view
@@ -33,6 +33,7 @@ vnameE = VarE . mkName vnameP = VarP . mkName cnameE = ConE . mkName+ cnameP n = ConP (mkName n) app2E f x y = AppE (AppE f x) y app3E f x y z = AppE (app2E f x y) z app4E f x y z u = AppE (app3E f x y z) u@@ -49,6 +50,12 @@ (vnameE "x") (cnameE "CLibName") else AppE (vnameE "fromJust") $ AppE (vnameE "libraryConfig") (vnameE "x")+ -- 'ComponentLocalBuildInfo' record changed fields in Cabal 1.18+ getCompLibName = if post118CabalAPI+ then AppE (LamE [cnameP "LibraryName" [vnameP "n"]] (vnameE "n")) $+ AppE (vnameE "head") $+ AppE (vnameE "componentLibraries") (vnameE "clbi")+ else vnameE "def" -- 'programFindLocation' field changed signature in Cabal 1.18 adaptFindLoc = if post118CabalAPI then LamE [vnameP "f", vnameP "x", WildP] $@@ -83,6 +90,8 @@ Clause [] (NormalB setEnvShim) []], FunD (mkName "extractCLBI") [ Clause [vnameP "x"] (NormalB extractCLBI) []],+ FunD (mkName "getCompLibName") [+ Clause [vnameP "clbi", vnameP "def"] (NormalB getCompLibName) []], FunD (mkName "adaptFindLoc") [ Clause [] (NormalB adaptFindLoc) []], FunD (mkName "rawSystemStdErr") [@@ -118,11 +127,17 @@ getCustomFlag name pkgDesc = fromMaybe False . simpleParse $ getCustomStr name pkgDesc +xForceGHCiLib, xMocHeaders, xFrameworkDirs, xSeparateCbits :: String+xForceGHCiLib = "x-force-ghci-lib"+xMocHeaders = "x-moc-headers"+xFrameworkDirs = "x-framework-dirs"+xSeparateCbits = "x-separate-cbits"+ confWithQt :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo confWithQt (gpd,hbi) flags = do let verb = fromFlag $ configVerbosity flags- mocPath <- findProgramLocation verb "moc"+ mocPath <- findMoc verb cppPath <- findProgramLocation verb "cpp" let mapLibBI = fmap . mapCondTree . mapBI $ substPaths mocPath cppPath gpd' = gpd {@@ -134,9 +149,9 @@ -- Find Qt moc program and store in database (_,_,db') <- requireProgramVersion verb mocProgram qtVersionRange (withPrograms lbi)- -- Force enable GHCi workaround library if flag set and not using shared libs + -- Force enable GHCi workaround library if flag set and not using shared libs let forceGHCiLib =- (getCustomFlag "x-force-ghci-lib" $ localPkgDescr lbi) &&+ (getCustomFlag xForceGHCiLib $ localPkgDescr lbi) && (not $ withSharedLib lbi) -- Update LocalBuildInfo return lbi {withPrograms = db',@@ -184,21 +199,25 @@ fixQtBuild :: Verbosity -> LocalBuildInfo -> BuildInfo -> IO BuildInfo fixQtBuild verb lbi build = do let moc = fromJust $ lookupProgram mocProgram $ withPrograms lbi- incs = words $ fromMaybe "" $ lookup "x-moc-headers" $- customFieldsBI build+ option name = words $ fromMaybe "" $ lookup name $ customFieldsBI build+ incs = option xMocHeaders bDir = buildDir lbi cpps = map (\inc -> bDir </> (takeDirectory inc) </> ("moc_" ++ (takeBaseName inc) ++ ".cpp")) incs+ args = map ("-I"++) (includeDirs build) +++ map ("-F"++) (option xFrameworkDirs)+ -- Run moc on each of the header files containing QObject subclasses mapM_ (\(i,o) -> do createDirectoryIfMissingVerbose verb True (takeDirectory o)- runProgram verb moc [i,"-o",o]) $ zip incs cpps+ runProgram verb moc $ [i,"-o",o] ++ args) $ zip incs cpps+ -- Add the moc generated source files to be compiled return build {cSources = cpps ++ cSources build, ccOptions = "-fPIC" : ccOptions build} needsGHCiFix :: PackageDescription -> LocalBuildInfo -> Bool needsGHCiFix pkgDesc lbi =- withGHCiLib lbi && getCustomFlag "x-separate-cbits" pkgDesc+ withGHCiLib lbi && getCustomFlag xSeparateCbits pkgDesc mkGHCiFixLibPkgId :: PackageDescription -> PackageIdentifier mkGHCiFixLibPkgId pkgDesc =@@ -218,15 +237,15 @@ buildGHCiFix :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> IO () buildGHCiFix verb pkgDesc lbi lib = do- let bDir = buildDir lbi- ms = map ModuleName.toFilePath $ libModules lib+ let bDir = buildDir lbi+ ms = map ModuleName.toFilePath $ libModules lib hsObjs = map ((bDir </>) . (<.> "o")) ms+ clbi = extractCLBI lbi+ lname = getCompLibName clbi $ ("HS" ++) $ display $ packageId pkgDesc stubObjs <- fmap catMaybes $ mapM (findFileWithExtension ["o"] [bDir]) $ map (++ "_stub") ms (ld,_) <- requireProgram verb ldProgram (withPrograms lbi)- combineObjectFiles verb ld- (bDir </> (("HS" ++) $ display $ packageId pkgDesc) <.> "o")- (stubObjs ++ hsObjs)+ combineObjectFiles verb ld (bDir </> lname <.> "o") (stubObjs ++ hsObjs) (ghc,_) <- requireProgram verb ghcProgram (withPrograms lbi) let bi = libBuildInfo lib runProgram verb ghc (@@ -239,17 +258,20 @@ mocProgram :: Program mocProgram = Program { programName = "moc",- programFindLocation = adaptFindLoc $- \verb -> findProgramLocation verb "moc",+ programFindLocation = adaptFindLoc findMoc, programFindVersion = \verb path -> do (oLine,eLine,_) <- rawSystemStdErr verb path ["-v"] return $- (findSubseq (stripPrefix "(Qt ") eLine `mplus`- findSubseq (stripPrefix "moc ") oLine) >>=+ msum (map (\(p,l) -> findSubseq (stripPrefix p) l)+ [("(Qt ",eLine), ("moc-qt5 ",oLine), ("moc ",oLine)]) >>= simpleParse . takeWhile (\c -> isDigit c || c == '.'), programPostConf = noPostConf } +findMoc :: Verbosity -> IO (Maybe FilePath)+findMoc verb =+ fmap msum $ mapM (findProgramLocation verb) ["moc-qt5", "moc"]+ qtVersionRange :: VersionRange qtVersionRange = intersectVersionRanges (orLaterVersion $ Version [5,0] []) (earlierVersion $ Version [6,0] [])@@ -282,7 +304,7 @@ I.extraGHCiLibraries instPkgInfo, -- Add directories to framework search path I.frameworkDirs =- words (getCustomStr "x-framework-dirs" pkg) +++ words (getCustomStr xFrameworkDirs pkg) ++ I.frameworkDirs instPkgInfo} case flagToMaybe $ regGenPkgConf flags of Just regFile -> do
SetupNoTH.hs view
@@ -29,6 +29,9 @@ -- 'LocalBuildInfo' record changed fields in Cabal 1.18 extractCLBI :: LocalBuildInfo -> ComponentLocalBuildInfo extractCLBI x = getComponentLocalBuildInfo x CLibName+-- 'ComponentLocalBuildInfo' record changed fields in Cabal 1.18+getCompLibName :: ComponentLocalBuildInfo -> String -> String+getCompLibName clbi _ = (\(LibraryName n) -> n) (head (componentLibraries clbi)) -- 'programFindLocation' field changed signature in Cabal 1.18 adaptFindLoc :: (Verbosity -> a) -> Verbosity -> ProgramSearchPath -> a adaptFindLoc f x _ = f x@@ -63,11 +66,17 @@ getCustomFlag name pkgDesc = fromMaybe False . simpleParse $ getCustomStr name pkgDesc +xForceGHCiLib, xMocHeaders, xFrameworkDirs, xSeparateCbits :: String+xForceGHCiLib = "x-force-ghci-lib"+xMocHeaders = "x-moc-headers"+xFrameworkDirs = "x-framework-dirs"+xSeparateCbits = "x-separate-cbits"+ confWithQt :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo confWithQt (gpd,hbi) flags = do let verb = fromFlag $ configVerbosity flags- mocPath <- findProgramLocation verb "moc"+ mocPath <- findMoc verb cppPath <- findProgramLocation verb "cpp" let mapLibBI = fmap . mapCondTree . mapBI $ substPaths mocPath cppPath gpd' = gpd {@@ -79,9 +88,9 @@ -- Find Qt moc program and store in database (_,_,db') <- requireProgramVersion verb mocProgram qtVersionRange (withPrograms lbi)- -- Force enable GHCi workaround library if flag set and not using shared libs + -- Force enable GHCi workaround library if flag set and not using shared libs let forceGHCiLib =- (getCustomFlag "x-force-ghci-lib" $ localPkgDescr lbi) &&+ (getCustomFlag xForceGHCiLib $ localPkgDescr lbi) && (not $ withSharedLib lbi) -- Update LocalBuildInfo return lbi {withPrograms = db',@@ -129,21 +138,25 @@ fixQtBuild :: Verbosity -> LocalBuildInfo -> BuildInfo -> IO BuildInfo fixQtBuild verb lbi build = do let moc = fromJust $ lookupProgram mocProgram $ withPrograms lbi- incs = words $ fromMaybe "" $ lookup "x-moc-headers" $- customFieldsBI build+ option name = words $ fromMaybe "" $ lookup name $ customFieldsBI build+ incs = option xMocHeaders bDir = buildDir lbi cpps = map (\inc -> bDir </> (takeDirectory inc) </> ("moc_" ++ (takeBaseName inc) ++ ".cpp")) incs+ args = map ("-I"++) (includeDirs build) +++ map ("-F"++) (option xFrameworkDirs)+ -- Run moc on each of the header files containing QObject subclasses mapM_ (\(i,o) -> do createDirectoryIfMissingVerbose verb True (takeDirectory o)- runProgram verb moc [i,"-o",o]) $ zip incs cpps+ runProgram verb moc $ [i,"-o",o] ++ args) $ zip incs cpps+ -- Add the moc generated source files to be compiled return build {cSources = cpps ++ cSources build, ccOptions = "-fPIC" : ccOptions build} needsGHCiFix :: PackageDescription -> LocalBuildInfo -> Bool needsGHCiFix pkgDesc lbi =- withGHCiLib lbi && getCustomFlag "x-separate-cbits" pkgDesc+ withGHCiLib lbi && getCustomFlag xSeparateCbits pkgDesc mkGHCiFixLibPkgId :: PackageDescription -> PackageIdentifier mkGHCiFixLibPkgId pkgDesc =@@ -163,15 +176,15 @@ buildGHCiFix :: Verbosity -> PackageDescription -> LocalBuildInfo -> Library -> IO () buildGHCiFix verb pkgDesc lbi lib = do- let bDir = buildDir lbi- ms = map ModuleName.toFilePath $ libModules lib+ let bDir = buildDir lbi+ ms = map ModuleName.toFilePath $ libModules lib hsObjs = map ((bDir </>) . (<.> "o")) ms+ clbi = extractCLBI lbi+ lname = getCompLibName clbi $ ("HS" ++) $ display $ packageId pkgDesc stubObjs <- fmap catMaybes $ mapM (findFileWithExtension ["o"] [bDir]) $ map (++ "_stub") ms (ld,_) <- requireProgram verb ldProgram (withPrograms lbi)- combineObjectFiles verb ld- (bDir </> (("HS" ++) $ display $ packageId pkgDesc) <.> "o")- (stubObjs ++ hsObjs)+ combineObjectFiles verb ld (bDir </> lname <.> "o") (stubObjs ++ hsObjs) (ghc,_) <- requireProgram verb ghcProgram (withPrograms lbi) let bi = libBuildInfo lib runProgram verb ghc (@@ -184,17 +197,20 @@ mocProgram :: Program mocProgram = Program { programName = "moc",- programFindLocation = adaptFindLoc $- \verb -> findProgramLocation verb "moc",+ programFindLocation = adaptFindLoc findMoc, programFindVersion = \verb path -> do (oLine,eLine,_) <- rawSystemStdErr verb path ["-v"] return $- (findSubseq (stripPrefix "(Qt ") eLine `mplus`- findSubseq (stripPrefix "moc ") oLine) >>=+ msum (map (\(p,l) -> findSubseq (stripPrefix p) l)+ [("(Qt ",eLine), ("moc-qt5 ",oLine), ("moc ",oLine)]) >>= simpleParse . takeWhile (\c -> isDigit c || c == '.'), programPostConf = noPostConf } +findMoc :: Verbosity -> IO (Maybe FilePath)+findMoc verb =+ fmap msum $ mapM (findProgramLocation verb) ["moc-qt5", "moc"]+ qtVersionRange :: VersionRange qtVersionRange = intersectVersionRanges (orLaterVersion $ Version [5,0] []) (earlierVersion $ Version [6,0] [])@@ -227,7 +243,7 @@ I.extraGHCiLibraries instPkgInfo, -- Add directories to framework search path I.frameworkDirs =- words (getCustomStr "x-framework-dirs" pkg) +++ words (getCustomStr xFrameworkDirs pkg) ++ I.frameworkDirs instPkgInfo} case flagToMaybe $ regGenPkgConf flags of Just regFile -> do
cbits/Canvas.cpp view
@@ -1,4 +1,5 @@ #include "Canvas.h"+#include "Engine.h" #include "Manager.h" #include <QtCore/qmath.h>
cbits/Class.cpp view
@@ -63,22 +63,7 @@ } HsQMLClass::~HsQMLClass()-{- for (int i=0; i<mMethodCount; i++) {- gManager->freeFun((HsFunPtr)mMethods[i]);- }- for (unsigned int i=0; i<2*mPropertyCount; i++) {- if (mProperties[i]) {- gManager->freeFun((HsFunPtr)mProperties[i]);- }- }- gManager->freeStable(mHsTypeRep);- std::free(mMetaData);- std::free(mMethods);- std::free(mProperties);-- gManager->updateCounter(HsQMLManager::ClassCount, -1);-}+{} const char* HsQMLClass::name() {@@ -133,8 +118,37 @@ count > 1 ? "Deref" : "Delete", name(), cRefSrcNames[src], count)); if (count == 1) {- delete this;+ destroy(); }+}++void HsQMLClass::destroy()+{+ for (int i=0; i<mMethodCount; i++) {+ gManager->freeFun((HsFunPtr)mMethods[i]);+ mMethods[i] = NULL;+ }+ for (unsigned int i=0; i<2*mPropertyCount; i++) {+ if (mProperties[i]) {+ gManager->freeFun((HsFunPtr)mProperties[i]);+ mProperties[i] = NULL;+ }+ }+ gManager->freeStable(mHsTypeRep);+ mHsTypeRep = NULL;+ std::free(mMetaData);+ mMetaData = NULL;+ std::free(mMethods);+ mMethods = NULL;+ std::free(mProperties);+ mProperties = NULL;++ gManager->updateCounter(HsQMLManager::ClassCount, -1);++ // Qt internally retains pointers to QMetaObjects it has encountered+ // without any mechanism for unregistering them. Hence, classes can't be+ // deleted prior to shutdown.+ gManager->zombifyClass(this); } extern "C" int hsqml_get_next_class_id()
cbits/Class.h view
@@ -21,6 +21,7 @@ const HsQMLUniformFunc* methods(); const HsQMLUniformFunc* properties(); const QMetaObject* metaObj();+ void destroy(); enum RefSrc {Handle, ObjProxy}; void ref(RefSrc); void deref(RefSrc);
cbits/Engine.cpp view
@@ -5,10 +5,98 @@ #include "Engine.h" #include "Object.h" -HsQMLEngine::HsQMLEngine(const HsQMLEngineConfig& config)- : mComponent(&mEngine)- , mStopCb(config.stopCb)+static const char* cRefSrcNames[] = {+ "Hndl", "Eng", "Event"+};++HsQMLEngineProxy::HsQMLEngineProxy()+ : mEngine(NULL)+ , mDead(false)+ , mSerial(gManager->updateCounter(HsQMLManager::EngineSerial, 1))+ , mRefCount(0) {+ ref(Handle);+ gManager->updateCounter(HsQMLManager::EngineCount, 1);+}++HsQMLEngineProxy::~HsQMLEngineProxy()+{+ gManager->updateCounter(HsQMLManager::EngineCount, -1);+}++void HsQMLEngineProxy::setEngine(HsQMLEngine* engine)+{+ mEngine = engine;+}++HsQMLEngine* HsQMLEngineProxy::engine() const+{+ return mEngine;+}++void HsQMLEngineProxy::kill()+{+ mDead = true;+ delete mEngine;+ Q_ASSERT (!mEngine);+}++bool HsQMLEngineProxy::dead() const+{+ return mDead;+}++void HsQMLEngineProxy::ref(RefSrc src)+{+ int count = mRefCount.fetchAndAddOrdered(1);++ HSQML_LOG(count == 0 ? 3 : 4,+ QString().sprintf("%s EngineProxy, id=%d, src=%s, count=%d.",+ count ? "Ref" : "New", mSerial, cRefSrcNames[src], count+1));+}++void HsQMLEngineProxy::deref(RefSrc src)+{+ int count = mRefCount.fetchAndAddOrdered(-1);++ HSQML_LOG(count == 0 ? 3 : 4,+ QString().sprintf("%s EngineProxy, id=%d, src=%s, count=%d.",+ count > 1 ? "Deref" : "Delete", mSerial, cRefSrcNames[src], count));++ if (count == 1) {+ delete this;+ }+}++HsQMLEngineCreateEvent::HsQMLEngineCreateEvent(HsQMLEngineProxy* proxy)+ : QEvent(HsQMLManagerApp::CreateEngineEvent)+ , mProxy(proxy)+ , contextObject(NULL)+ , stopCb(NULL)+{+ mProxy->ref(HsQMLEngineProxy::Event);+}++HsQMLEngineProxy* HsQMLEngineCreateEvent::proxy() const+{+ return mProxy;+}++HsQMLEngineCreateEvent::~HsQMLEngineCreateEvent()+{+ mProxy->deref(HsQMLEngineProxy::Event);+}++HsQMLEngine::HsQMLEngine(const HsQMLEngineCreateEvent* config, QObject* parent)+ : QObject(parent) + , mProxy(config->proxy())+ , mComponent(&mEngine)+ , mStopCb(config->stopCb)+{+ // Setup life-cycle+ mProxy->setEngine(this);+ mProxy->ref(HsQMLEngineProxy::Engine);+ // Connect signals QObject::connect( &mEngine, SIGNAL(quit()),@@ -18,20 +106,21 @@ this, SLOT(componentStatus(QQmlComponent::Status))); // Obtain, re-parent, and set QML global object- if (config.contextObject) {- QObject* ctx = config.contextObject->object(this);- mEngine.rootContext()->setContextObject(ctx);- mObjects << ctx;+ if (config->contextObject) {+ HsQMLObjectProxy* ctxProxy = config->contextObject;+ ctxProxy->ref(HsQMLObjectProxy::Engine);+ mGlobals << ctxProxy;+ mEngine.rootContext()->setContextObject(ctxProxy->object(this)); } // Engine settings mEngine.setImportPathList(- QStringList(config.importPaths) << mEngine.importPathList());+ QStringList(config->importPaths) << mEngine.importPathList()); mEngine.setPluginPathList(- QStringList(config.pluginPaths) << mEngine.pluginPathList());+ QStringList(config->pluginPaths) << mEngine.pluginPathList()); // Load document- mComponent.loadUrl(QUrl(config.initialURL));+ mComponent.loadUrl(QUrl(config->initialURL)); } HsQMLEngine::~HsQMLEngine()@@ -40,8 +129,15 @@ mStopCb(); gManager->freeFun(reinterpret_cast<HsFunPtr>(mStopCb)); - // Delete owned objects- qDeleteAll(mObjects);+ // Release engine proxy and globals+ mProxy->setEngine(NULL);+ mProxy->deref(HsQMLEngineProxy::Engine);+ Q_FOREACH(HsQMLObjectProxy* proxy, mGlobals) {+ proxy->deref(HsQMLObjectProxy::Engine);+ }++ // Delete other owned resources+ qDeleteAll(mResources); } bool HsQMLEngine::eventFilter(QObject* obj, QEvent* ev)@@ -62,12 +158,15 @@ switch (status) { case QQmlComponent::Ready: { QObject* obj = mComponent.create();- mObjects << obj;+ // Freeing the object causes memory corruption prior to Qt 5.2+#if QT_VERSION >= 0x050200+ mResources << obj;+#endif QQuickWindow* win = qobject_cast<QQuickWindow*>(obj); QQuickItem* item = qobject_cast<QQuickItem*>(obj); if (item) { win = new QQuickWindow();- mObjects << win;+ mResources << win; item->setParentItem(win->contentItem()); int width = item->width(); int height = item->height();@@ -95,27 +194,48 @@ } deleteLater(); break;}+ default: break; } } -extern "C" void hsqml_create_engine(+extern "C" HsQMLEngineHandle* hsqml_create_engine( HsQMLObjectHandle* contextObject, HsQMLStringHandle* initialURL, HsQMLStringHandle** importPaths, HsQMLStringHandle** pluginPaths, HsQMLTrivialCb stopCb) {- HsQMLEngineConfig config;- config.contextObject = reinterpret_cast<HsQMLObjectProxy*>(contextObject);- config.initialURL = *reinterpret_cast<QString*>(initialURL);+ Q_ASSERT (gManager);++ HsQMLEngineProxy* proxy = new HsQMLEngineProxy();+ HsQMLEngineCreateEvent* config = new HsQMLEngineCreateEvent(proxy);++ config->contextObject = reinterpret_cast<HsQMLObjectProxy*>(contextObject);+ config->initialURL = *reinterpret_cast<QString*>(initialURL); for (QString** p = reinterpret_cast<QString**>(importPaths); *p; p++) {- config.importPaths.push_back(**p);+ config->importPaths.push_back(**p); } for (QString** p = reinterpret_cast<QString**>(pluginPaths); *p; p++) {- config.pluginPaths.push_back(**p);+ config->pluginPaths.push_back(**p); }- config.stopCb = stopCb;+ config->stopCb = stopCb; - Q_ASSERT (gManager);- gManager->createEngine(config);+ gManager->postAppEvent(config);+ return reinterpret_cast<HsQMLEngineHandle*>(proxy);+}++extern "C" void hsqml_kill_engine(+ HsQMLEngineHandle* hndl)+{+ HsQMLEngineProxy* proxy = reinterpret_cast<HsQMLEngineProxy*>(hndl);++ Q_ASSERT(gManager->isEventThread());+ proxy->kill();+}++extern void hsqml_finalise_engine_handle(+ HsQMLEngineHandle* hndl)+{+ HsQMLEngineProxy* proxy = (HsQMLEngineProxy*)hndl;+ proxy->deref(HsQMLEngineProxy::Handle); }
cbits/Engine.h view
@@ -1,8 +1,9 @@ #ifndef HSQML_ENGINE_H #define HSQML_ENGINE_H -#include <QtCore/QScopedPointer>+#include <QtCore/QEvent> #include <QtCore/QString>+#include <QtCore/QStringList> #include <QtCore/QUrl> #include <QtQml/QQmlEngine> #include <QtQml/QQmlContext>@@ -10,21 +11,49 @@ #include "hsqml.h" +class HsQMLEngine; class HsQMLObjectProxy; class HsQMLWindow; -struct HsQMLEngineConfig+class HsQMLEngineProxy {- HsQMLEngineConfig()- : contextObject(NULL)- , stopCb(NULL)- {}+public:+ HsQMLEngineProxy();+ ~HsQMLEngineProxy(); + void setEngine(HsQMLEngine*);+ HsQMLEngine* engine() const;+ void kill();+ bool dead() const;+ enum RefSrc {Handle, Engine, Event};+ void ref(RefSrc);+ void deref(RefSrc);++private:+ Q_DISABLE_COPY(HsQMLEngineProxy)++ HsQMLEngine* mEngine;+ bool mDead;+ int mSerial;+ QAtomicInt mRefCount;+};++class HsQMLEngineCreateEvent : public QEvent+{+public:+ HsQMLEngineCreateEvent(HsQMLEngineProxy*);+ HsQMLEngineProxy* proxy() const;+ virtual ~HsQMLEngineCreateEvent();++ // Config fields HsQMLObjectProxy* contextObject; QString initialURL; QStringList importPaths; QStringList pluginPaths; HsQMLTrivialCb stopCb;++private:+ HsQMLEngineProxy* mProxy; }; class HsQMLEngine : public QObject@@ -32,7 +61,7 @@ Q_OBJECT public:- HsQMLEngine(const HsQMLEngineConfig&);+ HsQMLEngine(const HsQMLEngineCreateEvent*, QObject* = NULL); ~HsQMLEngine(); bool eventFilter(QObject*, QEvent*); QQmlEngine* declEngine();@@ -41,9 +70,11 @@ Q_DISABLE_COPY(HsQMLEngine) Q_SLOT void componentStatus(QQmlComponent::Status);+ HsQMLEngineProxy* mProxy; QQmlEngine mEngine; QQmlComponent mComponent;- QList<QObject*> mObjects;+ QList<HsQMLObjectProxy*> mGlobals;+ QList<QObject*> mResources; HsQMLTrivialCb mStopCb; };
cbits/Intrinsics.cpp view
@@ -3,6 +3,7 @@ #include <QtQml/QJSValue> #include "Manager.h"+#include "Engine.h" /* String */ extern "C" size_t hsqml_get_string_size()
cbits/Manager.cpp view
@@ -9,7 +9,10 @@ #endif #include "Canvas.h"+#include "Class.h"+#include "Engine.h" #include "Manager.h"+#include "Model.h" #include "Object.h" // Declarations for part of Qt's internal API@@ -23,9 +26,11 @@ "ClassCounter", "ObjectCounter", "QObjectCounter",+ "EngineCounter", "VariantCounter", "ClassSerial",- "ObjectSerial"+ "ObjectSerial",+ "EngineSerial", }; // This definition overrides a symbol in the GHC RTS@@ -83,6 +88,9 @@ , mYieldCb(NULL) , mActiveEngine(NULL) {+ // Set default Qt args+ setArgs(QStringList("HsQML"));+ // Get log level from environment const char* env = std::getenv("HSQML_DEBUG_LOG_LEVEL"); if (env) {@@ -129,6 +137,28 @@ mFreeStable(stablePtr); } +bool HsQMLManager::setArgs(const QStringList& args)+{+ if (mApp || mShutdown) {+ return false;+ }++ mArgs.clear();+ mArgs.reserve(args.size());+ mArgsPtrs.clear();+ mArgsPtrs.reserve(args.size());+ Q_FOREACH(const QString& arg, args) {+ mArgs << arg.toLocal8Bit(); + mArgsPtrs << mArgs.last().data();+ }+ return true;+}++QVector<char*>& HsQMLManager::argsPtrs()+{+ return mArgsPtrs;+}+ void HsQMLManager::registerObject(const QObject* obj) { mObjectSet.insert(obj);@@ -309,13 +339,6 @@ } } -void HsQMLManager::createEngine(const HsQMLEngineConfig& config)-{- Q_ASSERT (mApp);- QMetaObject::invokeMethod(- mApp, "createEngine", Q_ARG(HsQMLEngineConfig, config));-}- void HsQMLManager::setActiveEngine(HsQMLEngine* engine) { Q_ASSERT(!mActiveEngine || !engine);@@ -327,11 +350,21 @@ return mActiveEngine; } -void HsQMLManager::postObjectEvent(HsQMLObjectEvent* ev)+void HsQMLManager::postAppEvent(QEvent* ev) { QCoreApplication::postEvent(mApp, ev); } +void HsQMLManager::zombifyClass(HsQMLClass* clazz)+{+ if (mApp) {+ mZombieClasses << clazz;+ }+ else {+ delete clazz;+ }+}+ HsQMLManager::EventLoopStatus HsQMLManager::shutdown() { QMutexLocker locker(&mLock);@@ -352,12 +385,11 @@ } HsQMLManagerApp::HsQMLManagerApp()- : mArgC(1)- , mArg0(0)- , mArgV(&mArg0)- , mHookedHandler(*gManager->mOriginalHandler)- , mApp(mArgC, &mArgV)+ : mHookedHandler(*gManager->mOriginalHandler)+ , mArgC(gManager->argsPtrs().size())+ , mApp(mArgC, gManager->argsPtrs().data()) {+ gManager->argsPtrs().resize(mArgC); mApp.setQuitOnLastWindowClosed(false); // Install hooked handler for QVariants@@ -366,14 +398,18 @@ QVariantPrivate::registerHandler(0, &mHookedHandler); // Register custom types- qRegisterMetaType<HsQMLEngineConfig>("HsQMLEngineConfig"); qmlRegisterType<HsQMLCanvas>("HsQML.Canvas", 1, 0, "HaskellCanvas"); qmlRegisterType<HsQMLContextControl>( "HsQML.Canvas", 1, 0, "OpenGLContextControl");+ qmlRegisterType<HsQMLAutoListModel>(+ "HsQML.Model", 1, 0, "AutoListModel"); } HsQMLManagerApp::~HsQMLManagerApp()-{}+{+ qDeleteAll(gManager->mZombieClasses);+ gManager->mZombieClasses.clear();+} void HsQMLManagerApp::customEvent(QEvent* ev) {@@ -396,6 +432,17 @@ case HsQMLManagerApp::RemoveGCLockEvent: { static_cast<HsQMLObjectEvent*>(ev)->process(); break;}+ case HsQMLManagerApp::CreateEngineEvent: {+ HsQMLEngineCreateEvent* create =+ static_cast<HsQMLEngineCreateEvent*>(ev);+ if (create->proxy()->dead()) {+ create->stopCb();+ }+ else {+ new HsQMLEngine(create, this);+ }+ break;}+ default: break; } } @@ -405,12 +452,6 @@ gManager->mYieldCb(); } -void HsQMLManagerApp::createEngine(HsQMLEngineConfig config)-{- HsQMLEngine* engine = new HsQMLEngine(config);- engine->setParent(this);-}- int HsQMLManagerApp::exec() { return mApp.exec();@@ -425,6 +466,31 @@ if (!gManager.testAndSetOrdered(NULL, manager)) { delete manager; }+ }+}++extern "C" int hsqml_set_args(+ HsQMLStringHandle** args)+{+ QStringList argsList;+ for (QString** p = reinterpret_cast<QString**>(args); *p; p++) {+ argsList.push_back(**p);+ }+ return gManager->setArgs(argsList);+}++extern "C" int hsqml_get_args_count()+{+ return gManager->argsPtrs().size();+}++extern "C" void hsqml_get_args(HsQMLStringHandle** args)+{+ int argc = gManager->argsPtrs().size();+ char** argv = gManager->argsPtrs().data();+ for (int i=0; i<argc; i++) {+ QString* string = reinterpret_cast<QString*>(args[i]);+ *string = QString::fromLocal8Bit(argv[i]); } }
cbits/Manager.h view
@@ -3,19 +3,22 @@ #include <QtCore/QAtomicPointer> #include <QtCore/QAtomicInt>+#include <QtCore/QByteArray> #include <QtCore/QMutex> #include <QtCore/QSet> #include <QtCore/QString>+#include <QtCore/QStringList> #include <QtCore/QVariant>+#include <QtCore/QVector> #include <QtWidgets/QApplication> #include "hsqml.h"-#include "Engine.h" #define HSQML_LOG(ll, msg) if (gManager->checkLogLevel(ll)) gManager->log(msg) class HsQMLManagerApp;-class HsQMLObjectEvent;+class HsQMLClass;+class HsQMLEngine; class HsQMLManager {@@ -25,8 +28,10 @@ ObjectCount, QObjectCount, VariantCount,+ EngineCount, ClassSerial, ObjectSerial,+ EngineSerial, TotalCounters }; @@ -39,6 +44,8 @@ int updateCounter(CounterId, int); void freeFun(HsFunPtr); void freeStable(HsStablePtr);+ bool setArgs(const QStringList&);+ QVector<char*>& argsPtrs(); void registerObject(const QObject*); void unregisterObject(const QObject*); void hookedConstruct(QVariant::Private*, const void*);@@ -50,10 +57,10 @@ EventLoopStatus requireEventLoop(); void releaseEventLoop(); void notifyJobs();- void createEngine(const HsQMLEngineConfig&); void setActiveEngine(HsQMLEngine*); HsQMLEngine* activeEngine();- void postObjectEvent(HsQMLObjectEvent*);+ void postAppEvent(QEvent*);+ void zombifyClass(HsQMLClass*); EventLoopStatus shutdown(); private:@@ -66,7 +73,10 @@ bool mAtExit; void (*mFreeFun)(HsFunPtr); void (*mFreeStable)(HsStablePtr);+ QVector<QByteArray> mArgs;+ QVector<char*> mArgsPtrs; QSet<const QObject*> mObjectSet;+ QVector<HsQMLClass*> mZombieClasses; const QVariant::Handler* mOriginalHandler; HsQMLManagerApp* mApp; QMutex mLock;@@ -89,14 +99,14 @@ virtual ~HsQMLManagerApp(); virtual void customEvent(QEvent*); virtual void timerEvent(QTimerEvent*);- Q_SLOT void createEngine(HsQMLEngineConfig); int exec(); enum CustomEventIndicies { StartedLoopEventIndex, StopLoopEventIndex, PendingJobsEventIndex,- RemoveGCLockEventIndex+ RemoveGCLockEventIndex,+ CreateEngineEventIndex, }; static const QEvent::Type StartedLoopEvent =@@ -107,14 +117,14 @@ static_cast<QEvent::Type>(QEvent::User+PendingJobsEventIndex); static const QEvent::Type RemoveGCLockEvent = static_cast<QEvent::Type>(QEvent::User+RemoveGCLockEventIndex);+ static const QEvent::Type CreateEngineEvent =+ static_cast<QEvent::Type>(QEvent::User+CreateEngineEventIndex); private: Q_DISABLE_COPY(HsQMLManagerApp) - int mArgC;- char mArg0;- char* mArgV; QVariant::Handler mHookedHandler;+ int mArgC; QApplication mApp; };
+ cbits/Model.cpp view
@@ -0,0 +1,339 @@+#include <QtCore/QMultiHash>++#include "Model.h"+#include "Manager.h"++HsQMLAutoListModel::HsQMLAutoListModel(QObject* parent)+ : QAbstractListModel(parent)+ , mMode(ByReset)+ , mEqualityTestValid(false)+ , mKeyFunctionValid(false)+ , mOldOffset(0)+ , mDefer(false)+ , mPending(false)+{+}++void HsQMLAutoListModel::classBegin()+{+ mDefer = true;+}++void HsQMLAutoListModel::componentComplete()+{+ mDefer = false;+ if (mPending) {+ updateModel();+ }+}++int HsQMLAutoListModel::rowCount(const QModelIndex&) const+{+ return fromOldIndex(mOldModel.size());+}++QVariant HsQMLAutoListModel::data(const QModelIndex& index, int) const+{+ int i = index.row();+ const Element& e =+ i < mNewModel.size() ? mNewModel[i] : mOldModel[toOldIndex(i)];+ return e.mValue.toVariant();+}++QHash<int, QByteArray> HsQMLAutoListModel::roleNames() const+{+ QHash<int, QByteArray> roleNames;+ roleNames.insert(Qt::UserRole, QByteArray("modelData"));+ return roleNames;+}++void HsQMLAutoListModel::setMode(Mode mode)+{+ mMode = mode;+}++HsQMLAutoListModel::Mode HsQMLAutoListModel::mode() const+{+ return mMode;+}++void HsQMLAutoListModel::setSource(const QJSValue& source)+{+ bool change = !mSource.strictlyEquals(source);+ mSource = source;+ if (change) {+ sourceChanged();+ }+ updateModel();+}++QJSValue HsQMLAutoListModel::source() const+{+ return mSource;+}++void HsQMLAutoListModel::setEqualityTest(const QJSValue& equalityTest)+{+ mEqualityTest = equalityTest;+ mEqualityTestValid = equalityTest.isCallable();+}++QJSValue HsQMLAutoListModel::equalityTest() const+{+ return mEqualityTest;+}++void HsQMLAutoListModel::setKeyFunction(const QJSValue& keyFunction)+{+ mKeyFunction = keyFunction;+ mKeyFunctionValid = keyFunction.isCallable();+ mRehash = true;+}++QJSValue HsQMLAutoListModel::keyFunction() const+{+ return mKeyFunction;+}++void HsQMLAutoListModel::updateModel()+{+ if (mDefer) {+ mPending = true;+ return;+ }++ switch (mMode) {+ case ByReset:+ updateModelByReset(); break;+ case ByIndex:+ updateModelByIndex(); break;+ case ByKey:+ updateModelByKey(true); break;+ case ByKeyNoReorder:+ updateModelByKey(false); break;+ }+}++void HsQMLAutoListModel::updateModelByReset()+{+ int srcLen = sourceLength();++ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByReset: Inserted %d elements.", srcLen));+ beginResetModel();+ mOldModel.clear();+ mOldModel.reserve(srcLen);+ for (int i=0; i<srcLen; i++) {+ mOldModel.append(Element(mSource.property(i)));+ }+ endResetModel();++ // This mode doesn't maintain the hashes+ mRehash = true;+}++void HsQMLAutoListModel::updateModelByIndex()+{+ int srcLen = sourceLength();+ int oldLen = mOldModel.size();++ // Notify views which elements have changed+ for (int i=0; i<qMin(srcLen, oldLen); i++) {+ handleInequality(mSource.property(i), mOldModel, i);+ }++ // Add or remove elements to/from the end of the list+ if (srcLen > oldLen) {+ mOldModel.reserve(srcLen);+ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByIndex: Inserted %d extra elements at %d.",+ srcLen - oldLen, oldLen));+ beginInsertRows(QModelIndex(), oldLen, srcLen-1);+ for (int i=oldLen; i<srcLen; i++) {+ mOldModel.append(Element(mSource.property(i)));+ }+ endInsertRows();+ }+ else if (oldLen > srcLen) {+ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByIndex: Removed %d excess elements at %d.",+ oldLen - srcLen, srcLen));+ beginRemoveRows(QModelIndex(), srcLen, oldLen-1);+ mOldModel.erase(mOldModel.begin()+srcLen, mOldModel.end());+ endRemoveRows();+ }++ // This mode doesn't maintain the hashes+ mRehash = true;+}++void HsQMLAutoListModel::updateModelByKey(bool reorder)+{+ int srcLen = sourceLength();++ // Build a map of element key's highest indices in the new source+ typedef QHash<QString, int> SrcDict;+ SrcDict srcDict;+ if (reorder) {+ for (int i=0; i<srcLen; i++) {+ QJSValue srcVal = mSource.property(i);+ srcDict.insert(keyFunction(srcVal), i);+ }+ }++ // Build a map of element key's previous indices in the old model+ typedef QMultiHash<QString, int> ModelDict;+ ModelDict modelDict;+ for (int idx = mOldModel.size()-1; idx >= 0; --idx) {+ Element& e = mOldModel[idx];+ if (mRehash) {+ e.mKey = keyFunction(e.mValue);+ }+ modelDict.insert(e.mKey, idx);+ }+ mRehash = false;++ // Rearrange and insert new elements+ Q_ASSERT(!mNewModel.size() && !mOldOffset);+ mNewModel.reserve(srcLen);+ for (int i=0; i<srcLen; i++) {+ QJSValue srcVal = mSource.property(i);+ QString srcKey = keyFunction(srcVal);++ ModelDict::iterator it = modelDict.find(srcKey);+ if (it != modelDict.end()) {+ const int elemIdx = *it;+ Q_ASSERT(elemIdx >= mOldOffset);+ Q_ASSERT(elemIdx < mOldModel.size());+ modelDict.erase(it);++ // Try removing elements before target+ while (elemIdx > mOldOffset) {+ const Element& nextElem = mOldModel[mOldOffset];++ if (reorder) {+ // Check if element will be used later+ SrcDict::iterator srcIt = srcDict.find(nextElem.mKey);+ if (srcIt != srcDict.end()) {+ if (srcIt.value() >= i) {+ // Old element is still needed by the new source+ break;+ }+ }+ }++ // Remove element+ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByKey: Removed element at %d.", i));+ beginRemoveRows(QModelIndex(), i, i);+ mOldOffset++;+ endRemoveRows();+ modelDict.erase(modelDict.find(nextElem.mKey));+ }++ // Move target element earlier in list if needed+ if (elemIdx > mOldOffset) {+ Q_ASSERT(reorder);+ int srcIdx = fromOldIndex(elemIdx);+ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByKey: Moved element at %d to %d.",+ srcIdx, i));+ beginMoveRows(QModelIndex(), srcIdx, srcIdx, QModelIndex(), i);+ mNewModel.append(mOldModel[elemIdx]);+ mOldModel.remove(elemIdx);+ endMoveRows();++ // Renumber remaining indices in the old model+ for (ModelDict::iterator renumIt = modelDict.begin();+ renumIt != modelDict.end();) {+ ModelDict::iterator currIt = renumIt++;+ Q_ASSERT(currIt.value() >= mOldOffset);+ if (currIt.value() > elemIdx) {+ currIt.value()--;+ }+ }+ }+ else {+ // Transfer element from old to new model+ mNewModel.append(mOldModel[elemIdx]);+ mOldOffset++;+ }++ // Has value changed?+ handleInequality(srcVal, mNewModel, i);+ Q_ASSERT(mNewModel.size() == i+1);+ }+ else {+ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByKey: Inserted element at %d.", i));+ beginInsertRows(QModelIndex(), i, i);+ mNewModel.append(Element(srcVal, srcKey));+ endInsertRows();+ }+ }++ // Move element to the old model, removing any excess elements from the end+ bool excess = mOldOffset < mOldModel.size();+ if (excess) {+ HSQML_LOG(3, QString().sprintf(+ "AutoListModel.ByKey: Removed %d excess elements at %d.",+ mOldModel.size() - mOldOffset, srcLen));+ beginRemoveRows(QModelIndex(), srcLen, rowCount(QModelIndex())-1);+ }+ mNewModel.swap(mOldModel);+ mNewModel.clear();+ mOldOffset = 0;+ if (excess) {+ endRemoveRows();+ }+}++int HsQMLAutoListModel::sourceLength()+{+ return mSource.property("length").toInt();+}++int HsQMLAutoListModel::toOldIndex(int i) const+{+ return i - mNewModel.size() + mOldOffset;+}++int HsQMLAutoListModel::fromOldIndex(int i) const+{+ return i + mNewModel.size() - mOldOffset;+}++void HsQMLAutoListModel::handleInequality(+ const QJSValue& a, Model& model, int i)+{+ if (!equalityTest(a, model[i].mValue)) {+ model[i].mValue = a;+ QModelIndex idx = createIndex(i, 0);+ dataChanged(idx, idx);+ }+}++bool HsQMLAutoListModel::equalityTest(const QJSValue& a, const QJSValue& b)+{+ if (mEqualityTestValid) {+ QJSValueList args;+ args.append(a);+ args.append(b);+ return mEqualityTest.call(args).toBool();+ }+ else {+ return a.equals(b);+ }+}++QString HsQMLAutoListModel::keyFunction(const QJSValue& a)+{+ if (mKeyFunctionValid) {+ QJSValueList args;+ args.append(a);+ return mKeyFunction.call(args).toString();+ }+ else {+ return a.toString();+ }+}
+ cbits/Model.h view
@@ -0,0 +1,85 @@+#ifndef HSQML_MODEL_H+#define HSQML_MODEL_H++#include <QtCore/QAbstractListModel>+#include <QtCore/QVector>+#include <QtQml/QJSValue>+#include <QtQml/QQmlParserStatus>++class HsQMLAutoListModel : public QAbstractListModel, public QQmlParserStatus+{+ Q_OBJECT+ Q_INTERFACES(QQmlParserStatus)+ Q_ENUMS(Mode)+ Q_PROPERTY(Mode mode READ mode WRITE setMode)+ Q_PROPERTY(QJSValue source READ source WRITE setSource NOTIFY sourceChanged)+ Q_PROPERTY(QJSValue equalityTest READ equalityTest WRITE setEqualityTest)+ Q_PROPERTY(QJSValue keyFunction READ keyFunction WRITE setKeyFunction)++public:+ enum Mode {+ ByReset,+ ByIndex,+ ByKey,+ ByKeyNoReorder+ };++ HsQMLAutoListModel(QObject* = NULL);++ int rowCount(const QModelIndex&) const;+ QVariant data(const QModelIndex&, int) const;+ QHash<int, QByteArray> roleNames() const;++ Q_SIGNAL void sourceChanged();+ void classBegin();+ void componentComplete();+ void setMode(Mode);+ Mode mode() const;+ void setSource(const QJSValue&);+ QJSValue source() const;+ void setEqualityTest(const QJSValue&);+ QJSValue equalityTest() const;+ void setKeyFunction(const QJSValue&);+ QJSValue keyFunction() const;++private:+ struct Element {+ Element() {}+ Element(const QJSValue& value) : mValue(value) {}+ Element(const QJSValue& value, const QString& key)+ : mValue(value), mKey(key) {}+ QJSValue mValue;+ QString mKey;+ };+ typedef QVector<Element> Model;++ void updateModel();+ void updateModelByReset();+ void updateModelByIndex();+ void updateModelByKey(bool);+ int sourceLength();+ int toOldIndex(int) const;+ int fromOldIndex(int) const;+ bool modeTest(const QJSValue&, const QString&, int, int);+ void handleInequality(const QJSValue&, Model&, int);+ bool equalityTest(const QJSValue&, const QJSValue&);+ bool identityTest(const QJSValue&, const QJSValue&);+ QString keyFunction(const QJSValue&);++ Mode mMode;+ QJSValue mSource;+ QJSValue mEqualityTest;+ bool mEqualityTestValid;+ QJSValue mIdentityTest;+ bool mIdentityTestValid;+ QJSValue mKeyFunction;+ bool mKeyFunctionValid;+ Model mOldModel;+ Model mNewModel;+ int mOldOffset;+ bool mDefer;+ bool mPending;+ bool mRehash;+};++#endif //HSQML_MODEL_H
cbits/Object.cpp view
@@ -5,10 +5,20 @@ #include "Object.h" #include "Class.h"+#include "Engine.h" #include "Manager.h" -static const char* cRefSrcNames[] = {"Hndl", "Weak", "Obj", "Event", "Var"};+static const char* cRefSrcNames[] = {+ "Hndl", "Weak", "Eng", "Var", "Obj", "Event"+}; +static bool isStrongRef(HsQMLObjectProxy::RefSrc src)+{+ return src == HsQMLObjectProxy::Handle ||+ src == HsQMLObjectProxy::Engine ||+ src == HsQMLObjectProxy::Variant;+}+ HsQMLObjectFinaliser::HsQMLObjectFinaliser(HsQMLObjFinaliserCb cb) : mFinaliseCb(cb) {}@@ -87,7 +97,7 @@ { Q_ASSERT(gManager->isEventThread()); - if (mObject && mHndlCount.loadAcquire() > 0 && !mObject->isGCLocked()) {+ if (mObject && mStrongCount.loadAcquire() > 0 && !mObject->isGCLocked()) { mObject->setGCLock(); HSQML_LOG(5,@@ -100,7 +110,7 @@ { Q_ASSERT(gManager->isEventThread()); - if (mObject && mHndlCount.loadAcquire() == 0) {+ if (mObject && mStrongCount.loadAcquire() == 0) { if (mObject->isGCLocked()) { mObject->clearGCLock(); @@ -154,22 +164,22 @@ count ? "Ref" : "New", mKlass->name(), mSerial, cRefSrcNames[src], count+1)); - if (src == Handle || src == Variant) {- mHndlCount.fetchAndAddOrdered(1);+ if (isStrongRef(src)) {+ mStrongCount.fetchAndAddOrdered(1); } } void HsQMLObjectProxy::deref(RefSrc src) { // Remove JavaScript GC lock when there are no strong handles- if (src == Handle || src == Variant) {- int hndlCount = mHndlCount.fetchAndAddOrdered(-1);- if (hndlCount == 1 && mObject) {+ if (isStrongRef(src)) {+ int strongCount = mStrongCount.fetchAndAddOrdered(-1);+ if (strongCount == 1 && mObject) { if (src == Handle) { // Handles can be dereferenced from any thread. The event will // remove the lock if there are still no handles by the time // it reaches the event loop.- gManager->postObjectEvent(new HsQMLObjectEvent(this));+ gManager->postAppEvent(new HsQMLObjectEvent(this)); } else { removeGCLock();
cbits/Object.h view
@@ -45,7 +45,7 @@ void addFinaliser(const HsQMLObjectFinaliser::Ref&); void runFinalisers(); HsQMLEngine* engine() const;- enum RefSrc {Handle, WeakHandle, Object, Event, Variant};+ enum RefSrc {Handle, WeakHandle, Engine, Variant, Object, Event}; void ref(RefSrc); void deref(RefSrc); @@ -57,7 +57,7 @@ int mSerial; HsQMLObject* volatile mObject; QAtomicInt mRefCount;- QAtomicInt mHndlCount;+ QAtomicInt mStrongCount; QMutex mFinaliseMutex; typedef QVarLengthArray<HsQMLObjectFinaliser::Ref, 1> Finalisers; Finalisers mFinalisers;
cbits/hsqml.h view
@@ -8,13 +8,11 @@ #include <stddef.h> #include <HsFFI.h> -/* Manager */+/* Init */ extern void hsqml_init( void (*)(HsFunPtr), void (*)(HsStablePtr)); -extern void hsqml_set_debug_loglevel(int);- /* Event Loop */ typedef void (*HsQMLTrivialCb)(); @@ -191,13 +189,30 @@ extern void hsqml_object_add_finaliser( HsQMLObjectHandle*, HsQMLObjFinaliserHandle*); +/* Global */+extern int hsqml_set_args(HsQMLStringHandle**);++extern int hsqml_get_args_count();++extern void hsqml_get_args(HsQMLStringHandle**);++extern void hsqml_set_debug_loglevel(int);+ /* Engine */-extern void hsqml_create_engine(+typedef char HsQMLEngineHandle;++extern HsQMLEngineHandle* hsqml_create_engine( HsQMLObjectHandle*, HsQMLStringHandle*, HsQMLStringHandle**, HsQMLStringHandle**, HsQMLTrivialCb stopCb);++extern void hsqml_kill_engine(+ HsQMLEngineHandle*);++extern void hsqml_finalise_engine_handle(+ HsQMLEngineHandle*); /* Canvas */ typedef char HsQMLGLDelegateHandle;
hsqml.cabal view
@@ -1,10 +1,10 @@ Name: hsqml-Version: 0.3.3.0+Version: 0.3.4.0 Cabal-version: >= 1.14 Build-type: Custom License: BSD3 License-file: LICENSE-Copyright: (c) 2010-2015 Robin KAY+Copyright: (c) 2010-2016 Robin KAY Author: Robin KAY Maintainer: komadori@gekkou.co.uk Stability: experimental@@ -40,21 +40,27 @@ Override the OnExitHook symbol to shutdown the Qt framework on exit. Default: True +Flag EnableQmlDebugging+ Description:+ Allow the QML debug server to be enabled via Qt arguments.+ Default: False+ Library Default-language: Haskell2010 Build-depends: base == 4.*, containers >= 0.4 && < 0.6,- filepath == 1.3.*,+ filepath >= 1.3 && < 1.5, text >= 0.11 && < 1.3,- tagged >= 0.4 && < 0.8,- transformers >= 0.2 && < 0.5+ tagged >= 0.4 && < 0.9,+ transformers >= 0.2 && < 0.6 Exposed-modules: Graphics.QML Graphics.QML.Debug Graphics.QML.Canvas Graphics.QML.Engine Graphics.QML.Marshal+ Graphics.QML.Model Graphics.QML.Objects Graphics.QML.Objects.ParamNames Graphics.QML.Objects.Weak@@ -75,18 +81,22 @@ cbits/Engine.cpp cbits/Intrinsics.cpp cbits/Manager.cpp+ cbits/Model.cpp cbits/Object.cpp Include-dirs: cbits X-moc-headers: cbits/Canvas.h cbits/Engine.h cbits/Manager.h+ cbits/Model.h X-separate-cbits: True Build-tools: c2hs if flag(ForceGHCiLib) X-force-ghci-lib: True if flag(UseExitHook) CC-options: -DHSQML_USE_EXIT_HOOK+ if flag(EnableQmlDebugging)+ CC-options: -DQT_QML_DEBUG_NO_WARNING if os(windows) && !flag(UsePkgConfig) Include-dirs: /QT_ROOT/include Extra-libraries:@@ -120,8 +130,8 @@ containers >= 0.4 && < 0.6, directory >= 1.1 && < 1.3, text >= 0.11 && < 1.3,- tagged >= 0.4 && < 0.8,- QuickCheck >= 2.4 && < 2.8,+ tagged >= 0.4 && < 0.9,+ QuickCheck >= 2.4 && < 2.9, hsqml == 0.3.* if os(darwin) && !flag(UsePkgConfig) -- Library not registered yet
src/Graphics/QML/Engine.hs view
@@ -19,11 +19,16 @@ runEngineWith, runEngineAsync, runEngineLoop,+ joinEngine,+ killEngine, -- * Event Loop RunQML(), runEventLoop,+ runEventLoopNoArgs, requireEventLoop,+ setQtArgs,+ getQtArgs, shutdownQt, EventLoopException(), @@ -45,13 +50,15 @@ import Control.Exception import Control.Monad import Control.Monad.IO.Class+import Control.Monad.Trans.Maybe import qualified Data.Text as T import Data.List-import Data.Traversable+import Data.Traversable (sequenceA) import Data.Typeable import Foreign.Marshal.Array import Foreign.Ptr import Foreign.Storable+import System.Environment (getProgName, getArgs, withProgName, withArgs) import System.FilePath (FilePath, isAbsolute, splitDirectories, pathSeparators) -- | Holds parameters for configuring a QML runtime engine.@@ -77,22 +84,26 @@ } -- | Represents a QML engine.-data Engine = Engine+data Engine = Engine HsQMLEngineHandle (MVar ()) -runEngineImpl :: EngineConfig -> IO () -> IO Engine-runEngineImpl config stopCb = do+-- | Starts a new QML engine using the supplied configuration and returns+-- immediately without blocking.+runEngineAsync :: EngineConfig -> RunQML Engine+runEngineAsync config = RunQML $ do hsqmlInit+ finishVar <- newEmptyMVar let obj = contextObject config DocumentPath res = initialDocument config impPaths = importPaths config plugPaths = pluginPaths config- hndl <- sequenceA $ fmap mToHndl obj- mWithCVal (T.pack res) $ \resPtr ->+ stopCb = putMVar finishVar () + ctxHndl <- sequenceA $ fmap mToHndl obj+ engHndl <- mWithCVal (T.pack res) $ \resPtr -> withManyArray0 mWithCVal (map T.pack impPaths) nullPtr $ \impPtr -> withManyArray0 mWithCVal (map T.pack plugPaths) nullPtr $ \plugPtr ->- hsqmlCreateEngine hndl (HsQMLStringHandle $ castPtr resPtr)+ hsqmlCreateEngine ctxHndl (HsQMLStringHandle $ castPtr resPtr) (castPtr impPtr) (castPtr plugPtr) stopCb- return Engine+ return $ Engine engHndl finishVar withMany :: (a -> (b -> m c) -> m c) -> [a] -> ([b] -> m c) -> m c withMany func as cont =@@ -105,28 +116,28 @@ withManyArray0 func as term cont = withMany func as $ \ptrs -> withArray0 term ptrs cont --- | Starts a new QML engine using the supplied configuration and blocks until--- the engine has terminated.-runEngine :: EngineConfig -> RunQML ()-runEngine config = runEngineWith config (const $ return ())+-- | Waits for the specified Engine to terminate.+joinEngine :: Engine -> IO ()+joinEngine (Engine _ finishVar) = void $ readMVar finishVar +-- | Kills the specified Engine asynchronously.+killEngine :: Engine -> IO ()+killEngine (Engine hndl _) = postJob $ hsqmlKillEngine hndl+ -- | Starts a new QML engine using the supplied configuration. The \'with\' -- function is executed once the engine has been started and after it returns -- this function blocks until the engine has terminated. runEngineWith :: EngineConfig -> (Engine -> RunQML a) -> RunQML a-runEngineWith config with = RunQML $ do- finishVar <- newEmptyMVar- let stopCb = putMVar finishVar () - eng <- runEngineImpl config stopCb- let (RunQML withIO) = with eng- ret <- withIO- void $ takeMVar finishVar+runEngineWith config with = do+ eng <- runEngineAsync config+ ret <- with eng+ RunQML $ joinEngine eng return ret --- | Starts a new QML engine using the supplied configuration and returns--- immediately without blocking.-runEngineAsync :: EngineConfig -> RunQML Engine-runEngineAsync config = RunQML $ runEngineImpl config (return ())+-- | Starts a new QML engine using the supplied configuration and blocks until+-- the engine has terminated.+runEngine :: EngineConfig -> RunQML ()+runEngine config = runEngineAsync config >>= (RunQML . joinEngine) -- | Conveniance function that both runs the event loop and starts a new QML -- engine. It blocks keeping the event loop running until the engine has@@ -154,8 +165,25 @@ -- can be started again, but only on the same operating system thread as -- before. If the event loop fails to start then an 'EventLoopException' will -- be thrown.+--+-- If the event loop is entered for the first time then the currently set+-- runtime command line arguments will be passed to Qt. Hence, while calling+-- back to the supplied function, attempts to read the runtime command line+-- arguments using the System.Environment module will only return those+-- arguments not already consumed by Qt (per 'getQtArgs'). runEventLoop :: RunQML a -> IO a-runEventLoop (RunQML runFn) = tryRunInBoundThread $ do+runEventLoop (RunQML runFn) = do+ prog <- getProgName+ args <- getArgs+ setQtArgs prog args+ runEventLoopNoArgs . RunQML $ do+ (prog', args') <- getQtArgsIO+ withProgName prog' $ withArgs args' runFn++-- | Enters the Qt event loop in the same manner as 'runEventLoop', but does+-- not perform any processing related to command line arguments.+runEventLoopNoArgs :: RunQML a -> IO a+runEventLoopNoArgs (RunQML runFn) = tryRunInBoundThread $ do hsqmlInit finishVar <- newEmptyMVar let startCb = void $ forkIO $ do@@ -194,6 +222,31 @@ Just ex -> throw ex Nothing -> return () bracket_ reqFn hsqmlEvloopRelease runFn++-- | Sets the program name and command line arguments used by Qt and returns+-- True if successful. This must be called before the first time the Qt event+-- loop is entered otherwise it will have no effect and return False. By+-- default Qt receives no arguments and the program name is set to "HsQML".+setQtArgs :: String -> [String] -> IO Bool+setQtArgs prog args = do+ hsqmlInit+ withManyArray0 mWithCVal (map T.pack (prog:args)) nullPtr+ (hsqmlSetArgs . castPtr)++-- | Gets the program name and any command line arguments remaining from an+-- earlier call to 'setQtArgs' once Qt has removed any it understands, leaving+-- only application specific arguments.+getQtArgs :: RunQML (String, [String])+getQtArgs = RunQML getQtArgsIO++getQtArgsIO :: IO (String, [String])+getQtArgsIO = do+ argc <- hsqmlGetArgsCount+ withManyArray0 mWithCVal (replicate argc $ T.pack "") nullPtr $ \argv -> do+ hsqmlGetArgs $ castPtr argv+ argvs <- peekArray0 nullPtr argv+ Just (arg0:args) <- runMaybeT $ mapM (fmap T.unpack . mFromCVal) argvs+ return (arg0, args) -- | Shuts down and frees resources used by the Qt framework, preventing -- further use of the event loop. The framework is initialised when
src/Graphics/QML/Internal/BindCanvas.chs view
@@ -9,7 +9,7 @@ import Foreign.C.Types import Foreign.Marshal.Utils import Foreign.Ptr-import Foreign.ForeignPtr.Safe+import Foreign.ForeignPtr import Foreign.Storable #include "hsqml.h"
src/Graphics/QML/Internal/BindCore.chs view
@@ -9,6 +9,8 @@ {#import Graphics.QML.Internal.BindObj #} import Foreign.C.Types+import Foreign.ForeignPtr+import Foreign.Marshal.Utils (toBool) import Foreign.Ptr #include <HsFFI.h>@@ -31,6 +33,18 @@ hsqmlInit :: IO () hsqmlInit = hsqmlInit_ hsFreeFunPtr hsFreeStablePtr +{#fun unsafe hsqml_set_args as ^+ {id `Ptr HsQMLStringHandle'} ->+ `Bool' toBool #}++{#fun unsafe hsqml_get_args_count as ^+ {} ->+ `Int' fromIntegral #}++{#fun unsafe hsqml_get_args as ^+ {id `Ptr HsQMLStringHandle'} ->+ `()' #}+ type TrivialCb = IO () foreign import ccall "wrapper" @@ -67,12 +81,26 @@ {} -> `HsQMLEventLoopStatus' cIntToEnum #} +{#pointer *HsQMLEngineHandle as ^ foreign newtype #}++foreign import ccall "hsqml.h &hsqml_finalise_engine_handle"+ hsqmlFinaliseEngineHandlePtr :: FunPtr (Ptr (HsQMLEngineHandle) -> IO ())++newEngineHandle :: Ptr HsQMLEngineHandle -> IO HsQMLEngineHandle+newEngineHandle p = do+ fp <- newForeignPtr hsqmlFinaliseEngineHandlePtr p+ return $ HsQMLEngineHandle fp+ {#fun hsqml_create_engine as ^ {withMaybeHsQMLObjectHandle* `Maybe HsQMLObjectHandle', id `HsQMLStringHandle', id `Ptr HsQMLStringHandle', id `Ptr HsQMLStringHandle', withTrivialCb* `TrivialCb'} ->+ `HsQMLEngineHandle' newEngineHandle* #}++{#fun hsqml_kill_engine as ^+ {withHsQMLEngineHandle* `HsQMLEngineHandle'} -> `()' #} {#fun unsafe hsqml_set_debug_loglevel as ^
src/Graphics/QML/Internal/BindObj.chs view
@@ -12,8 +12,8 @@ import Foreign.C.Types import Foreign.Marshal.Utils (fromBool, toBool) import Foreign.Ptr-import Foreign.ForeignPtr.Safe-import Foreign.ForeignPtr.Unsafe+import Foreign.ForeignPtr+import qualified Foreign.ForeignPtr.Unsafe as UnsafeFPtr import Foreign.StablePtr #include "hsqml.h"@@ -77,7 +77,7 @@ isNullObjectHandle :: HsQMLObjectHandle -> Bool isNullObjectHandle (HsQMLObjectHandle fp) =- nullPtr == unsafeForeignPtrToPtr fp+ nullPtr == UnsafeFPtr.unsafeForeignPtrToPtr fp {#fun unsafe hsqml_create_object as ^ {marshalStable* `a',
src/Graphics/QML/Internal/Marshal.hs view
@@ -10,6 +10,8 @@ import Graphics.QML.Internal.BindPrim import Graphics.QML.Internal.BindObj +import Prelude hiding (catch)+import Control.Exception (SomeException(SomeException), catch) import Control.Monad.Trans.Maybe import Data.Maybe import Data.Tagged@@ -20,7 +22,7 @@ runErrIO :: ErrIO a -> IO () runErrIO m = do- r <- runMaybeT m+ r <- catch (runMaybeT m) $ \(SomeException _) -> return Nothing if isNothing r then hPutStrLn stderr "Warning: Marshalling error." else return ()
+ src/Graphics/QML/Model.hs view
@@ -0,0 +1,57 @@+{-| Facility for working with Qt data models.++This module is a placeholder for the ability to freely define QML classes which+implement the @QAbstractItemModel@ interface and functions to interact with+those models. This is not currently supported, but the functionality will be+available in a future release.++HsQML does currently provide one mechanism for creating a Qt data model, the+@AutoListModel@ item. This item implements the @QAbstractItemModel@ interface+and provides a QML-side solution for generating a stateful Qt data model from a+succession of JavaScript arrays.++The advantage of this over using the arrays directly is that, when the array+changes, the @AutoListModel@ can generate item add, remove, and change events+based on the differences between the old and new arrays. An simple array+binding, on the other hand, causes the entire model to be reset so that views+lose their state, cannot animate changes, etc.++To use this facility, you must assign an @AutoListModel@ item to the @model@+property of a QML view such as a @Repeater@ item. In turn, the @source@+property of the @AutoListModel@ must then be bound to an expression yielding+the arrays you want to use. The @AutoListModel@ can be imported from the+@HsQML.Model 1.0@ module using an @import@ statement in your QML script and it+has several properties which can be set from QML as described below:++[@mode@] Specifies how the model is updated when the source array changes.+Possible values are:++ [@AutoListModel.ByReset@] The model is reset entirely (default). + [@AutoListModel.ByIndex@] The elements in the old and new arrays are+ compared for equality and change signals are sent for any that aren't+ equal. If the length of the array has changed then elements will be added+ to or removed from the end of the list model. + [@AutoListModel.ByKey@] The key function is applied to each element in the+ old and new arrays. According to the key, elements which exist in both the+ old and new arrays are moved to their new positions in the list model as+ necessary, elements which only exist in the new array are added, and ones+ which only existed in the old are removed. Where elements have been moved,+ the old and new values are compared for equality and change signals are+ sent for any that aren't equal. Unlike the other modes which only require+ linear time to process the arrays, if elements are reordered then this mode+ requires quadratic time in the worst case.+ [@AutoListModel.ByKeyNoReorder@] This is the same as the ByKey mode except+ that the model will not explicitly move elements to different positions,+ only remove and re-add them at their new location as necessary.++[@source@] JavaScript array containing the elements for the model.+[@equalityTest@] JavaScript function which takes two parameters, compares them+for equality, and returns a boolean. This is used by all the modes except+@ByReset@. If no function is set then the model will use the JavaScript equals+operator by default.+[@keyFunction@] JavaScript function which takes a single parameter and+returns a string key for use by the @ByKey@ and @ByKeyNoReorder@ modes. If no+function is set then the model will use JavaScript's string conversion by+default.+-}+module Graphics.QML.Model () where
+ test/Graphics/QML/Test/AutoListTest.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE DeriveDataTypeable, FlexibleInstances, TypeFamilies #-}++module Graphics.QML.Test.AutoListTest where++import Graphics.QML.Marshal+import Graphics.QML.Objects+import Graphics.QML.Test.Framework+import Graphics.QML.Test.MayGen+import Graphics.QML.Test.TestObject+import Graphics.QML.Test.ScriptDSL (Expr, Prog)+import qualified Graphics.QML.Test.ScriptDSL as S++import Test.QuickCheck.Arbitrary+import Test.QuickCheck.Gen+import Control.Applicative+import Data.Int+import Data.Monoid+import Data.Proxy+import Data.Text (Text)+import qualified Data.Text as T+import Data.Typeable++data Mode = ByReset | ByIndex | ByKey | ByKeyNoReorder+ deriving (Bounded, Enum, Eq, Show, Typeable)++instance Marshal Mode where+ type MarshalMode Mode c d = ModeBidi c+ marshaller = bidiMarshaller toEnum fromEnum++instance S.Literal Mode where+ literal ByReset = S.Expr $ showString "AutoListModel.ByReset"+ literal ByIndex = S.Expr $ showString "AutoListModel.ByIndex"+ literal ByKey = S.Expr $ showString "AutoListModel.ByKey"+ literal ByKeyNoReorder = S.Expr $ showString "AutoListModel.ByKeyNoReorder"++data AutoListTest+ = CreateAutoList Int+ deriving (Eq, Show, Typeable)++data AutoList+ = SetSource [Int32]+ | SetMode Mode+ deriving (Eq, Show, Typeable)++qtN, hsN :: Int -> Int+qtN n = 2*n+0+hsN n = 2*n+1++autoListType :: TestType+autoListType = TestType (Proxy :: Proxy AutoList)++testCode :: Text+testCode = T.pack $ unlines [+ "import QtQuick 2.0;",+ "import HsQML.Model 1.0;",+ "Item {",+ " id: obj;",+ " Repeater {",+ " id: rep;",+ " model: AutoListModel { onSourceChanged: tmr.start(); }",+ " Item { property var value : modelData; }",+ " }",+ " property var model : rep.model;",+ " Timer { id: tmr; interval: 50; onTriggered: obj.ready(); }",+ " signal ready;",+ " function get() {",+ " var xs = [];",+ " for (var i=0; i<rep.count; i++) {xs.push(rep.itemAt(i).value);}",+ " return xs;",+ " }",+ "}"]++instance TestAction AutoListTest where+ legalActionIn _ _ = True+ nextActionsFor env = pure . CreateAutoList $ testEnvNextJ env+ updateEnvRaw (CreateAutoList n) = testEnvStep . testEnvSerial (\s ->+ testEnvSetJ n autoListType s)+ actionRemote (CreateAutoList n) _ =+ (S.saveVar (qtN n) (S.call (S.sym "Qt" `S.dot` "createQmlObject")+ [S.literal testCode, S.sym "page", S.literal $ T.pack "dyn"])) <>+ (S.saveVar (hsN n) (S.call (S.sym "create") [S.literal n]))+ mockObjDef = [+ defMethod "create" $ \m n -> checkAction m (CreateAutoList n)+ (forkMockObj m :: IO (ObjRef (MockObj AutoList)))]++instance TestAction AutoList where+ legalActionIn _ _ = True+ nextActionsFor env = fromGen $ oneof [+ SetSource <$> arbitrary,+ SetMode <$> arbitraryBoundedEnum]+ updateEnvRaw _ = testEnvStep+ actionRemote (SetSource xs) n =+ S.makeCont [] (+ S.connect (S.var (qtN n) `S.dot` "ready") S.contVar <>+ S.set (S.var (qtN n) `S.dot` "model" `S.dot` "source")+ (S.literal xs)) <>+ S.disconnect (S.var (qtN n) `S.dot` "ready") S.callee <>+ S.eval (S.call (S.var (hsN n) `S.dot` "sourceSet") [+ S.call (S.var (qtN n) `S.dot` "get") []])+ actionRemote (SetMode x) n =+ S.set (S.var (qtN n) `S.dot` "model" `S.dot` "mode") (S.literal x) <>+ S.eval (S.call (S.var (hsN n) `S.dot` "modeSet") [S.literal x])+ mockObjDef = [+ defMethod "sourceSet" $ \m xs ->+ checkAction m (SetSource xs) $ return (),+ defMethod "modeSet" $ \m x ->+ checkAction m (SetMode x) $ return ()]
test/Graphics/QML/Test/Harness.hs view
@@ -18,6 +18,7 @@ qmlPrelude = unlines [ "import QtQuick 2.0", "import QtQuick.Window 2.0",+ "import HsQML.Model 1.0", "Window {", " id: page; visible: false;", " Component.onCompleted: {",
test/Graphics/QML/Test/ScriptDSL.hs view
@@ -122,10 +122,10 @@ disconnect :: Expr -> Expr -> Prog disconnect sig fn = eval $ sig `dot` "disconnect" `call` [fn] -makeCont :: [String] -> Prog -> Prog -> Prog-makeCont args (Prog a1 b1) (Prog a2 b2) =- Prog (showString "var cont = function(" . farg . showString ") {\n" . a2)- (b2 . showString "};\n" . a1 . b1)+makeCont :: [String] -> Prog -> Prog+makeCont args (Prog a b) =+ Prog (showString "var cont = function(" . farg . showString ") {\n")+ (showString "};\n" . a . b) where farg = foldr1 (.) $ (id:) $ intersperse (showChar ',') $ map showString args
test/Graphics/QML/Test/SignalTest.hs view
@@ -63,7 +63,7 @@ chainSignal :: Int -> [String] -> String -> String -> Prog chainSignal n args sig fn = S.makeCont args ((S.connect (S.var n `S.dot` sig) S.contVar) `mappend` - (S.eval $ (S.var n) `S.dot` fn `S.call` []))+ (S.eval $ (S.var n) `S.dot` fn `S.call` [])) `mappend` (S.disconnect (S.var n `S.dot` sig) S.callee) testSignal :: Int -> String -> String -> Expr -> Prog
test/Graphics/QML/Test/SimpleTest.hs view
@@ -152,7 +152,7 @@ actionRemote (SPSetObject v) n = setProp n "propObjectW" $ S.var v mockObjDef = [ -- There are seperate properties for testing accessors and mutators- -- becasue QML produces spurious reads when writing.+ -- because QML produces spurious reads when writing. defPropertyRO "propIntConst" (\m -> expectAction m $ \a -> case a of SPGetIntConst v -> return $ Right v
test/Test1.hs view
@@ -8,6 +8,7 @@ import Graphics.QML.Test.SimpleTest import Graphics.QML.Test.SignalTest import Graphics.QML.Test.MixedTest+import Graphics.QML.Test.AutoListTest import Data.Proxy import System.Exit @@ -38,7 +39,8 @@ checkProperty 20 $ TestType (Proxy :: Proxy (DataTest [Bool])), checkProperty 20 $ TestType (Proxy :: Proxy (DataTest [Int32])), checkProperty 20 $ TestType (Proxy :: Proxy (DataTest [Double])),- checkProperty 20 $ TestType (Proxy :: Proxy (DataTest [Text]))]+ checkProperty 20 $ TestType (Proxy :: Proxy (DataTest [Text])),+ checkProperty 100 $ TestType (Proxy :: Proxy AutoListTest)] if and rs then exitSuccess else exitFailure