summaryrefslogtreecommitdiff
path: root/Biz
diff options
context:
space:
mode:
Diffstat (limited to 'Biz')
-rw-r--r--Biz/Bild.hs4
-rw-r--r--Biz/Bild.nix17
-rw-r--r--Biz/Bild/Constants.nix2
-rw-r--r--Biz/Bild/Deps.hs16
-rw-r--r--Biz/Bild/Deps.nix10
-rw-r--r--Biz/Bild/Deps/Haskell.nix3
-rw-r--r--Biz/Bild/Nixpkgs.nix7
-rw-r--r--Biz/Bild/Sources.json65
-rw-r--r--Biz/Dragons.hs14
-rw-r--r--Biz/Id.hs2
-rwxr-xr-xBiz/Ide/hooks/pre-commit4
-rwxr-xr-xBiz/Ide/version14
-rw-r--r--Biz/Lint.hs2
-rw-r--r--Biz/Namespace.hs1
-rw-r--r--Biz/Pie.hs192
-rw-r--r--Biz/Que/Host.hs4
16 files changed, 80 insertions, 277 deletions
diff --git a/Biz/Bild.hs b/Biz/Bild.hs
index cba5232..0e6daf4 100644
--- a/Biz/Bild.hs
+++ b/Biz/Bild.hs
@@ -232,8 +232,8 @@ data Target = Target
-- | We can't build everything yet...
isBuildableNs :: Namespace -> Bool
-isBuildableNs (Namespace (x : _) Namespace.Hs) | x /= "Hero" = True
-isBuildableNs (Namespace _ Namespace.Scm) = True
+isBuildableNs (Namespace _ Namespace.Hs) = True
+isBuildableNs (Namespace _ Namespace.Scm) = False
isBuildableNs (Namespace _ Namespace.Rs) = True
isBuildableNs ns
| ns `elem` nixTargets = True
diff --git a/Biz/Bild.nix b/Biz/Bild.nix
index c007661..e675b68 100644
--- a/Biz/Bild.nix
+++ b/Biz/Bild.nix
@@ -1,8 +1,7 @@
{ nixpkgs ? import ./Bild/Nixpkgs.nix }:
-with import ./Bild/Constants.nix;
-
rec {
+ constants = import ./Bild/Constants.nix;
private = {
inherit nixpkgs;
@@ -21,7 +20,7 @@ rec {
haskellDeps = import ./Bild/Deps/Haskell.nix;
- ghcWith = nixpkgs.haskell.packages.${ghcCompiler}.ghcWithHoogle;
+ ghcWith = nixpkgs.haskell.packages.${constants.ghcCompiler}.ghcWithHoogle;
#mkGhcjsPackageSet = nixpkgs.haskell.packages.${ghcjsCompiler}.ghcWithPackages;
ghcPackageSetFull = private.ghcWith private.haskellDeps;
@@ -140,20 +139,20 @@ rec {
env = nixpkgs.pkgs.mkShell {
name = "bizdev";
+ # this should just be dev tools
buildInputs = with nixpkgs.pkgs; [
- # this should just be dev tools
- haskell.packages.${ghcCompiler}.apply-refact
+ #haskell.packages.${constants.ghcCompiler}.apply-refact
bild
figlet
git
- haskell.packages.${ghcCompiler}.fast-tags
+ haskell.packages.${constants.ghcCompiler}.fast-tags
hlint
lolcat
- niv.niv
nixops
ormolu
- python38Packages.black
- python38Packages.pylint
+ # not using python now, should remove
+ #python38Packages.black
+ #python38Packages.pylint
rustc
sbcl
lispPackages.swank
diff --git a/Biz/Bild/Constants.nix b/Biz/Bild/Constants.nix
index 652e022..0ffc85d 100644
--- a/Biz/Bild/Constants.nix
+++ b/Biz/Bild/Constants.nix
@@ -1,4 +1,4 @@
{
- ghcCompiler = "ghc8104";
+ ghcCompiler = "ghc923";
ghcjsCompiler = "ghcjs86";
}
diff --git a/Biz/Bild/Deps.hs b/Biz/Bild/Deps.hs
new file mode 100644
index 0000000..908f188
--- /dev/null
+++ b/Biz/Bild/Deps.hs
@@ -0,0 +1,16 @@
+{-# LANGUAGE LambdaCase #-}
+
+-- | A specific-purpose dependency manager.
+--
+-- : out deps
+module Biz.Bild.Deps where
+
+import Alpha
+import qualified Niv.Cli
+import qualified System.Environment as Env
+
+main :: IO ()
+main =
+ Env.getArgs +> \case
+ ["test"] -> pure ()
+ _ -> Niv.Cli.cli
diff --git a/Biz/Bild/Deps.nix b/Biz/Bild/Deps.nix
index 4f16250..84639b5 100644
--- a/Biz/Bild/Deps.nix
+++ b/Biz/Bild/Deps.nix
@@ -14,11 +14,17 @@ in rec
overrides = with super.pkgs.haskell.lib; sel: sup:
super.overridePinnedDeps (buildCabal sel) // {
acid-state = dontCheck sup.acid-state; # mac: "too many open files"
+ clay = doJailbreak sup.clay;
+ envy = doJailbreak sup.envy;
+ fast-tags = sup.fast-tags.overrideAttrs (old: old // { patches = []; });
+ generic-data = dontCheck sup.generic-data; # https://github.com/Lysxia/generic-data/issues/56
ghcjs-base = null; # otherwise ghc tries to build this via overridePinnedDeps
- servant-auth = buildCabalSubdir sel {name = "servant-auth";};
+ readable = doJailbreak sup.readable; # why is this even being built?
+ servant-auth = doJailbreak (buildCabalSubdir sel {name = "servant-auth"; subdir = "servant-auth/servant-auth";});
servant-server = doJailbreak sup.servant-server;
+ stripe-core = doJailbreak sup.stripe-core;
stripe-haskell = dontCheck sup.stripe-haskell;
- stripe-http-client = dontCheck sup.stripe-http-client;
+ stripe-http-client = doJailbreak (dontCheck sup.stripe-http-client);
temporary = dontCheck sup.temporary;
wai-middleware-metrics = dontCheck sup.wai-middleware-metrics;
};
diff --git a/Biz/Bild/Deps/Haskell.nix b/Biz/Bild/Deps/Haskell.nix
index 39139af..7e9f4fe 100644
--- a/Biz/Bild/Deps/Haskell.nix
+++ b/Biz/Bild/Deps/Haskell.nix
@@ -20,7 +20,6 @@ with hpkgs;
containers
directory
docopt
- ekg
envy
fast-logger
filepath
@@ -33,12 +32,12 @@ with hpkgs;
ixset
katip
lucid
- miso
monad-logger
monad-metrics
mtl
neat-interpolation
network-uri
+ niv
optparse-simple
parsec
process
diff --git a/Biz/Bild/Nixpkgs.nix b/Biz/Bild/Nixpkgs.nix
index d29519c..480662a 100644
--- a/Biz/Bild/Nixpkgs.nix
+++ b/Biz/Bild/Nixpkgs.nix
@@ -6,6 +6,10 @@ import sources.nixpkgs {
overlays = [
(_: _: { inherit sources; })
(_: pkgs: {
+ # Given a generic `builder`, will generate an attrset for all the packages
+ # pinned by `deps` with `builder` applied to the package. This attrset can
+ # then be merged with the rest of the packages in the set as part of an
+ # overlay or overrides.
overridePinnedDeps = builder:
pkgs.lib.genAttrs (builtins.attrNames pkgs.sources) builder;
})
@@ -28,5 +32,8 @@ import sources.nixpkgs {
config = {
allowBroken = true;
allowUnfree = true;
+ permittedInsecurePackages = [
+ "python2.7-pyjwt-1.7.1"
+ ];
};
}
diff --git a/Biz/Bild/Sources.json b/Biz/Bild/Sources.json
index 7659958..b754685 100644
--- a/Biz/Bild/Sources.json
+++ b/Biz/Bild/Sources.json
@@ -1,17 +1,4 @@
{
- "apply-refact": {
- "branch": "master",
- "description": "Refactor Haskell source files",
- "homepage": "",
- "owner": "mpickering",
- "repo": "apply-refact",
- "rev": "0.8.2.1",
- "sha256": "0wyamn4w3lsayhsqs6h60f0m337b1p5byw1frmcyima3pqsgprvl",
- "type": "tarball",
- "url": "https://github.com/mpickering/apply-refact/archive/0.8.2.1.tar.gz",
- "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
- "version": "0.8.2.1"
- },
"clay": {
"branch": "master",
"description": "A CSS preprocessor as embedded Haskell.",
@@ -96,36 +83,23 @@
"homepage": "",
"owner": "ghcjs",
"repo": "jsaddle",
- "rev": "d569be43f92b9b8c01dc3ee4c41401ab406a2076",
- "sha256": "1m1xxy4l9ii91k1k504qkxh9k1ybprm1m66mkb9dqlwcpyhcccmv",
+ "rev": "00b206288c2cd019b56ff9f0b72a065f67ffb242",
+ "sha256": "179q0j4wmn28h1ny2p8qgpr25krl4v6dn3xmbn8zkvylkz4f3m42",
"type": "tarball",
- "url": "https://github.com/ghcjs/jsaddle/archive/d569be43f92b9b8c01dc3ee4c41401ab406a2076.tar.gz",
+ "url": "https://github.com/ghcjs/jsaddle/archive/00b206288c2cd019b56ff9f0b72a065f67ffb242.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
"version": "1e39844"
},
- "miso": {
- "branch": "master",
- "description": ":ramen: A tasty Haskell front-end framework",
- "homepage": "https://haskell-miso.org",
- "owner": "dmjio",
- "repo": "miso",
- "rev": "41234e419d6177fe05913a1bd885f811afe5cc9f",
- "sha256": "1nby1y8yixv0a47h1bzdfjcwzah3km7bfd0phdb520ci4dgs30w1",
- "type": "tarball",
- "url": "https://github.com/dmjio/miso/archive/41234e419d6177fe05913a1bd885f811afe5cc9f.tar.gz",
- "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
- "version": "1.5"
- },
"niv": {
"branch": "master",
"description": "Easy dependency management for Nix projects",
"homepage": "https://github.com/nmattia/niv",
"owner": "nmattia",
"repo": "niv",
- "rev": "af958e8057f345ee1aca714c1247ef3ba1c15f5e",
- "sha256": "1qjavxabbrsh73yck5dcq8jggvh3r2jkbr6b5nlz5d9yrqm9255n",
+ "rev": "82e5cd1ad3c387863f0545d7591512e76ab0fc41",
+ "sha256": "090l219mzc0gi33i3psgph6s2pwsc8qy4lyrqjdj4qzkvmaj65a7",
"type": "tarball",
- "url": "https://github.com/nmattia/niv/archive/af958e8057f345ee1aca714c1247ef3ba1c15f5e.tar.gz",
+ "url": "https://github.com/nmattia/niv/archive/82e5cd1ad3c387863f0545d7591512e76ab0fc41.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"nixos-mailserver": {
@@ -144,10 +118,10 @@
"name": "nixpkgs",
"owner": "bsima",
"repo": "nixpkgs",
- "rev": "11452e4fe3b4afe566b47f1f85c2cec863a4f5bb",
- "sha256": "0csm6wxf1s6vx9kl0yl28lgiwnxans0023ib47qlrjbkmpaqy4b8",
+ "rev": "30216881bc4c0faf52f048b9141afe167762b917",
+ "sha256": "11qwps5mg8pgy5hvb2cw5l0vj7igk5gi7gskn9z6mqf7rv29yh4x",
"type": "tarball",
- "url": "https://github.com/bsima/nixpkgs/archive/11452e4fe3b4afe566b47f1f85c2cec863a4f5bb.tar.gz",
+ "url": "https://github.com/bsima/nixpkgs/archive/30216881bc4c0faf52f048b9141afe167762b917.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz"
},
"regex-applicative": {
@@ -164,29 +138,16 @@
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
"version": "0.3.4"
},
- "req": {
- "branch": "master",
- "description": "Easy-to-use, type-safe, expandable, high-level HTTP client library",
- "homepage": "",
- "owner": "mrkkrp",
- "repo": "req",
- "rev": "0f799e9076053c4bdd685b81e0393d1682de8735",
- "sha256": "1xrzplgas107zxnv23ai14r4s6wz57ycsav1zhikhk04zz442zhh",
- "type": "tarball",
- "url": "https://github.com/mrkkrp/req/archive/0f799e9076053c4bdd685b81e0393d1682de8735.tar.gz",
- "url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
- "version": "3.8.0"
- },
"servant-auth": {
"branch": "master",
"description": null,
"homepage": null,
"owner": "haskell-servant",
- "repo": "servant-auth",
- "rev": "servant-auth-0.4.0.0",
- "sha256": "1wg67mr472mracyjd63ldlfiv85v2kdw2rvcvq1sahp05i591j26",
+ "repo": "servant",
+ "rev": "f0e2316895ee5fda52ba9d5b2b7e10f8a80a9019",
+ "sha256": "0ndan9zxvg5zvrl42zvppc9vhbn5skgsyqyxp2v685h82lfz74ps",
"type": "tarball",
- "url": "https://github.com/haskell-servant/servant-auth/archive/servant-auth-0.4.0.0.tar.gz",
+ "url": "https://github.com/haskell-servant/servant/archive/f0e2316895ee5fda52ba9d5b2b7e10f8a80a9019.tar.gz",
"url_template": "https://github.com/<owner>/<repo>/archive/<rev>.tar.gz",
"version": "0.4.0.0"
}
diff --git a/Biz/Dragons.hs b/Biz/Dragons.hs
index 0a3583d..7307f69 100644
--- a/Biz/Dragons.hs
+++ b/Biz/Dragons.hs
@@ -540,9 +540,9 @@ data Keep = Keep
$(deriveSafeCopy 0 'base ''Keep)
createUser :: User -> Acid.Update Keep User
-createUser u = do
+createUser User {..} = do
keep <- get
- let newUser = u {userId = nextUserId keep} :: User
+ let newUser = User {userId = nextUserId keep, ..}
put
<| keep
{ users = IxSet.insert newUser (users keep),
@@ -644,9 +644,10 @@ upsertGitHubUser keep tok ghUser =
|> GetUserByGitHubId
|> Acid.query keep
+> \case
- Just user ->
+ Just User {..} ->
-- if we already know this user, we need to refresh the token
- UpdateUser user {userGitHubToken = Encoding.decodeUtf8 tok}
+ User {userGitHubToken = Encoding.decodeUtf8 tok, ..}
+ |> UpdateUser
|> Acid.update keep
Nothing ->
CreateUser
@@ -1036,8 +1037,9 @@ htmlApp jwtCfg cooks kp cfg oAuthArgs =
guardAuth >=> UserAccount .> App.Html .> pure,
postAccount = \a subscription ->
guardAuth a
- +> \user ->
- UpdateUser user {userSubscription = subscription}
+ +> \User {..} ->
+ User {userSubscription = subscription, ..}
+ |> UpdateUser
|> Acid.update' kp
+> UserAccount
.> App.Html
diff --git a/Biz/Id.hs b/Biz/Id.hs
index 4635f7f..344149d 100644
--- a/Biz/Id.hs
+++ b/Biz/Id.hs
@@ -30,7 +30,7 @@ instance Hashable (Id entity)
instance Binary (Id entity)
instance Enum (Id entity) where
- toEnum n = mk (Proxy :: Proxy entity) n
+ toEnum = mk (Proxy :: Proxy entity)
fromEnum = untag
instance NFData (Id entity) where
diff --git a/Biz/Ide/hooks/pre-commit b/Biz/Ide/hooks/pre-commit
index 507d7e6..31a4e68 100755
--- a/Biz/Ide/hooks/pre-commit
+++ b/Biz/Ide/hooks/pre-commit
@@ -8,7 +8,9 @@
for ns in ${changed[@]}
do
version=$($BIZ_ROOT/Biz/Ide/version $ns)
- if (( $version < 1 )); then
+ if (( $version == -1 )); then
+ echo "info: version: $ns: deleted"
+ elif (( $version < 1 )); then
echo "fail: version: $ns: $version"
exit 1
else
diff --git a/Biz/Ide/version b/Biz/Ide/version
index 3a02b95..5b017d9 100755
--- a/Biz/Ide/version
+++ b/Biz/Ide/version
@@ -3,9 +3,13 @@
# simple implementation of kelvin versioning
##
ns=$1
- commits=$(git log --oneline --follow $ns | wc -l)
- # gold melts at 1337 kelvin, so we start with this
- # bc we are forging gold here
- version=$(bc -l <<< "1337 - $commits")
- echo $version
+ if [[ -e "$1" ]]; then
+ commits=$(git log --oneline --follow $ns | wc -l)
+ # gold melts at 1337 kelvin, so we start with this
+ # bc we are forging gold here
+ version=$(bc -l <<< "1337 - $commits")
+ echo $version
+ else
+ echo -1 # signal that file doesn't exist
+ fi
##
diff --git a/Biz/Lint.hs b/Biz/Lint.hs
index 23a6834..8dafcb3 100644
--- a/Biz/Lint.hs
+++ b/Biz/Lint.hs
@@ -159,7 +159,7 @@ runOne mode root cwd path_ = results +> traverse_ printResult >> results
[ lint mode ormolu path_,
lint mode hlint path_
]
- Just (Namespace _ Py) -> [lint mode pylint path_]
+ Just (Namespace _ Py) -> [] -- [lint mode pylint path_]
Just (Namespace _ Sh) -> [lint mode shellcheck path_]
Just (Namespace _ Nix) -> [pure <| NoOp path_]
Just (Namespace _ Scm) -> [pure <| NoOp path_]
diff --git a/Biz/Namespace.hs b/Biz/Namespace.hs
index b9ef994..1365919 100644
--- a/Biz/Namespace.hs
+++ b/Biz/Namespace.hs
@@ -1,5 +1,4 @@
{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}
diff --git a/Biz/Pie.hs b/Biz/Pie.hs
index ff02716..3914674 100644
--- a/Biz/Pie.hs
+++ b/Biz/Pie.hs
@@ -1,12 +1,3 @@
-{-# LANGUAGE DeriveAnyClass #-}
-{-# LANGUAGE DeriveGeneric #-}
-{-# LANGUAGE DuplicateRecordFields #-}
-{-# LANGUAGE LambdaCase #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE QuasiQuotes #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# LANGUAGE NoImplicitPrelude #-}
-
-- | [P]roduct [I]mprovement [E]ngine
--
-- A product improvement engine must measure two things:
@@ -30,186 +21,3 @@
-- - Sean Ellis' question: "How would you feel if you could no longer use this
-- product? (a) Very disappointed, (b) somewhat disappointed, (c) not
-- disappointed" and then measure the percentage who answer (a).
---
--- Bild Metadata:
---
--- : out pie
-module Biz.Pie
- ( main,
- )
-where
-
-import Alpha
-import qualified Biz.Cli as Cli
-import Biz.Test ((@=?))
-import qualified Biz.Test as Test
-import qualified Data.Aeson as Aeson
-import qualified Data.Maybe as Maybe
-import qualified Data.Text as Text
-import qualified Data.Time as Time
-import qualified System.Console.Haskeline as Haskeline
-import qualified System.Directory as Directory
-import qualified System.Exit as Exit
-import qualified System.Process as Process
-import qualified Text.Parsec as Parsec
-import qualified Text.Parsec.String as Parsec
-
-main :: IO ()
-main = Cli.main <| Cli.Plan help move test pure
-
-test :: Test.Tree
-test = Test.group "Biz.Pie" [Test.unit "id" <| 1 @=? (1 :: Integer)]
-
-help :: Cli.Docopt
-help =
- [Cli.docopt|
-[p]roduct [i]mprovement [e]ngine
-manages .pie files, records data from product build sprints and user testing
-
-Usage:
- pie new
- pie update <ns>
- pie feedback <ns>
- pie test
-|]
-
-newtype Form = Form {roll :: [Entry]}
- deriving (Generic, Aeson.ToJSON, Aeson.FromJSON, Show)
-
-instance Monoid Form where
- mempty = Form []
-
-instance Semigroup Form where
- a <> b = Form (roll a <> roll b)
-
-formFile :: String -> FilePath
-formFile ns = ns ++ ".pie"
-
-loadForm :: String -> IO Form
-loadForm ns =
- Directory.doesFileExist file +> \case
- False -> pure mempty
- True ->
- Aeson.decodeFileStrict file +> \case
- Nothing -> panic <| Text.pack <| "could not decode: " ++ file
- Just x -> pure x
- where
- file = formFile ns
-
-saveForm :: String -> Form -> IO ()
-saveForm "" _ = pure ()
-saveForm namespace form = Aeson.encodeFile (formFile namespace) form
-
-data Move
- = New
- | Update String
- | Feedback String
-
-fromArgs :: Cli.Arguments -> Move
-fromArgs args
- | cmd "new" = New
- | cmd "update" = Update <| getArg "ns"
- | cmd "feedback" = Feedback <| getArg "ns"
- | otherwise = panic "could not get move from args"
- where
- cmd a = args `Cli.has` Cli.command a
- getArg a = Maybe.fromJust <| args `Cli.getArg` Cli.argument a
-
-move :: Cli.Arguments -> IO ()
-move args = case fromArgs args of
- New -> do
- week <- Time.getCurrentTime +> pure <. Time.formatTime Time.defaultTimeLocale "%V"
- let branch = "sprint-" <> week
- proc <- Process.spawnProcess "git" ["show-ref", branch]
- Process.waitForProcess proc +> \case
- Exit.ExitSuccess ->
- Process.callProcess "git" ["switch", branch]
- Exit.ExitFailure _ ->
- Process.callProcess "git" ["switch", "-c", branch]
- Update namespace ->
- Haskeline.runInputT Haskeline.defaultSettings <| do
- form <- liftIO <| loadForm namespace
- timestamp <- liftIO Time.getCurrentTime
- onTrack <- parseBool </ question "Are you on track?"
- isLaunched <- parseBool </ question "Are you launched?"
- weeksUntilLaunch <- parseInt </ question "How many weeks to launch?"
- usersTalkedWith <- parseInt </ question "Haw many (prospective) users have you talked to in the last week?"
- learnings <- parseText </ question "What have you learned from them?"
- morale <- parseInt </ question "On a scale of 1-10, what is your morale?"
- mostImprovement <- parseText </ question "What most improved your primary metric?"
- biggestObstacle <- parseText </ question "What is your biggest obstacle?"
- goals <- parseText </ question "What are your top 1-3 goals for next week?"
- liftIO <| saveForm namespace <| form {roll = BuildSprint {..} : roll form}
- Feedback namespace ->
- Haskeline.runInputT Haskeline.defaultSettings <| do
- form <- liftIO <| loadForm namespace
- timestamp <- liftIO Time.getCurrentTime
- user <- parseText </ question "User?"
- howDisappointed <- parseDisappointment </ question "How disappointed? (1=very, 2=somewhat, 3=not)"
- liftIO <| saveForm namespace <| form {roll = UserFeedback {..} : roll form}
-
-question :: String -> Haskeline.InputT IO String
-question q = Maybe.fromJust </ (Haskeline.getInputLine <| q ++ " ")
-
-data Entry
- = BuildSprint
- { timestamp :: Time.UTCTime,
- -- | Last week your goals were X. As of now, do you feel like you're on
- -- track to hit your goals?
- onTrack :: Bool,
- -- | Are you launched?
- isLaunched :: Bool,
- -- | How many weeks to launch?
- weeksUntilLaunch :: Int,
- -- | Haw many (prospective) users have you talked to in the last week?
- usersTalkedWith :: Int,
- -- | What have you learned from them?
- learnings :: Text,
- -- | On a scale of 1-10, what is your morale?
- morale :: Int,
- -- | What most improved your primary metric?
- mostImprovement :: Text,
- -- | What is your biggest obstacle?
- biggestObstacle :: Text,
- -- | What are your top 1-3 goals for next week?
- goals :: Text
- }
- | UserFeedback
- { timestamp :: Time.UTCTime,
- user :: Text,
- howDisappointed :: Disappointment
- }
- deriving (Generic, Aeson.ToJSON, Aeson.FromJSON, Show)
-
-data Disappointment = Very | Somewhat | NotAtAll
- deriving (Generic, Aeson.ToJSON, Aeson.FromJSON, Show)
-
--- helpers for parsing user input
-
-parseInput :: Parsec.Parser a -> String -> Either Parsec.ParseError a
-parseInput p = Parsec.parse (p <* Parsec.eof) ""
-
-parseDisappointment :: String -> Disappointment
-parseDisappointment s = case parseInt s of
- 1 -> Very
- 2 -> Somewhat
- 3 -> NotAtAll
- _ -> panic "could not parse disappointment"
-
-parseText :: String -> Text
-parseText s =
- parseInput (Parsec.many1 Parsec.anyChar) s
- |> fromRight ""
- |> Text.pack
-
-parseBool :: String -> Bool
-parseBool s =
- parseInput (Parsec.oneOf "yn") s
- /> (== 'y')
- |> fromRight False
-
-parseInt :: String -> Int
-parseInt s =
- parseInput (Parsec.many1 Parsec.digit /> readMaybe) s
- /> Maybe.fromJust
- |> fromRight 0
diff --git a/Biz/Que/Host.hs b/Biz/Que/Host.hs
index 702827e..b26f9c7 100644
--- a/Biz/Que/Host.hs
+++ b/Biz/Que/Host.hs
@@ -106,7 +106,7 @@ instance Accept HTML where
contentTypes _ = "text" // "html" /: ("charset", "utf-8") :| ["text" // "html"]
instance MimeRender HTML ByteString where
- mimeRender _ x = str x
+ mimeRender _ = str
instance MimeUnrender HTML Text where
mimeUnrender _ bs = Right <| str bs
@@ -115,7 +115,7 @@ instance MimeUnrender OctetStream Text where
mimeUnrender _ bs = Right <| str bs
instance MimeRender PlainText ByteString where
- mimeRender _ bs = str bs
+ mimeRender _ = str
instance MimeUnrender PlainText ByteString where
mimeUnrender _ bs = Right <| str bs
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-27 21:20:57 +0000