diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,4 +1,13 @@ -## [_Unreleased_](https://github.com/freckle/github-workflow-commands/compare/v0.0.0.0...main) +## [_Unreleased_](https://github.com/freckle/github-workflow-commands/compare/v0.0.1.0...main) + +## [v0.0.1.0](https://github.com/freckle/github-workflow-commands/compare/v0.0.0.0...v0.0.1.0) + +Additions: + +- Re-exporting overview module `GitHub.Workflow.Command`, which is now the + primary module for users to import and find documentation +- Class `MonadCommand` which is now the recommended way to execute commands +- Support for `group`, `add-mask`, `stop-commands` commands ## [v0.0.0.0](https://github.com/freckle/github-workflow-commands/tree/v0.0.0.0) diff --git a/README.lhs b/README.lhs --- a/README.lhs +++ b/README.lhs @@ -19,8 +19,8 @@ --> ```haskell -import qualified GitHub.Workflow.Command.Annotation as GH -import Control.Lens +import qualified GitHub.Workflow.Command as GH +import Control.Lens ((&), (?~)) ``` An annotation is at minimum just a string. @@ -28,7 +28,7 @@ ```haskell example1 :: IO () example1 = - GH.printByteStringLn $ + GH.executeCommand $ GH.error "Something failed." ``` @@ -47,7 +47,7 @@ ```haskell example2 :: IO () example2 = - GH.printByteStringLn $ + GH.executeCommand $ GH.warning "Something seems amiss here." & GH.location ?~ someLocation ``` @@ -55,7 +55,7 @@ diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -19,8 +19,8 @@ --> ```haskell -import qualified GitHub.Workflow.Command.Annotation as GH -import Control.Lens +import qualified GitHub.Workflow.Command as GH +import Control.Lens ((&), (?~)) ``` An annotation is at minimum just a string. @@ -28,7 +28,7 @@ ```haskell example1 :: IO () example1 = - GH.printByteStringLn $ + GH.executeCommand $ GH.error "Something failed." ``` @@ -47,7 +47,7 @@ ```haskell example2 :: IO () example2 = - GH.printByteStringLn $ + GH.executeCommand $ GH.warning "Something seems amiss here." & GH.location ?~ someLocation ``` @@ -55,7 +55,7 @@ diff --git a/github-workflow-commands.cabal b/github-workflow-commands.cabal --- a/github-workflow-commands.cabal +++ b/github-workflow-commands.cabal @@ -1,6 +1,6 @@ cabal-version: 1.18 name: github-workflow-commands -version: 0.0.0.0 +version: 0.0.1.0 license: MIT license-file: LICENSE maintainer: Freckle Education @@ -25,6 +25,7 @@ library exposed-modules: + GitHub.Workflow.Command GitHub.Workflow.Command.Annotation GitHub.Workflow.Command.Annotation.Commands.Debug GitHub.Workflow.Command.Annotation.Commands.Error @@ -39,6 +40,10 @@ GitHub.Workflow.Command.Annotation.Position.Extent GitHub.Workflow.Command.Annotation.Position.Line GitHub.Workflow.Command.Annotation.Properties + GitHub.Workflow.Command.Execution + GitHub.Workflow.Command.Grouping + GitHub.Workflow.Command.Masking + GitHub.Workflow.Command.Stopping GitHub.Workflow.Command.Syntax GitHub.Workflow.Command.Syntax.Command GitHub.Workflow.Command.Syntax.Key @@ -65,6 +70,7 @@ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe build-depends: + MonadRandom >=0.5.3, base >=4.16.4.0 && <5, bytestring >=0.11.4.0, containers >=0.6.5.1, diff --git a/library/GitHub/Workflow/Command.hs b/library/GitHub/Workflow/Command.hs new file mode 100644 --- /dev/null +++ b/library/GitHub/Workflow/Command.hs @@ -0,0 +1,99 @@ +-- | Programs run by GitHub Actions can use workflow commands to communicate with the runner. +-- +-- GitHub documentation: +-- +module GitHub.Workflow.Command + ( -- * Executing commands + MonadCommand (..) + , PrintCommands (..) + + -- * Commands + , ToCommand (..) + + -- ** Setting a debug message + , Debug (..) + , debug + + -- ** Setting a notice message + , Notice (..) + , notice + + -- ** Setting a warning message + , Warning (..) + , warning + + -- ** Setting an error message + , Error (..) + , error + + -- ** Grouping log lines + , group + , GroupStart (..) + , GroupEnd (..) + + -- ** Masking a value in a log + , AddMask (..) + + -- ** Stopping and starting workflow commands + , suspendCommands + , stopCommands + , resumeCommands + , SuspendToken + + -- * Location + , Location (..) + , HasLocationMaybe (..) + + -- ** File + , File (..) + , inFile + , file + + -- ** Position + , Position (..) + , position + , Extent (..) + , extent + , Columns (..) + , line + , startColumn + , endColumn + , Line (..) + , atLine + , Column (..) + , atColumn + + -- * Anatomy of a command + , Command + + -- ** Name + , Name (..) + , HasName (..) + + -- ** Message + , Message (..) + , HasMessage (..) + + -- ** Properties + , Properties + , HasProperties (..) + , Key (..) + , Value (..) + ) where + +import GitHub.Workflow.Command.Annotation.Commands.Debug +import GitHub.Workflow.Command.Annotation.Commands.Error +import GitHub.Workflow.Command.Annotation.Commands.Notice +import GitHub.Workflow.Command.Annotation.Commands.Warning +import GitHub.Workflow.Command.Annotation.File +import GitHub.Workflow.Command.Annotation.Location +import GitHub.Workflow.Command.Annotation.Position +import GitHub.Workflow.Command.Annotation.Position.Column +import GitHub.Workflow.Command.Annotation.Position.Columns +import GitHub.Workflow.Command.Annotation.Position.Extent +import GitHub.Workflow.Command.Annotation.Position.Line +import GitHub.Workflow.Command.Execution +import GitHub.Workflow.Command.Grouping +import GitHub.Workflow.Command.Masking +import GitHub.Workflow.Command.Stopping +import GitHub.Workflow.Command.Syntax diff --git a/library/GitHub/Workflow/Command/Annotation.hs b/library/GitHub/Workflow/Command/Annotation.hs --- a/library/GitHub/Workflow/Command/Annotation.hs +++ b/library/GitHub/Workflow/Command/Annotation.hs @@ -48,6 +48,7 @@ , atColumn -- * Output + , MonadCommand (..) , ToCommand (..) , toCommand , ToByteString (..) @@ -66,11 +67,7 @@ import GitHub.Workflow.Command.Annotation.Position.Extent import GitHub.Workflow.Command.Annotation.Position.Line import GitHub.Workflow.Command.Annotation.Properties -import GitHub.Workflow.Command.Syntax - ( FromMessage (..) - , Message (..) - , ToByteString (..) - , ToCommand (..) - , printByteStringLn - , toCommand - ) +import GitHub.Workflow.Command.Execution +import GitHub.Workflow.Command.Syntax.Command +import GitHub.Workflow.Command.Syntax.Message +import GitHub.Workflow.Command.Syntax.ToByteString diff --git a/library/GitHub/Workflow/Command/Annotation/Commands/Debug.hs b/library/GitHub/Workflow/Command/Annotation/Commands/Debug.hs --- a/library/GitHub/Workflow/Command/Annotation/Commands/Debug.hs +++ b/library/GitHub/Workflow/Command/Annotation/Commands/Debug.hs @@ -16,6 +16,10 @@ ) import GitHub.Workflow.Command.Syntax qualified as Syntax +-- | Prints a debug message to the log +-- +-- GitHub documentation: +-- newtype Debug = Debug { message :: Message } diff --git a/library/GitHub/Workflow/Command/Annotation/Commands/Error.hs b/library/GitHub/Workflow/Command/Annotation/Commands/Error.hs --- a/library/GitHub/Workflow/Command/Annotation/Commands/Error.hs +++ b/library/GitHub/Workflow/Command/Annotation/Commands/Error.hs @@ -18,6 +18,13 @@ ) import GitHub.Workflow.Command.Syntax qualified as Syntax +-- | Creates an error message and prints the message to the log +-- +-- The message can be associated with a particular file in your repository, +-- and optionally also a position within the file. See 'HasLocationMaybe'. +-- +-- GitHub documentation: +-- data Error = Error { message :: Message , properties :: Properties diff --git a/library/GitHub/Workflow/Command/Annotation/Commands/Notice.hs b/library/GitHub/Workflow/Command/Annotation/Commands/Notice.hs --- a/library/GitHub/Workflow/Command/Annotation/Commands/Notice.hs +++ b/library/GitHub/Workflow/Command/Annotation/Commands/Notice.hs @@ -18,6 +18,13 @@ ) import GitHub.Workflow.Command.Syntax qualified as Syntax +-- | Creates a notice message and prints the message to the log +-- +-- The message can be associated with a particular file in your repository, +-- and optionally also a position within the file. See 'HasLocationMaybe'. +-- +-- GitHub documentation: +-- data Notice = Notice { message :: Message , properties :: Properties diff --git a/library/GitHub/Workflow/Command/Annotation/Commands/Warning.hs b/library/GitHub/Workflow/Command/Annotation/Commands/Warning.hs --- a/library/GitHub/Workflow/Command/Annotation/Commands/Warning.hs +++ b/library/GitHub/Workflow/Command/Annotation/Commands/Warning.hs @@ -18,6 +18,13 @@ ) import GitHub.Workflow.Command.Syntax qualified as Syntax +-- | Creates a warning message and prints the message to the log +-- +-- The message can be associated with a particular file in your repository, +-- and optionally also a position within the file. See 'HasLocationMaybe'. +-- +-- GitHub documentation: +-- data Warning = Warning { message :: Message , properties :: Properties diff --git a/library/GitHub/Workflow/Command/Execution.hs b/library/GitHub/Workflow/Command/Execution.hs new file mode 100644 --- /dev/null +++ b/library/GitHub/Workflow/Command/Execution.hs @@ -0,0 +1,35 @@ +module GitHub.Workflow.Command.Execution + ( MonadCommand (..) + , PrintCommands (..) + ) where + +import Control.Applicative (Applicative) +import Control.Monad (Monad) +import Control.Monad.IO.Class (MonadIO, liftIO) +import Data.Function ((.)) +import Data.Functor (Functor) +import GitHub.Workflow.Command.Syntax +import System.IO (IO) + +-- | Monadic context in which GitHub workflow commands may be executed +-- +-- * For the most basic uses, use the 'IO' instance, which prints commands to 'System.IO.stdout'. +-- +-- * For custom monads that support 'MonadIO', you may derive 'MonadCommand' via 'PrintCommands' +-- to get the same behavior that 'IO' exhibits. +-- +-- * A program that wishes to accommodate running in both GitHub and non-GitHub contexts +-- may wish to define a more sophisicated 'MonadCommand' instance that prints GitHub +-- workflow commands only when the @GITHUB_ACTIONS@ environment variable is present, +-- and otherwise takes some other more context-appropriate action. +class Monad m => MonadCommand m where + executeCommand :: ToCommand a => a -> m () + +instance MonadCommand IO where + executeCommand = printByteStringLn . toCommand + +newtype PrintCommands m a = PrintCommands (m a) + deriving newtype (Functor, Applicative, Monad, MonadIO) + +instance MonadIO m => MonadCommand (PrintCommands m) where + executeCommand = liftIO . executeCommand diff --git a/library/GitHub/Workflow/Command/Grouping.hs b/library/GitHub/Workflow/Command/Grouping.hs new file mode 100644 --- /dev/null +++ b/library/GitHub/Workflow/Command/Grouping.hs @@ -0,0 +1,42 @@ +module GitHub.Workflow.Command.Grouping + ( group + , GroupStart (..) + , GroupEnd (..) + ) where + +import Control.Applicative ((*>), (<*)) +import Control.Lens ((.~)) +import Data.Function ((.)) +import Data.Text (Text) +import GitHub.Workflow.Command.Execution +import GitHub.Workflow.Command.Syntax + +-- | Creates an expandable group in the log +-- +-- GitHub documentation: +-- +group + :: MonadCommand m + => Text + -- ^ Group title + -> m a + -- ^ Anything printed within this action will be + -- nested inside an expandable entry in the log + -> m a +group title x = + executeCommand GroupStart {title} + *> x + <* executeCommand GroupEnd + +-- | Starts a 'group' +newtype GroupStart = GroupStart {title :: Text} + +instance ToCommand GroupStart where + addToCommand GroupStart {title} = + (name .~ "group") . (message .~ Message title) + +-- | Ends a 'group' +data GroupEnd = GroupEnd + +instance ToCommand GroupEnd where + addToCommand GroupEnd = name .~ "endgroup" diff --git a/library/GitHub/Workflow/Command/Masking.hs b/library/GitHub/Workflow/Command/Masking.hs new file mode 100644 --- /dev/null +++ b/library/GitHub/Workflow/Command/Masking.hs @@ -0,0 +1,21 @@ +module GitHub.Workflow.Command.Masking + ( AddMask (..) + ) where + +import Control.Lens ((.~)) +import Data.Function ((.)) +import Data.Text (Text) +import GitHub.Workflow.Command.Syntax + +-- | Prevents a string or variable from being printed in the log +-- +-- GitHub documentation: +-- +newtype AddMask = AddMask + { value :: Text + -- ^ An environment variable or string + } + +instance ToCommand AddMask where + addToCommand AddMask {value} = + (name .~ "add-mask") . (message .~ Message value) diff --git a/library/GitHub/Workflow/Command/Stopping.hs b/library/GitHub/Workflow/Command/Stopping.hs new file mode 100644 --- /dev/null +++ b/library/GitHub/Workflow/Command/Stopping.hs @@ -0,0 +1,83 @@ +module GitHub.Workflow.Command.Stopping + ( -- * Basic usage + suspendCommands + + -- * Stop and resume + , stopCommands + , resumeCommands + , SuspendToken (..) + + -- * Manual token management + , randomSuspendToken + , suspendCommandsWithToken + , stopCommandsWithToken + + -- * Command types + , StopCommands (..) + , ResumeCommands (..) + ) where + +import Control.Applicative ((*>), (<*)) +import Control.Lens ((.~)) +import Control.Monad.Random.Class (MonadRandom, getRandomRs) +import Data.Function ((.)) +import Data.Functor (Functor ((<$)), (<$>)) +import Data.List qualified as List +import Data.Text (Text) +import Data.Text qualified as T +import GitHub.Workflow.Command.Execution +import GitHub.Workflow.Command.Syntax + +-- | Run an action with processing of workflow commands suspended +-- +-- GitHub documentation: +-- +suspendCommands + :: (MonadCommand m, MonadRandom m) + => m a + -- ^ Commands issued by this action will have no effect + -> m a +suspendCommands x = do + token <- randomSuspendToken + suspendCommandsWithToken token x + +suspendCommandsWithToken :: MonadCommand m => SuspendToken -> m a -> m a +suspendCommandsWithToken token x = + stopCommandsWithToken token *> x <* resumeCommands token + +-- | Stops processing any workflow commands +-- +-- This special command allows you to log anything without accidentally running a workflow command. +stopCommands :: (MonadCommand m, MonadRandom m) => m SuspendToken +stopCommands = do + token <- randomSuspendToken + token <$ stopCommandsWithToken token + +stopCommandsWithToken :: MonadCommand m => SuspendToken -> m () +stopCommandsWithToken token = + executeCommand StopCommands {token} + +-- | Resume processing workflow commands +resumeCommands :: MonadCommand m => SuspendToken -> m () +resumeCommands token = executeCommand ResumeCommands {token} + +newtype SuspendToken = SuspendToken Text + +randomSuspendToken :: MonadRandom m => m SuspendToken +randomSuspendToken = SuspendToken . T.pack . List.take 20 <$> getRandomRs ('a', 'z') + +newtype StopCommands = StopCommands + { token :: SuspendToken + } + +instance ToCommand StopCommands where + addToCommand StopCommands {token = SuspendToken t} = + (name .~ "stop-commands") . (message .~ Message t) + +newtype ResumeCommands = ResumeCommands + { token :: SuspendToken + } + +instance ToCommand ResumeCommands where + addToCommand ResumeCommands {token = SuspendToken t} = + name .~ Name t diff --git a/library/GitHub/Workflow/Command/Syntax/Command.hs b/library/GitHub/Workflow/Command/Syntax/Command.hs --- a/library/GitHub/Workflow/Command/Syntax/Command.hs +++ b/library/GitHub/Workflow/Command/Syntax/Command.hs @@ -19,10 +19,20 @@ import GitHub.Workflow.Command.Syntax.ToByteString import Prelude (Eq, Maybe (..), Ord, Show, not, (<>)) +-- | A GitHub workflow command +-- +-- A 'Command' consists of: +-- +-- * 'Name' ('HasName') +-- * 'Message' ('HasMessage') +-- * 'Properties' ('HasProperties') +-- +-- Of these, only 'Name' is always required. Some particular types of command require +-- a message or have restrictions on what properties they support or require. data Command = Command { name :: Name - , properties :: Properties , message :: Message + , properties :: Properties } deriving stock (Eq, Ord, Show) diff --git a/package.yaml b/package.yaml --- a/package.yaml +++ b/package.yaml @@ -1,5 +1,5 @@ name: github-workflow-commands -version: 0.0.0.0 +version: 0.0.1.0 maintainer: Freckle Education category: GitHub github: freckle/github-workflow-commands @@ -72,6 +72,7 @@ - bytestring - containers - lens + - MonadRandom - text tests: