pie prototype

3 files changed, 218 insertions, 0 deletions

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 </ 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?"
+    return <| form {roll = BuildSprint {..} : (roll form)}
+  Feedback -> Haskeline.runInputT Haskeline.defaultSettings $ do
+    timestamp <- liftIO Clock.getCurrentTime
+    user <- parseText </ question "User?"
+    howDisappointed <- parseDisappointment </ question "How disappointed? (1=very, 2=somewhat, 3=not)"
+    return <| form {roll = UserFeedback {..} : (roll form)}
+
+question :: String -> Haskeline.InputT IO String
+question q = Maybe.fromJust </ (Haskeline.getInputLine <| q ++ " ")
+
+data Entry
+  = BuildSprint
+      { timestamp :: Clock.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 :: Clock.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/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")