{-# 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