commit 8745ded080a63d67f2aca762a027f2fa9e807f75 Author: James Brechtel Date: Sat Dec 31 08:24:24 2022 -0500 temp diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..cd08a6d --- /dev/null +++ b/.gitignore @@ -0,0 +1 @@ +db_credentials.txt diff --git a/README.md b/README.md new file mode 100644 index 0000000..8bec0bf --- /dev/null +++ b/README.md @@ -0,0 +1,44 @@ +Qualify is a quantified self tracking tool. + +It will have an API to record events described by the data model below. + +Later analysis can be done against the SQLite database where the events are stored + +# Data Model + +## Events +- Time +- Type + +## Event types +- Mood report +- Weight recording +- Argument +- Sleep quality +- Activity +- Substance + +## Activities +- Sex +- Reading +- TV +- Video game +- Board game +- Meditation +- Run +- Bike ride +- Socializing +- Eating + +## Moods +- Happy +- Stressed +- Focused + +## Substance +- Caffeine +- Alcohol +- Psy +- Kra +- Mol +- L diff --git a/data-model.md b/data-model.md new file mode 100644 index 0000000..e69de29 diff --git a/qualify-api/.gitignore b/qualify-api/.gitignore new file mode 100644 index 0000000..c368d45 --- /dev/null +++ b/qualify-api/.gitignore @@ -0,0 +1,2 @@ +.stack-work/ +*~ \ No newline at end of file diff --git a/qualify-api/CHANGELOG.md b/qualify-api/CHANGELOG.md new file mode 100644 index 0000000..5700d98 --- /dev/null +++ b/qualify-api/CHANGELOG.md @@ -0,0 +1,11 @@ +# Changelog for `qualify` + +All notable changes to this project will be documented in this file. + +The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), +and this project adheres to the +[Haskell Package Versioning Policy](https://pvp.haskell.org/). + +## Unreleased + +## 0.1.0.0 - YYYY-MM-DD diff --git a/qualify-api/LICENSE b/qualify-api/LICENSE new file mode 100644 index 0000000..342c588 --- /dev/null +++ b/qualify-api/LICENSE @@ -0,0 +1,30 @@ +Copyright Author name here (c) 2022 + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Author name here nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/qualify-api/README.md b/qualify-api/README.md new file mode 100644 index 0000000..f52341c --- /dev/null +++ b/qualify-api/README.md @@ -0,0 +1 @@ +# qualify diff --git a/qualify-api/Setup.hs b/qualify-api/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/qualify-api/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/qualify-api/app/Main.hs b/qualify-api/app/Main.hs new file mode 100644 index 0000000..4c6b30f --- /dev/null +++ b/qualify-api/app/Main.hs @@ -0,0 +1,6 @@ +module Main (main) where + +import Lib + +main :: IO () +main = someFunc diff --git a/qualify-api/package.yaml b/qualify-api/package.yaml new file mode 100644 index 0000000..1056280 --- /dev/null +++ b/qualify-api/package.yaml @@ -0,0 +1,60 @@ +name: qualify +version: 0.1.0.0 +github: "githubuser/qualify" +license: BSD3 +author: "Author name here" +maintainer: "example@example.com" +copyright: "2022 Author name here" + +extra-source-files: +- README.md +- CHANGELOG.md + +# Metadata used when publishing your package +# synopsis: Short description of your package +# category: Web + +# To avoid duplicated efforts in documentation and dealing with the +# complications of embedding Haddock markup inside cabal files, it is +# common to point users to the README.md file. +description: Please see the README on GitHub at + +dependencies: +- base >= 4.7 && < 5 +- non-empty-text + +ghc-options: +- -Wall +- -Wcompat +- -Widentities +- -Wincomplete-record-updates +- -Wincomplete-uni-patterns +- -Wmissing-export-lists +- -Wmissing-home-modules +- -Wpartial-fields +- -Wredundant-constraints + +library: + source-dirs: src + +executables: + qualify-exe: + main: Main.hs + source-dirs: app + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - qualify + +tests: + qualify-test: + main: Spec.hs + source-dirs: test + ghc-options: + - -threaded + - -rtsopts + - -with-rtsopts=-N + dependencies: + - qualify diff --git a/qualify-api/qualify.cabal b/qualify-api/qualify.cabal new file mode 100644 index 0000000..ec6d478 --- /dev/null +++ b/qualify-api/qualify.cabal @@ -0,0 +1,61 @@ +cabal-version: 1.12 + +-- This file has been generated from package.yaml by hpack version 0.35.1. +-- +-- see: https://github.com/sol/hpack + +name: qualify +version: 0.1.0.0 +description: Please see the README on GitHub at +homepage: https://github.com/githubuser/qualify#readme +bug-reports: https://github.com/githubuser/qualify/issues +author: Author name here +maintainer: example@example.com +copyright: 2022 Author name here +license: BSD3 +license-file: LICENSE +build-type: Simple +extra-source-files: + README.md + CHANGELOG.md + +source-repository head + type: git + location: https://github.com/githubuser/qualify + +library + exposed-modules: + Lib + other-modules: + Paths_qualify + hs-source-dirs: + src + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints + build-depends: + base >=4.7 && <5 + default-language: Haskell2010 + +executable qualify-exe + main-is: Main.hs + other-modules: + Paths_qualify + hs-source-dirs: + app + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , qualify + default-language: Haskell2010 + +test-suite qualify-test + type: exitcode-stdio-1.0 + main-is: Spec.hs + other-modules: + Paths_qualify + hs-source-dirs: + test + ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wmissing-export-lists -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N + build-depends: + base >=4.7 && <5 + , qualify + default-language: Haskell2010 diff --git a/qualify-api/src/Lib.hs b/qualify-api/src/Lib.hs new file mode 100644 index 0000000..d36ff27 --- /dev/null +++ b/qualify-api/src/Lib.hs @@ -0,0 +1,6 @@ +module Lib + ( someFunc + ) where + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/qualify-api/src/Qualify/Data/Event.hs b/qualify-api/src/Qualify/Data/Event.hs new file mode 100644 index 0000000..177c234 --- /dev/null +++ b/qualify-api/src/Qualify/Data/Event.hs @@ -0,0 +1,44 @@ +module Qualify.Data.Event +( Event(..) +) where + +import qualified Data.List.NonEmpty as NE +import qualified Data.NonEmptyText as NET +import qualified Data.Time as Time + +data Event = + Event + { time :: Time.UTCTime + , details :: EventDetails + } + +data EventDetails + = MoodEvent Mood Intensity + | ActivityEvent Activity + | ConsumptionEvent Substance Dose + +data Mood + = Angry + | Sad + | Happy + | Neutral + +data ActivityType + = Cycling Miles + | Running Miles + | Meditation Duration + | Pushups (NE.NonEmpty WorkoutSet) + +data ActivityQuantity + = Count [ActivitySet] + | Duration Minutes + | Distance Miles + +newtype Intensity = Intensity Int +newtype Minutes = Minutes Int +newtype Miles = Miles Int +newtype Reps = Reps Int +newtype WorkoutSet = WorkoutSet Reps + +newtype Substance = Substance NET.NonEmptyText +newtype Dose = Dose NET.NonEmptyText diff --git a/qualify-api/test/Spec.hs b/qualify-api/test/Spec.hs new file mode 100644 index 0000000..cd4753f --- /dev/null +++ b/qualify-api/test/Spec.hs @@ -0,0 +1,2 @@ +main :: IO () +main = putStrLn "Test suite not yet implemented" diff --git a/qualify-web-ui/.ghc.environment.x86_64-linux-8.6.5 b/qualify-web-ui/.ghc.environment.x86_64-linux-8.6.5 new file mode 100644 index 0000000..df5a5f1 --- /dev/null +++ b/qualify-web-ui/.ghc.environment.x86_64-linux-8.6.5 @@ -0,0 +1,122 @@ +-- This is a GHC environment file written by cabal. This means you can +-- run ghc or ghci and get the environment of the project as a whole. +-- But you still need to use cabal repl $target to get the environment +-- of specific components (libs, exes, tests etc) because each one can +-- have its own source dirs, cpp flags etc. +-- +clear-package-db +global-package-db +package-db /home/jbrechtel/.cabal/store/ghc-8.6.5/package.db +package-db dist-newstyle/packagedb/ghc-8.6.5 +package-id base-4.12.0.0 +package-id ghc-prim-0.5.3 +package-id rts +package-id integer-gmp-1.0.2.0 +package-id jsaddle-0.9.7.0-scENf4jN9rFo84nX1Kxop +package-id aeson-1.4.2.0-JZqYuUdHBw93faVr1pymZn +package-id attoparsec-0.13.2.2-Je5OzMsTDh03JGfULLEx8E +package-id array-0.5.3.0 +package-id bytestring-0.10.8.2 +package-id deepseq-1.4.4.0 +package-id containers-0.6.0.1 +package-id scientific-0.3.6.2-DS4ZHRNMqkUCpqFOF65TUm +package-id binary-0.8.6.0 +package-id hashable-1.2.7.0-6I2QtMiufsI9ruKWE84ksw +package-id text-1.2.3.1 +package-id integer-logarithms-1.0.3-L1fXvdNnENnEcLpMml0rI7 +package-id primitive-0.6.4.0-ILgywxtLpvnAOlEISPpP5b +package-id transformers-0.5.6.2 +package-id base-compat-0.10.5-FRXoAxOVtbG2qLNIZm1tTr +package-id unix-2.7.2.2 +package-id time-1.8.0.2 +package-id dlist-0.8.0.6-Fp8bZM9eelBDBq54ytkFUM +package-id tagged-0.8.6-EiJ2F18RuD68LSMkg0Ly4r +package-id template-haskell-2.14.0.0 +package-id ghc-boot-th-8.6.5 +package-id pretty-1.1.3.6 +package-id th-abstraction-0.2.11.0-DAhuCgi08HTBWsDjm9nrOq +package-id time-locale-compat-0.1.1.5-Et2KuIqhniaDySS0uBEPko +package-id unordered-containers-0.2.9.0-9doDsrqzw7xAm9zCbYj8Qi +package-id uuid-types-1.0.3-HXKIfWgc328KO7VMiiDOIL +package-id random-1.1-3ypV4EIycgb35PKjTYYr5q +package-id vector-0.12.0.3-2LEYu9M2i7lERDtz76XG3n +package-id base64-bytestring-1.0.0.2-HARlfMYmSpcHHGhdFyYRfr +package-id exceptions-0.10.2-LHW4ySHeehdC58HbVbQQvF +package-id mtl-2.2.2 +package-id stm-2.5.0.0 +package-id transformers-compat-0.6.4-3mIoeQKAFq789cuQC8bUpt +package-id filepath-1.4.2.1 +package-id http-types-0.12.3-DZTJzvZTJGsJ3xKEdkiKkv +package-id case-insensitive-1.2.0.11-9CrUfvMu9rkCkmR9zDROmV +package-id lens-4.17.1-GETyDb12WUH2tE5ChtAGxx +package-id base-orphans-0.8.1-9F7iLpy7q5N4wvYgKgAoCw +package-id bifunctors-5.5.4-9OOOVgMD2WBJnwKG7FYtoZ +package-id comonad-5.0.5-7ITduJPNGESHka4g0xPQV5 +package-id distributive-0.6-9HklLdWhP3qBEJWPIpooe4 +package-id call-stack-0.1.0-6JeY2gtocDgBo2y7QzQaJD +package-id contravariant-1.5.1-5DqKSjbrRzZU8YLmfpGsF +package-id StateVar-1.1.1.1-2ewTKofpCGhC2np5dyFIaR +package-id free-5.1.1-644eyYHrByA99LA1Z9FH3c +package-id profunctors-5.3-EVY8IO4wvjxLMvmdfgIGwe +package-id semigroups-0.18.5-6T2lH5F6zyQIdwR3JYKMO3 +package-id semigroupoids-5.3.2-3uF3VL5uiZe7qfXfhjeRSC +package-id transformers-base-0.4.5.2-65UcNnyddkzAHmgTOWDjuK +package-id kan-extensions-5.2-2pRI6ptkfT6HaZl61shezD +package-id adjunctions-4.4-GkmJFUdvi2L53dBjiJSk97 +package-id void-0.7.3-5xXWQQsTYbKFlr3KfNvyL8 +package-id invariant-0.5.3-FYZhSjPPPDTKdQlYfY8A5W +package-id parallel-3.2.2.0-EGl5SOk48TWHAD161C93aQ +package-id reflection-2.1.4-E9VXTbXoqHZ5rulgGPZOrF +package-id process-1.6.5.0 +package-id directory-1.3.3.0 +package-id ref-tf-0.4.0.1-6otS07lPtcm2p5TIx8ks0R +package-id unliftio-core-0.1.2.0-DmlZdkLzX278vkyONsp8WQ +package-id jsaddle-warp-0.9.7.0-DHMZWfEwF6AJVIaTVkQdus +package-id foreign-store-0.2-FCKu23zJ1MhKEqdHalRzFz +package-id wai-3.2.2-6kN80nBrI1nFDSmAnEDkik +package-id network-2.8.0.1-Hmt657UE3v349uYmvUXEvW +package-id vault-0.3.1.2-KJQxrWILNEQ83kAJMg9gey +package-id wai-websockets-3.0.1.2-4xTCo4L40uNAVGN8TL9k7Y +package-id websockets-0.12.5.3-HwQ46gcK0Iw3FwpDCPo4Jm +package-id SHA-1.6.4.4-LSGP1ORV6WOJZ2DmMQoqgU +package-id bytestring-builder-0.10.8.2.0-JZ1IVWVo4k62ItV0IvxitS +package-id entropy-0.4.1.4-23NMAjgKyCo3F1ZCvvDJOh +package-id streaming-commons-0.2.1.0-5mHswWsWKtTGuFNZYmU1rl +package-id async-2.2.1-1TgOGq8ixvq3LlZH9GyvzU +package-id zlib-0.6.2-BdOecmQ0rL1HOiGypdSgxY +package-id warp-3.2.27-84BXdcL0oZM7kcCMjzS61M +package-id auto-update-0.1.4.1-H02SxzDXmGPGYG55qTZ7dl +package-id bsb-http-chunked-0.0.0.4-JBvdmLk7KcRC0f2lFU97IT +package-id http-date-0.0.8-IcXFZGWOT1mI0h9wITgStD +package-id http2-1.6.5-Dmd6qaxGKkE6C5FThdwum3 +package-id network-byte-order-0.0.0.0-GNEe8M9BBmaFrQ7Jjku9SE +package-id psqueues-0.2.7.1-H8oN9RY0cpdLse42BHHTul +package-id iproute-1.7.7-EZNHS4uhniD1WmkvHxiYjP +package-id appar-0.1.8-GEXCW6eRsA87u3FkbnD06R +package-id byteorder-1.0.4-IVStE0plZAH4UpHo5zwztw +package-id simple-sendfile-0.2.28-34n8R7uTblnH3bAqOVOtfV +package-id unix-compat-0.5.1-7L4ZE9qc5MBJa5Jne6W69O +package-id word8-0.1.3-GQ49fFYDHvm35tXenKWcua +package-id miso-1.8.0.0-KAVKyKu8AvX3JNgaK7vf1F +package-id file-embed-0.0.11-4IE3sw0bCLQ7xXwEGMUYke +package-id http-api-data-0.4-2b3GezpwgkPQpD81T03Tr +package-id attoparsec-iso8601-1.0.1.0-7YCFf3AlzntF1cjR8B7Hbp +package-id cookie-0.4.4-DzW4e96znG4Li9tZKF8Kyy +package-id data-default-class-0.1.2.0-FeIQ5tLoVZBHMSgrT9zptQ +package-id lucid-2.9.11-6J6lYoecGqC1vlgCL6POsp +package-id blaze-builder-0.4.1.0-J6veHQLoGyv52zteT8TW8M +package-id mmorph-1.1.3-C3oMJRpRwaQ5uSWuFLRhoG +package-id network-uri-2.6.1.0-A8OLDSAIs4YFpy4ppRrA3O +package-id parsec-3.1.13.0 +package-id servant-0.15-IXdWND20zXS9AQeBrBiSf4 +package-id QuickCheck-2.12.6.1-JyVWDgZJAFGJC5rmVxfUSm +package-id erf-2.0.0.0-ExhHoenPosmHlOroBQQced +package-id tf-random-0.5-IjFVdJXpGgq3hBuRJiaT27 +package-id http-media-0.7.1.3-3nf4wm6HOOu4p769qQmAEm +package-id utf8-string-1.0.1.1-Geq8jdOv4Q3LkcQoEOWDVv +package-id singleton-bool-0.1.4-BswWCJ6C1foFLbVlo6nj0a +package-id string-conversions-0.4.0.1-IuznEViwX9LE3ijeMrf0jL +package-id servant-lucid-0.8.1-AgpKXrYVaEWGHcR1clBdpw +package-id tagsoup-0.14.8-F31oOhLdiYC1wIPEztZlok +package-id qualify-0.1.0.0-inplace-qualify-lib +package-id non-empty-text-0.1.1-IJAt0s2Skrh2raFH0XL6Yi diff --git a/qualify-web-ui/.gitignore b/qualify-web-ui/.gitignore new file mode 100644 index 0000000..7f44ae4 --- /dev/null +++ b/qualify-web-ui/.gitignore @@ -0,0 +1,3 @@ +dist-newstyle +result +result-2 diff --git a/qualify-web-ui/README.md b/qualify-web-ui/README.md new file mode 100644 index 0000000..b68e06e --- /dev/null +++ b/qualify-web-ui/README.md @@ -0,0 +1,57 @@ +## Sample Miso-JSaddle application + + +It's possible to build miso applications with `ghcid`, `miso` and `jsaddle`. This can enable a faster workflow due to hot reloading of the code. + +This application (sample-app-jsaddle) serves as an example of development w/ GHC, and releases with GHCJS. + +To take advantage of the hot reload code features, we recommend running the following command (see below) in a shell. (This will invoke `ghcid` for you). + +## Dev +```bash +nix-shell --run reload +``` + +You should now be able to open your browser to `http://localhost:8080` and see your working application. Subsequent edits of the code should cause a live update of the website at that address. + +To build the application w/ GHCJS, execute the below command. + +## Build w/ GHCJS +```bash +nix-build -A release +``` + +## Dev with `stack` + +In order to build `miso` w/ `jsaddle` support, it is necessary to remove the existing `miso` package first. + +```bash +stack exec -- ghc-pkg unregister --force miso +``` + +Enable the `jsaddle` flag by adding the following to your project's `package.yaml` file, then call `stack build`. + +```yaml +flags: + miso: + jsaddle: true +``` + +## Add external javascript file + +First download the external javascript file (`your-file.js`) to your project directory. +Then add `bytestring` to `build-depends` in `app.cabal`. +In your `Main.hs` you need to change the implementation of `runApp` from this: +``` +runApp f = + Warp.runSettings (Warp.setPort 8080 (Warp.setTimeout 3600 Warp.defaultSettings)) =<< + JSaddle.jsaddleOr defaultConnectionOptions (f >> syncPoint) JSaddle.jsaddleApp +``` +to this: +``` +runApp f = do + bString <- B.readFile "your-file.js" + jSaddle <- JSaddle.jsaddleOr defaultConnectionOptions (f >> syncPoint) (JSaddle.jsaddleAppWithJs (B.append (JSaddle.jsaddleJs False) bString)) + Warp.runSettings (Warp.setPort 8081 (Warp.setTimeout 3600 Warp.defaultSettings)) jSaddle +``` +Now you should be able to use `your-file.js` in jsaddle. diff --git a/qualify-web-ui/app.cabal b/qualify-web-ui/app.cabal new file mode 100644 index 0000000..cbf95f0 --- /dev/null +++ b/qualify-web-ui/app.cabal @@ -0,0 +1,26 @@ +name: qualify +version: 0.1.0.0 +synopsis: Qualify - personal event tracker +category: Web +build-type: Simple +cabal-version: >=1.10 + +executable app + main-is: + Main.hs + build-depends: + base, miso, qualify-lib + hs-source-dirs: web + if !impl(ghcjs) + build-depends: + jsaddle, jsaddle-warp, transformers, warp, websockets + default-language: + Haskell2010 + +library qualify-lib + build-depends: + base, non-empty-text, time + hs-source-dirs: lib + exposed-modules: + default-language: + Haskell2010 diff --git a/qualify-web-ui/cabal.config b/qualify-web-ui/cabal.config new file mode 100644 index 0000000..ef1b749 --- /dev/null +++ b/qualify-web-ui/cabal.config @@ -0,0 +1 @@ +compiler: ghcjs diff --git a/qualify-web-ui/default.nix b/qualify-web-ui/default.nix new file mode 100644 index 0000000..1d5e6d8 --- /dev/null +++ b/qualify-web-ui/default.nix @@ -0,0 +1,9 @@ +with (import (builtins.fetchTarball { + url = "https://github.com/dmjio/miso/archive/refs/tags/1.8.tar.gz"; +}) {}); +{ + dev = pkgs.haskell.packages.ghc865.callCabal2nix "app" ./. { miso = miso-jsaddle; }; + release = pkgs.haskell.packages.ghcjs86.callCabal2nix "app" ./. {}; + inherit pkgs; +} + diff --git a/qualify-web-ui/lib/Qualify/Data.hs b/qualify-web-ui/lib/Qualify/Data.hs new file mode 100644 index 0000000..1c46fdc --- /dev/null +++ b/qualify-web-ui/lib/Qualify/Data.hs @@ -0,0 +1,5 @@ +module Qualify.Data + ( module X + ) where + +import qualified Qualify.Data.Event as X diff --git a/qualify-web-ui/lib/Qualify/Data/Event.hs b/qualify-web-ui/lib/Qualify/Data/Event.hs new file mode 100644 index 0000000..2dc2bca --- /dev/null +++ b/qualify-web-ui/lib/Qualify/Data/Event.hs @@ -0,0 +1,39 @@ +module Qualify.Data.Event +( Event(..) +) where + +import qualified Data.List.NonEmpty as NE +import qualified Data.NonEmptyText as NET +import qualified Data.Time as Time + +data Event = + Event + { time :: Time.UTCTime + , details :: EventDetails + } + +data EventDetails + = MoodEvent Mood Intensity + | ActivityEvent ActivityType + | ConsumptionEvent Substance Dose + +data Mood + = Angry + | Sad + | Happy + | Neutral + +data ActivityType + = Cycling Distance + | Running Distance + | Meditation DurationX + | Pushups (NE.NonEmpty WorkoutSet) + +newtype Intensity = Intensity Int +newtype Duration = Minutes Int +newtype Distance = Miles Int +newtype Reps = Reps Int +newtype WorkoutSet = WorkoutSet Reps + +newtype Substance = Substance NET.NonEmptyText +newtype Dose = Dose NET.NonEmptyText diff --git a/qualify-web-ui/shell.nix b/qualify-web-ui/shell.nix new file mode 100644 index 0000000..7d352e0 --- /dev/null +++ b/qualify-web-ui/shell.nix @@ -0,0 +1,10 @@ +with (import ./default.nix); +let + reload-script = pkgs.writeScriptBin "reload" '' + ${pkgs.haskell.packages.ghc865.ghcid}/bin/ghcid -c \ + '${pkgs.haskell.packages.ghc865.cabal-install}/bin/cabal new-repl' \ + -T ':run Main.main' +''; +in dev.env.overrideAttrs (old: { + buildInputs = old.buildInputs ++ [reload-script]; +}) diff --git a/qualify-web-ui/web/Main.hs b/qualify-web-ui/web/Main.hs new file mode 100644 index 0000000..5405381 --- /dev/null +++ b/qualify-web-ui/web/Main.hs @@ -0,0 +1,69 @@ +-- | Haskell language pragma +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE CPP #-} + +-- | Haskell module declaration +module Main where + +-- | Miso framework import +import Miso +import Miso.String + +-- | JSAddle import +#ifndef __GHCJS__ +import Language.Javascript.JSaddle.Warp as JSaddle +import qualified Network.Wai.Handler.Warp as Warp +import Network.WebSockets +#endif +import Control.Monad.IO.Class + +-- | Type synonym for an application model +newtype Model = Model Int + deriving (Show, Eq) + +-- | Sum type for application events +data Action + = AddOne + | SubtractOne + | NoOp + | SayHelloWorld + deriving (Show, Eq) + +#ifndef __GHCJS__ +runApp :: JSM () -> IO () +runApp f = JSaddle.debugOr 8080 (f >> syncPoint) JSaddle.jsaddleApp +#else +runApp :: IO () -> IO () +runApp app = app +#endif + +-- | Entry point for a miso application +main :: IO () +main = runApp $ startApp App {..} + where + initialAction = SayHelloWorld -- initial action to be executed on application load + model = Model 3 -- initial model + update = updateModel -- update function + view = viewModel -- view function + events = defaultEvents -- default delegated events + subs = [] -- empty subscription list + mountPoint = Nothing -- mount point for application (Nothing defaults to 'body') + logLevel = Off -- used during prerendering to see if the VDOM and DOM are in synch (only used with `miso` function) + +-- | Updates model, optionally introduces side effects +updateModel :: Action -> Model -> Effect Action Model +updateModel AddOne (Model m) = noEff $ Model (m + 1) +updateModel SubtractOne (Model m) = noEff $ Model (m - 1) +updateModel NoOp m = noEff m +updateModel SayHelloWorld m = m <# do + liftIO (putStrLn "Hello World") >> pure NoOp + +-- | Constructs a virtual DOM from a model +viewModel :: Model -> View Action +viewModel (Model m) = div_ [] [ + button_ [ onClick AddOne ] [ text "+" ] + , text (ms m) + , button_ [ onClick SubtractOne ] [ text "-" ] + , div_ [] [ text "UGH" ] + ]