temp

2022-12-31 08:24:24 -05:00
commit 8745ded080
24 changed files with 611 additions and 0 deletions
--- a/qualify-web-ui/.ghc.environment.x86_64-linux-8.6.5
+++ 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
--- a/qualify-web-ui/.gitignore
+++ b/qualify-web-ui/.gitignore
@@ -0,0 +1,3 @@
+dist-newstyle
+result
+result-2
--- a/qualify-web-ui/README.md
+++ 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.
--- a/qualify-web-ui/app.cabal
+++ 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
--- a/qualify-web-ui/cabal.config
+++ b/qualify-web-ui/cabal.config
@@ -0,0 +1 @@
+compiler: ghcjs
--- a/qualify-web-ui/default.nix
+++ 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;
+}
+
--- a/qualify-web-ui/lib/Qualify/Data.hs
+++ 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
--- a/qualify-web-ui/lib/Qualify/Data/Event.hs
+++ 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
--- a/qualify-web-ui/shell.nix
+++ 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];
+})
--- a/qualify-web-ui/web/Main.hs
+++ 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" ]
+ ]