path: root/Biz/Pie.hs

{-# 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:
--
--   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 we approach 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).
--
-- Bild Metadata:
--
-- : out pie
-- : dep aeson
-- : dep docopt
-- : dep haskeline
-- : dep protolude
-- : dep parsec
-- : dep rainbow
-- : dep tasty
-- : dep tasty-hunit
-- : dep tasty-quickcheck
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