1 files changed, 208 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