summaryrefslogtreecommitdiff
path: root/Biz/Pie.hs
diff options
context:
space:
mode:
authorBen Sima <ben@bsima.me>2022-07-18 22:09:58 -0400
committerBen Sima <ben@bsima.me>2022-07-19 09:22:58 -0400
commitbc9e5b0ea863a17537987faa5a72b00efc7767d1 (patch)
treea22df5a00c29f5612a5f6885b9e6bb9a7a56d420 /Biz/Pie.hs
parentf034ad709ba0de5a2e5ec6be47523f595e381d7a (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/Pie.hs')
-rw-r--r--Biz/Pie.hs192
1 files changed, 0 insertions, 192 deletions
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