From 170ca39ccee2826f7623858ad4426071fd3a0d61 Mon Sep 17 00:00:00 2001 From: Ben Sima Date: Mon, 12 Oct 2020 23:42:22 -0400 Subject: pie prototype --- Biz/Pie.hs | 208 +++++++++++++++++++++++++++++++++++++++++++++++++++ nix/haskell-deps.nix | 4 + nix/shellHook.sh | 6 ++ 3 files changed, 218 insertions(+) create mode 100644 Biz/Pie.hs diff --git a/Biz/Pie.hs b/Biz/Pie.hs new file mode 100644 index 0000000..e8334e2 --- /dev/null +++ b/Biz/Pie.hs @@ -0,0 +1,208 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DuplicateRecordFields #-} +{-# LANGUAGE LambdaCase #-} +{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude #-} + +-- | [P]roduct [I]mprovement [E]ngine +-- +-- A product improvement engine must measure two things: +-- +-- 1. Is your product built? +-- 2. Do you have product-market fit? +-- +-- Let's use an analogy: building a startup is like jumping off a clif and +-- assembling a plane on the way down. As nsroach the ground at terminal +-- velocity, only two questions are relevant: Is the plane built? Does it fly? +-- Nothing else matters. +-- +-- So, Pie is a program that records answers to these two things and then +-- reports on whether we are making the correct progress. +-- +-- This is inspired by a few things: +-- +-- - YC's Startup School has a build sprint questionnaire +-- - Sam Altman's startup playbook: "You want to build a 'product improvement +-- engine' in your company." +-- - 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). +module Biz.Pie + ( main, + ) +where + +import Alpha +import qualified Data.Aeson as Aeson +import qualified Data.Maybe as Maybe +import qualified Data.Text as Text +import qualified Data.Time.Clock as Clock +import Options.Applicative.Simple +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 = do + (ns, mov) <- + simpleOptions + "dev" + "[P]roduct [I]mprovement [E]ngine" + "manages .pie files, records data from product build sprints and user testing" + ( strArgument + <| help "the namespace of the app you are working on" + <> metavar "NAMESPACE" + <> value "Devalloc" + ) + <| do + addCommand + "start" + "start a sprint" + (const . move Start) + (pure mempty) + addCommand + "update" + "submit update" + (const . move Update) + (pure mempty) + addCommand + "feedback" + "submit user feedback" + (const . move Feedback) + (pure mempty) + form <- loadForm ns + newForm <- mov form {namespace = ns} + saveForm ns newForm + +type Namespace = String + +data Form = Form {namespace :: Namespace, roll :: [Entry]} + deriving (Generic, Aeson.ToJSON, Aeson.FromJSON, Show) + +instance Monoid Form where + mempty = Form "" [] + +instance Semigroup Form where + a <> b = Form (namespace a <> namespace b) (roll a <> roll b) + +formFile :: String -> FilePath +formFile ns = ns ++ ".pie" + +loadForm :: Namespace -> IO Form +loadForm ns = Directory.doesFileExist file >>= \case + False -> touch file >> return mempty + True -> Aeson.decodeFileStrict file >>= \case + Nothing -> panic $ Text.pack $ "could not decode: " ++ file + Just x -> return x + where + file = formFile ns + touch f = writeFile f "" + +saveForm :: Namespace -> Form -> IO () +saveForm ns = Aeson.encodeFile (formFile ns) + +data Move + = Start + | Update + | Feedback + +move :: Move -> Form -> IO Form +move mov form = case mov of + Start -> + let branch = namespace form ++ "/sprint" + in Process.spawnProcess "git" ["show-ref", branch] + >>= Process.waitForProcess + >>= \case + Exit.ExitSuccess -> + Process.callProcess "git" ["switch", branch] + Exit.ExitFailure _ -> + Process.callProcess "git" ["switch", "-c", branch] + >> return form + Update -> Haskeline.runInputT Haskeline.defaultSettings $ do + timestamp <- liftIO Clock.getCurrentTime + onTrack <- parseBool Haskeline.runInputT Haskeline.defaultSettings $ do + timestamp <- liftIO Clock.getCurrentTime + user <- parseText Haskeline.InputT IO String +question q = Maybe.fromJust 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/nix/haskell-deps.nix b/nix/haskell-deps.nix index 1f09b4a..dccbd81 100644 --- a/nix/haskell-deps.nix +++ b/nix/haskell-deps.nix @@ -15,6 +15,7 @@ "fast-logger" "filepath" "ghcjs-base" + "haskeline" "http-types" "ixset" "katip" @@ -24,6 +25,8 @@ "monad-metrics" "mtl" "network-uri" + "optparse-simple" + "parsec" "process" "protolude" "quickcheck-instances" @@ -42,6 +45,7 @@ "string-quote" "tasty" "text" + "time" "transformers" "unagi-chan" "unix" diff --git a/nix/shellHook.sh b/nix/shellHook.sh index d1cfaf1..8c8cecc 100644 --- a/nix/shellHook.sh +++ b/nix/shellHook.sh @@ -8,6 +8,7 @@ function help() { echo " help show this message" echo " hero compile and start a dev server for herocomics.app" echo " lint auto-lint all changed files" + echo " pie product improvement engine" echo " push send a namespace to the cloud" echo " ship lint, bild, and push one (or all) namespace(s)" } @@ -47,6 +48,11 @@ function lint() { alias lint=$BIZ_ROOT/Biz/lint.py } + +function pie() { + runghc Biz.Pie $@ +} + # TODO: convert to haskell function push() { prefix=$(echo $PWD | sed -e "s|^$BIZ_ROOT/*||g" -e "s|/|.|g") -- cgit v1.2.3