From ba095a30e1aa1c9b85d4801d88c797aee666dabb Mon Sep 17 00:00:00 2001 From: Jesse McDonald Date: Sun, 22 May 2016 12:03:16 -0500 Subject: [PATCH] Simple GUI for calculating factorials in HsQML -- initial commit --- .gitignore | 6 +++++ LICENSE | 34 ++++++++++++++++++++++++++ factorial/LICENSE | 34 ++++++++++++++++++++++++++ factorial/Setup.hs | 2 ++ factorial/factorial.cabal | 25 ++++++++++++++++++++ factorial/factorial.hs | 50 +++++++++++++++++++++++++++++++++++++++ factorial/factorial.qml | 34 ++++++++++++++++++++++++++ stack.yaml | 6 +++++ 8 files changed, 191 insertions(+) create mode 100644 .gitignore create mode 100644 LICENSE create mode 100644 factorial/LICENSE create mode 100644 factorial/Setup.hs create mode 100644 factorial/factorial.cabal create mode 100644 factorial/factorial.hs create mode 100644 factorial/factorial.qml create mode 100644 stack.yaml diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..ede30be --- /dev/null +++ b/.gitignore @@ -0,0 +1,6 @@ +.stack-work/ +.*.swp +.*.swo +*.hi +*.o +*~ diff --git a/LICENSE b/LICENSE new file mode 100644 index 0000000..0505e52 --- /dev/null +++ b/LICENSE @@ -0,0 +1,34 @@ + Creative Commons + Public Domain Dedication + + Copyright-Only Dedication (based on United States law) + or Public Domain Certification + +The person or persons who have associated work with this document +(the "Dedicator" or "Certifier") hereby either (a) certifies that, +to the best of his knowledge, the work of authorship identified is +in the public domain of the country from which the work is published, +or (b) hereby dedicates whatever copyright the dedicators holds in +the work of authorship identified below (the "Work") to the public +domain. A certifier, moreover, dedicates any copyright interest he +may have in the associated work, and for these purposes, is described +as a "dedicator" below. + +A certifier has taken reasonable steps to verify the copyright status +of this work. Certifier recognizes that his good faith efforts may not +shield him from liability if in fact the work certified is not in the +public domain. + +Dedicator makes this dedication for the benefit of the public at large +and to the detriment of the Dedicator's heirs and successors. Dedicator +intends this dedication to be an overt act of relinquishment in perpetuity +of all present and future rights under copyright law, whether vested or +contingent, in the Work. Dedicator understands that such relinquishment +of all rights includes the relinquishment of all rights to enforce (by +lawsuit or otherwise) those copyrights in the Work. + +Dedicator recognizes that, once placed in the public domain, the Work +may be freely reproduced, distributed, transmitted, used, modified, +built upon, or otherwise exploited by anyone for any purpose, commercial +or non-commercial, and in any way, including by methods that have not yet +been invented or conceived. diff --git a/factorial/LICENSE b/factorial/LICENSE new file mode 100644 index 0000000..0505e52 --- /dev/null +++ b/factorial/LICENSE @@ -0,0 +1,34 @@ + Creative Commons + Public Domain Dedication + + Copyright-Only Dedication (based on United States law) + or Public Domain Certification + +The person or persons who have associated work with this document +(the "Dedicator" or "Certifier") hereby either (a) certifies that, +to the best of his knowledge, the work of authorship identified is +in the public domain of the country from which the work is published, +or (b) hereby dedicates whatever copyright the dedicators holds in +the work of authorship identified below (the "Work") to the public +domain. A certifier, moreover, dedicates any copyright interest he +may have in the associated work, and for these purposes, is described +as a "dedicator" below. + +A certifier has taken reasonable steps to verify the copyright status +of this work. Certifier recognizes that his good faith efforts may not +shield him from liability if in fact the work certified is not in the +public domain. + +Dedicator makes this dedication for the benefit of the public at large +and to the detriment of the Dedicator's heirs and successors. Dedicator +intends this dedication to be an overt act of relinquishment in perpetuity +of all present and future rights under copyright law, whether vested or +contingent, in the Work. Dedicator understands that such relinquishment +of all rights includes the relinquishment of all rights to enforce (by +lawsuit or otherwise) those copyrights in the Work. + +Dedicator recognizes that, once placed in the public domain, the Work +may be freely reproduced, distributed, transmitted, used, modified, +built upon, or otherwise exploited by anyone for any purpose, commercial +or non-commercial, and in any way, including by methods that have not yet +been invented or conceived. diff --git a/factorial/Setup.hs b/factorial/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/factorial/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/factorial/factorial.cabal b/factorial/factorial.cabal new file mode 100644 index 0000000..ce95ebe --- /dev/null +++ b/factorial/factorial.cabal @@ -0,0 +1,25 @@ +name: factorial +version: 0.1.0.0 +synopsis: Simple GUI to calculate factorials in HsQML +-- description: +license: PublicDomain +license-file: LICENSE +author: Jesse McDonald +maintainer: nybble41@gmail.com +-- copyright: +category: GUI +build-type: Simple +-- extra-source-files: +cabal-version: >=1.10 + +executable factorial + main-is: factorial.hs + -- other-modules: + -- other-extensions: + ghc-options: -threaded + build-depends: base >=4.6 && <4.9, + stm >=2.4 && <2.5, + hsqml >=0.3 && <0.4, + text >=1.2 && <1.3 + -- hs-source-dirs: + default-language: Haskell2010 diff --git a/factorial/factorial.hs b/factorial/factorial.hs new file mode 100644 index 0000000..fe26983 --- /dev/null +++ b/factorial/factorial.hs @@ -0,0 +1,50 @@ +{-# LANGUAGE LambdaCase #-} +module Main (main) where + +import Control.Applicative +import Control.Concurrent (forkIO, killThread, myThreadId) +import Control.Concurrent.STM +import Control.Exception (evaluate, mask_) +import Control.Monad +import Data.IORef +import Data.Maybe +import Data.Text (Text) +import Graphics.QML + +import qualified Data.Text as T + +-- How are these not in Control.Monad? +whenM, unlessM :: Monad m => m Bool -> m () -> m () +whenM mcond mtrue = mcond >>= flip when mtrue +unlessM mcond mfalse = mcond >>= flip unless mfalse + +main :: IO () +main = do + state <- newIORef $ T.pack "" + tidVar <- atomically $ newTMVar Nothing + skey <- newSignalKey + clazz <- newClass + [ defPropertySigRO' "result" skey + (\obj -> readIORef state) + , defMethod' "factorial" $ \obj txt -> void $ forkIO $ do + tid <- myThreadId + mask_ $ (atomically $ swapTMVar tidVar $ Just tid) >>= \case + Just oldId -> killThread oldId + Nothing -> return () + writeIORef state $ T.pack "Working..." + mask_ $ fireSignal skey obj :: IO () + let n = read $ T.unpack txt :: Integer + let out = T.take 1000 . T.pack . show $ product [1..n] + evaluate out + writeIORef state out + mask_ $ fireSignal skey obj + atomically $ whenM ((== Just tid) <$> readTMVar tidVar) $ + void $ swapTMVar tidVar Nothing + ] + + ctx <- newObject clazz () + + runEngineLoop defaultEngineConfig + { initialDocument = fileDocument "factorial.qml" + , contextObject = Just $ anyObjRef ctx + } diff --git a/factorial/factorial.qml b/factorial/factorial.qml new file mode 100644 index 0000000..963678a --- /dev/null +++ b/factorial/factorial.qml @@ -0,0 +1,34 @@ +import QtQuick 2.0 +import QtQuick.Controls 1.2 +import QtQuick.Window 2.2 + +Window { + width: 300; + height: 300; + visible: true; + + TextField { + id: input; + anchors.top: parent.top; + anchors.left: parent.left; + anchors.right: parent.right; + focus: true; + } + Button { + id: calculate; + anchors.top: input.bottom; + anchors.left: parent.left; + anchors.right: parent.right; + text: "Calculate Factorial"; + onClicked: factorial(input.text); + } + Text { + anchors.top: calculate.bottom; + anchors.left: parent.left; + anchors.right: parent.right; + anchors.bottom: parent.bottom; + wrapMode: Text.WrapAnywhere; + font.pixelSize: 30; + text: result; + } +} diff --git a/stack.yaml b/stack.yaml new file mode 100644 index 0000000..91a1907 --- /dev/null +++ b/stack.yaml @@ -0,0 +1,6 @@ +flags: {} +packages: +- factorial +extra-deps: +- hsqml-0.3.4.0 +resolver: lts-5.17