This commit is contained in:
2022-12-31 08:24:24 -05:00
commit 8745ded080
24 changed files with 611 additions and 0 deletions

1
.gitignore vendored Normal file
View File

@@ -0,0 +1 @@
db_credentials.txt

44
README.md Normal file
View File

@@ -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

0
data-model.md Normal file
View File

2
qualify-api/.gitignore vendored Normal file
View File

@@ -0,0 +1,2 @@
.stack-work/
*~

11
qualify-api/CHANGELOG.md Normal file
View File

@@ -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

30
qualify-api/LICENSE Normal file
View File

@@ -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.

1
qualify-api/README.md Normal file
View File

@@ -0,0 +1 @@
# qualify

2
qualify-api/Setup.hs Normal file
View File

@@ -0,0 +1,2 @@
import Distribution.Simple
main = defaultMain

6
qualify-api/app/Main.hs Normal file
View File

@@ -0,0 +1,6 @@
module Main (main) where
import Lib
main :: IO ()
main = someFunc

60
qualify-api/package.yaml Normal file
View File

@@ -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 <https://github.com/githubuser/qualify#readme>
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

61
qualify-api/qualify.cabal Normal file
View File

@@ -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 <https://github.com/githubuser/qualify#readme>
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

6
qualify-api/src/Lib.hs Normal file
View File

@@ -0,0 +1,6 @@
module Lib
( someFunc
) where
someFunc :: IO ()
someFunc = putStrLn "someFunc"

View File

@@ -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

2
qualify-api/test/Spec.hs Normal file
View File

@@ -0,0 +1,2 @@
main :: IO ()
main = putStrLn "Test suite not yet implemented"

View File

@@ -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

3
qualify-web-ui/.gitignore vendored Normal file
View File

@@ -0,0 +1,3 @@
dist-newstyle
result
result-2

57
qualify-web-ui/README.md Normal file
View File

@@ -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.

26
qualify-web-ui/app.cabal Normal file
View File

@@ -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

View File

@@ -0,0 +1 @@
compiler: ghcjs

View File

@@ -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;
}

View File

@@ -0,0 +1,5 @@
module Qualify.Data
( module X
) where
import qualified Qualify.Data.Event as X

View File

@@ -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

10
qualify-web-ui/shell.nix Normal file
View File

@@ -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];
})

View File

@@ -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" ]
]