diff --git a/CHANGELOG b/CHANGELOG
new file mode 100644
--- /dev/null
+++ b/CHANGELOG
@@ -0,0 +1,10 @@
+HsQML Samples - Release History
+
+release-0.3.3.0 - 2015.06.17
+
+  * Added faster multi-threaded version of the demo.
+  * Renamed original version hsqml-notes-slow.
+
+release-0.3.2.0 - 2014.11.29
+
+  * Initial release.
diff --git a/hsqml-demo-notes.cabal b/hsqml-demo-notes.cabal
--- a/hsqml-demo-notes.cabal
+++ b/hsqml-demo-notes.cabal
@@ -1,10 +1,10 @@
 Name:          hsqml-demo-notes
-Version:       0.3.2.0
+Version:       0.3.3.0
 Cabal-version: >= 1.10
 Build-type:    Simple
 License:       BSD3
 License-file:  LICENSE
-Copyright:     (c) 2014 Robin KAY
+Copyright:     (c) 2014-2015 Robin KAY
 Author:        Robin KAY
 Maintainer:    komadori@gekkou.co.uk
 Stability:     experimental
@@ -14,11 +14,24 @@
 Data-dir:      qml
 Data-files:    *.qml *.png
 Extra-source-files:
-    README
+    README CHANGELOG
 Description:
     Sticky notes example program implemented in HsQML
 
 Executable hsqml-notes
+    Default-language: Haskell2010
+    Hs-source-dirs: src
+    Main-is: NotesFast.hs
+    Build-depends:
+        base          == 4.*,
+        containers    >= 0.4 && < 0.6,
+        text          >= 0.11 && < 1.3,
+        transformers  >= 0.2 && < 0.5,
+        sqlite-simple >= 0.4.8 && < 0.5,
+        hsqml         >= 0.3.2.1 && < 0.4
+    GHC-options: -threaded
+
+Executable hsqml-notes-slow
     Default-language: Haskell2010
     Hs-source-dirs: src
     Main-is: NotesSlow.hs
