sh2md-0.1.0.0: src/RecordShellToMarkdown.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NamedFieldPuns #-}

{-|
Module      : RecordShellToMarkdown
Description : Create an interactive shell and record the inputs & outputs. When an user interrupts, print the result in markdown format
Copyright   : (c) Mo Kweon
License     : MIT
Maintainer  : kkweon@gmail.com
Stability   : experimental
Portability : POSIX

This module exports 'startShell' which starts an interactive shell

> startShell

CTRL + C if you want to stop recording

Then it will copy the result to the system clipboard.
-}
module RecordShellToMarkdown
  ( startShell
  , runShellCommand
  , runCommand
  ) where

import Control.Concurrent.MVar (MVar, modifyMVar_, newMVar, readMVar)
import Control.Monad (unless)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Trans.State (execStateT, get, modify, put)
import Data.Sequence (Seq((:|>), Empty))
import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Data.Text.IO as TIO
import GHC.IO.Handle (BufferMode(NoBuffering), hGetContents, hSetBuffering)
import System.Hclip (setClipboard)
import System.IO (stdout)
import System.Posix.Signals (Handler(Catch), installHandler, sigINT)
import qualified System.Process as Process

import qualified RecordShellToMarkdown.CLI as CLI
import RecordShellToMarkdown.Data (RecordShellToMarkdownState, ShellIO(..))
import RecordShellToMarkdown.Print (joinSequence)

-- | Start an Interactive shell
--
-- When an user interrupt __CTRL+C__ ('sigINT') then it will stop the session and print markdown
startShell :: CLI.CLIOption -> IO ()
startShell CLI.CLIOption {cli_stdout} = do
  hSetBuffering stdout NoBuffering
  mVar <- newMVar False
  _ <- installHandler sigINT (Catch $ handleInterrupt mVar) Nothing
  shellIOs <- execStateT (foreverRunShellCommand mVar) Empty
  let result = Seq.foldMapWithIndex (\_ x -> buildMarkdown x) shellIOs
  if cli_stdout
    then TIO.putStrLn result
    else setClipboard (T.unpack result) >>
         TIO.putStrLn "The output is copied to your clipboard"
  where
    printAsMarkdown :: ShellIO -> IO ()
    printAsMarkdown = TIO.putStrLn . buildMarkdown
    buildMarkdown :: ShellIO -> T.Text
    buildMarkdown ShellIO {..} =
      let inputs = "```\n" <> T.strip (joinSequence shell_inputs) <> "\n```\n"
       in if T.null shell_output
            then inputs
            else inputs <> "```\n" <> T.strip shell_output <> "\n```\n"

-- | Handle CTRL-C Interrupt
handleInterrupt :: MVar Bool -> IO ()
handleInterrupt mVar = do
  putStrLn "\nPress any key to complete"
  modifyMVar_ mVar (\_ -> return True)

-- | Run shell until CTRL-C is handled
foreverRunShellCommand :: MVar Bool -> RecordShellToMarkdownState ()
foreverRunShellCommand mVar = do
  liftIO $ TIO.putStr "$ "
  cmd <- T.pack <$> liftIO getLine
  unless (T.null cmd) $ runShellCommand cmd
  interrupted <- liftIO $ readMVar mVar
  unless interrupted $ foreverRunShellCommand mVar

-- | Run Shell Command
-- This is a wrapper 'runCommand'
runShellCommand :: T.Text -> RecordShellToMarkdownState ()
runShellCommand cmd = do
  stack <- get
  shellIO <-
    case stack of
      Empty -> runCommand cmd Nothing
      (_ :|> x) -> runCommand cmd (Just . shell_wd $ x)
  unless (T.null . shell_output $ shellIO) $
    liftIO . TIO.putStrLn . T.strip $ shell_output shellIO

-- | Run a shell command
--
-- If the current working directory(CWD) is given, then run the command in the CWD
runCommand ::
     T.Text -- ^ Shell command
  -> Maybe T.Text -- ^ Current working directory
  -> RecordShellToMarkdownState ShellIO
runCommand cmd cwd = do
  (_, maybeHout, _, _) <-
    liftIO $
    Process.createProcess
      (Process.shell (T.unpack cmd ++ ";pwd"))
        { Process.std_out = Process.CreatePipe
        , Process.new_session = False
        , Process.cwd = T.unpack <$> cwd
        }
  case maybeHout of
    Just hout -> do
      content <- liftIO . (T.lines . T.pack <$>) $ hGetContents hout
      handleContent cmd content
    Nothing -> fail "Failed to create a stdout handle"

handleContent :: T.Text -> [T.Text] -> RecordShellToMarkdownState ShellIO
handleContent cmd content = do
  shellIOs <- get
  case shellIOs of
    (rest :|> lastShellIO@ShellIO {..}) ->
      if T.null shell_output
        then let newShellIO =
                   lastShellIO
                     { shell_inputs = shell_inputs :|> cmd
                     , shell_output = shell_output <> T.unlines (init content)
                     , shell_wd = last content
                     }
              in put (rest :|> newShellIO) >> return newShellIO
        else addNewShellIO cmd content
    _ -> addNewShellIO cmd content

-- | Create a new ShellIO and add to the state
addNewShellIO :: T.Text -> [T.Text] -> RecordShellToMarkdownState ShellIO
addNewShellIO cmd content = do
  let shellIO =
        ShellIO (Seq.singleton cmd) (T.unlines (init content)) (last content)
  modify (:|> shellIO)
  return shellIO