diff options
author | Ben Sima <ben@bsima.me> | 2022-07-18 22:09:58 -0400 |
---|---|---|
committer | Ben Sima <ben@bsima.me> | 2022-07-19 09:22:58 -0400 |
commit | bc9e5b0ea863a17537987faa5a72b00efc7767d1 (patch) | |
tree | a22df5a00c29f5612a5f6885b9e6bb9a7a56d420 /Biz | |
parent | f034ad709ba0de5a2e5ec6be47523f595e381d7a (diff) |
Upgrade nixpkgs, ghc923
I ended up deleting miso, and consequently all files under Hero/ and Miso/,
because I couldn't get miso to build with GHC 9.2.
Other things:
- Niv has been wrapped by Biz/Bild/Deps.hs, so I can extend it to my liking.
- Apply-refact is gone because I couldn't get it to build.
- Disabled python stuff.
Diffstat (limited to 'Biz')
-rw-r--r-- | Biz/Bild.hs | 4 | ||||
-rw-r--r-- | Biz/Bild.nix | 17 | ||||
-rw-r--r-- | Biz/Bild/Constants.nix | 2 | ||||
-rw-r--r-- | Biz/Bild/Deps.hs | 16 | ||||
-rw-r--r-- | Biz/Bild/Deps.nix | 10 | ||||
-rw-r--r-- | Biz/Bild/Deps/Haskell.nix | 3 | ||||
-rw-r--r-- | Biz/Bild/Nixpkgs.nix | 7 | ||||
-rw-r--r-- | Biz/Bild/Sources.json | 65 | ||||
-rw-r--r-- | Biz/Dragons.hs | 14 | ||||
-rw-r--r-- | Biz/Id.hs | 2 | ||||
-rwxr-xr-x | Biz/Ide/hooks/pre-commit | 4 | ||||
-rwxr-xr-x | Biz/Ide/version | 14 | ||||
-rw-r--r-- | Biz/Lint.hs | 2 | ||||
-rw-r--r-- | Biz/Namespace.hs | 1 | ||||
-rw-r--r-- | Biz/Pie.hs | 192 | ||||
-rw-r--r-- | Biz/Que/Host.hs | 4 |
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 @@ -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 #-} @@ -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 |