diff --git a/src/NotesFast.hs b/src/NotesFast.hs
new file mode 100644
--- /dev/null
+++ b/src/NotesFast.hs
@@ -0,0 +1,226 @@
+{-# LANGUAGE RankNTypes, DeriveDataTypeable #-}
+module Main where
+
+import System.Environment (getArgs)
+
+import Data.Functor.Identity
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Typeable (Typeable)
+
+import Control.Applicative
+import Control.Concurrent
+
+import qualified Database.SQLite.Simple as S
+import qualified Database.SQLite.Simple.FromField as S
+import qualified Database.SQLite.Simple.ToField as S
+
+import Graphics.QML
+
+import Paths_hsqml_demo_notes
+
+newtype Note = Note {noteId :: Int} deriving (Eq, Ord, Typeable)
+
+data DBStatus
+    = Current
+    | UpdatePending
+    | InsertPending
+    | DeletePending
+    deriving Eq
+
+data NoteData = NoteData {
+    noteX :: Int,
+    noteY :: Int,
+    noteReverse :: Bool,
+    noteFront :: Text,
+    noteBack :: Text,
+    noteStatus :: DBStatus
+}
+
+data DBCommand = Load | Pending | Quit
+
+type ModelVar = MVar (Map Note NoteData)
+type CmdVar = MVar DBCommand
+
+type Lens t p = (Functor f) => (p -> f p) -> t -> f t
+
+view :: Lens t p -> t -> p
+view ln = getConst . ln Const
+
+set :: Lens t p -> p -> t -> t
+set ln val = runIdentity . ln (const $ Identity val)
+
+alter :: Lens t p -> (p -> p) -> t -> t
+alter ln fn = runIdentity . ln (\val -> Identity $ fn val)
+
+noteXLens :: Lens NoteData Int
+noteXLens fn nd = fmap (\x' -> nd {noteX = x'}) . fn $ noteX nd
+
+noteYLens :: Lens NoteData Int
+noteYLens fn nd = fmap (\y' -> nd {noteY = y'}) . fn $ noteY nd
+
+noteReverseLens :: Lens NoteData Bool
+noteReverseLens fn nd =
+    fmap (\rev' -> nd {noteReverse = rev'}) . fn $ noteReverse nd
+
+noteFrontLens :: Lens NoteData Text
+noteFrontLens fn nd =
+    fmap (\front' -> nd {noteFront = front'}) . fn $ noteFront nd
+
+noteBackLens :: Lens NoteData Text
+noteBackLens fn nd =
+    fmap (\back' -> nd {noteBack = back'}) . fn $ noteBack nd
+
+noteStatusLens :: Lens NoteData DBStatus
+noteStatusLens fn nd =
+    fmap (\status' -> nd {noteStatus = status'}) . fn $ noteStatus nd
+
+selectNotes :: ModelVar -> IO [Note]
+selectNotes modelVar = withMVar modelVar (
+    return . Map.keys . Map.filter ((/= DeletePending) . noteStatus))
+
+insertNote :: ModelVar -> Int -> Int -> Text -> IO ()
+insertNote modelVar x y front = modifyMVar_ modelVar (\notes ->
+    let (Note lastId) = fromMaybe (Note 0) . fmap fst . fmap fst $
+            Map.maxViewWithKey notes
+        newNote       = Note (lastId+1)
+    in return $ Map.insert newNote (
+        NoteData x y False front T.empty InsertPending) notes)
+
+deleteNote :: ModelVar -> Note -> IO ()
+deleteNote modelVar note = modifyMVar_ modelVar (
+    return . Map.adjust (set noteStatusLens DeletePending) note)
+
+readNoteAttrib :: ModelVar -> Lens NoteData a -> ObjRef Note -> IO a
+readNoteAttrib modelVar attrib note = withMVar modelVar (
+    return . view attrib .
+    fromMaybe (NoteData 0 0 False T.empty T.empty Current) .
+    Map.lookup (fromObjRef note))
+
+writeNoteAttrib ::
+    ModelVar -> CmdVar -> Lens NoteData a -> SignalKey (IO ()) ->
+    ObjRef Note -> a -> IO ()
+writeNoteAttrib modelVar cmdVar attrib changeKey note value = do
+    modifyMVar_ modelVar (return . Map.adjust (
+        set attrib value . alter noteStatusLens updateState) (fromObjRef note))
+    tryPutMVar cmdVar Pending
+    fireSignal changeKey note
+    where updateState InsertPending = InsertPending
+          updateState DeletePending = DeletePending
+          updateState _ = UpdatePending
+
+createContext :: ModelVar -> CmdVar -> SignalKey (IO ()) -> IO (ObjRef ())
+createContext modelVar cmdVar changeKey = do
+    noteClass <- newClass [
+        defPropertySigRW "x" changeKey
+            (readNoteAttrib modelVar noteXLens)
+            (writeNoteAttrib modelVar cmdVar noteXLens changeKey),
+        defPropertySigRW "y" changeKey
+            (readNoteAttrib modelVar noteYLens)
+            (writeNoteAttrib modelVar cmdVar noteYLens changeKey),
+        defPropertySigRW "reverse" changeKey
+            (readNoteAttrib modelVar noteReverseLens)
+            (writeNoteAttrib modelVar cmdVar noteReverseLens changeKey),
+        defPropertySigRW "front" changeKey
+            (readNoteAttrib modelVar noteFrontLens)
+            (writeNoteAttrib modelVar cmdVar noteFrontLens changeKey),
+        defPropertySigRW "back" changeKey
+            (readNoteAttrib modelVar noteBackLens)
+            (writeNoteAttrib modelVar cmdVar noteBackLens changeKey)]
+    notePool <- newFactoryPool (newObject noteClass)
+    rootClass <- newClass [
+        defPropertySigRO' "notes" changeKey (\_ -> do
+            notes <- selectNotes modelVar
+            mapM (getPoolObject notePool) notes),
+        defMethod' "insertNote" (\this x y front -> do
+            insertNote modelVar x y front
+            tryPutMVar cmdVar Pending
+            fireSignal changeKey this),
+        defMethod' "deleteNote" (\this note -> do
+            deleteNote modelVar $ fromObjRef note
+            tryPutMVar cmdVar Pending
+            fireSignal changeKey this)]
+    newObject rootClass ()
+
+createTableDb :: S.Connection -> IO ()
+createTableDb conn =
+    S.execute_ conn . S.Query . T.pack $
+        "CREATE TABLE IF NOT EXISTS notes (" ++
+            "id INTEGER PRIMARY KEY AUTOINCREMENT, " ++
+            "x INTEGER, y INTEGER, reverse BOOLEAN, front TEXT, back TEXT)"
+
+selectNotesDb :: S.Connection -> a -> (a -> Note -> NoteData -> IO a) -> IO a
+selectNotesDb conn zero func =
+    let query = S.Query $ T.pack
+            "SELECT id,x,y,reverse,front,back FROM notes ORDER BY id DESC"
+    in S.fold_ conn query zero (\acc (i,x,y,rev,front,back) ->
+        func acc (Note i) (NoteData x y rev front back Current))
+
+insertNoteDb :: S.Connection -> Note -> NoteData -> IO ()
+insertNoteDb conn note dat =
+    S.execute conn (S.Query $ T.pack
+        "INSERT INTO notes (id,x,y,reverse,front,back) VALUES (?,?,?,?,?,?)")
+        (noteId note, noteX dat, noteY dat,
+            noteReverse dat, noteFront dat, noteBack dat)
+
+deleteNoteDb :: S.Connection -> Note -> IO ()
+deleteNoteDb conn =
+    let query = S.Query $ T.pack "DELETE FROM notes WHERE id = ?"
+    in S.execute conn query . S.Only . noteId
+
+updateNoteDb :: S.Connection -> Note -> NoteData -> IO ()
+updateNoteDb conn note dat =
+    S.execute conn (S.Query $ T.pack 
+        "UPDATE notes SET x=?, y=?, reverse=?, front=?, back=? WHERE id=?")
+        (noteX dat, noteY dat,
+            noteReverse dat, noteFront dat, noteBack dat, noteId note)
+
+dbThread ::
+    S.Connection -> ModelVar -> CmdVar -> MVar () -> IO () -> IO ()
+dbThread conn modelVar cmdVar finVar changeCb = do 
+    cmd <- takeMVar cmdVar
+    case cmd of
+        Load -> do
+            createTableDb conn
+            selectNotesDb conn () $ \_ note dat -> do
+                modifyMVar_ modelVar (return . Map.insert note dat)
+                changeCb
+            dbThread conn modelVar cmdVar finVar changeCb
+        Pending -> do
+            pending <- modifyMVar modelVar (\notes ->
+                let pending = Map.toList $
+                        Map.filter ((/= Current) . noteStatus) notes
+                    notes' = Map.mapMaybe (\dat -> case noteStatus dat of
+                        DeletePending -> Nothing
+                        _             -> Just $
+                            set noteStatusLens Current dat) notes
+                in return (notes', pending))
+            mapM_ (\(note,dat) -> case noteStatus dat of
+                DeletePending -> deleteNoteDb conn note
+                InsertPending -> insertNoteDb conn note dat
+                UpdatePending -> updateNoteDb conn note dat) pending
+            dbThread conn modelVar cmdVar finVar changeCb
+        Quit -> putMVar finVar ()
+
+main :: IO ()
+main = do
+    modelVar <- newMVar Map.empty
+    cmdVar <- newMVar Load
+    finVar <- newEmptyMVar
+    changeKey <- newSignalKey
+    ctx <- createContext modelVar cmdVar changeKey
+    forkOS $ S.withConnection "notes.db" $ \conn ->
+        dbThread conn modelVar cmdVar finVar (fireSignal changeKey ctx)
+    args <- getArgs
+    path <- case args of
+        ("local":p:_) -> return $ p ++ ".qml"
+        (p:_)         -> getDataFileName $ p ++ ".qml"
+        _             -> getDataFileName "notes.qml"
+    runEngineLoop defaultEngineConfig {
+        initialDocument = fileDocument path,
+        contextObject = Just $ anyObjRef ctx}
+    tryPutMVar cmdVar Quit
+    takeMVar finVar