github-workflow-commands (empty) → 0.0.0.0
raw patch · 32 files changed
+1404/−0 lines, 32 filesdep +basedep +bytestringdep +containers
Dependencies added: base, bytestring, containers, github-workflow-commands, hspec, hspec-junit-formatter, lens, markdown-unlit, text
Files
- CHANGELOG.md +5/−0
- LICENSE +21/−0
- README.lhs +64/−0
- README.md +64/−0
- github-workflow-commands.cabal +162/−0
- library/GitHub/Workflow/Command/Annotation.hs +76/−0
- library/GitHub/Workflow/Command/Annotation/Commands/Debug.hs +45/−0
- library/GitHub/Workflow/Command/Annotation/Commands/Error.hs +55/−0
- library/GitHub/Workflow/Command/Annotation/Commands/Generic.hs +42/−0
- library/GitHub/Workflow/Command/Annotation/Commands/Notice.hs +55/−0
- library/GitHub/Workflow/Command/Annotation/Commands/Warning.hs +55/−0
- library/GitHub/Workflow/Command/Annotation/File.hs +16/−0
- library/GitHub/Workflow/Command/Annotation/Location.hs +45/−0
- library/GitHub/Workflow/Command/Annotation/Position.hs +34/−0
- library/GitHub/Workflow/Command/Annotation/Position/Column.hs +23/−0
- library/GitHub/Workflow/Command/Annotation/Position/Columns.hs +32/−0
- library/GitHub/Workflow/Command/Annotation/Position/Extent.hs +18/−0
- library/GitHub/Workflow/Command/Annotation/Position/Line.hs +23/−0
- library/GitHub/Workflow/Command/Annotation/Properties.hs +49/−0
- library/GitHub/Workflow/Command/Syntax.hs +37/−0
- library/GitHub/Workflow/Command/Syntax/Command.hs +79/−0
- library/GitHub/Workflow/Command/Syntax/Key.hs +16/−0
- library/GitHub/Workflow/Command/Syntax/Message.hs +41/−0
- library/GitHub/Workflow/Command/Syntax/Name.hs +28/−0
- library/GitHub/Workflow/Command/Syntax/Properties.hs +56/−0
- library/GitHub/Workflow/Command/Syntax/ToByteString.hs +25/−0
- library/GitHub/Workflow/Command/Syntax/Value.hs +28/−0
- package.yaml +93/−0
- tests/GitHub/Workflow/Command/AnnotationSpec.hs +72/−0
- tests/GitHub/Workflow/Command/SyntaxSpec.hs +33/−0
- tests/Spec.hs +1/−0
- tests/SpecHook.hs +11/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+## [_Unreleased_](https://github.com/freckle/github-workflow-commands/compare/v0.0.0.0...main)++## [v0.0.0.0](https://github.com/freckle/github-workflow-commands/tree/v0.0.0.0)++First tagged release.
+ LICENSE view
@@ -0,0 +1,21 @@+The MIT License (MIT)++Copyright (c) 2024 Renaissance Learning Inc++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in all+copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE+SOFTWARE.
+ README.lhs view
@@ -0,0 +1,64 @@+# github-workflow-commands++For printing workflow commands in GitHub Actions.++See [Workflow commands for GitHub Actions](https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions).++The code herein is based on [GitHub Actions Toolkit](https://github.com/actions/toolkit/tree/main/packages/core/src).++---++<!--+```haskell+module Main (main) where++import Prelude++import Text.Markdown.Unlit ()+```+-->++```haskell+import qualified GitHub.Workflow.Command.Annotation as GH+import Control.Lens+```++An annotation is at minimum just a string.++```haskell+example1 :: IO ()+example1 =+ GH.printByteStringLn $+ GH.error "Something failed."+```++An annotation can also include a location.++```haskell+someLocation :: GH.Location+someLocation =+ GH.inFile "app.js"+ & GH.position ?~+ ( GH.atLine 13+ & GH.extent ?~ GH.ToLine 16+ )+```++```haskell+example2 :: IO ()+example2 =+ GH.printByteStringLn $+ GH.warning "Something seems amiss here."+ & GH.location ?~ someLocation+```++<!--+```haskell+main :: IO ()+main = example1 >> example2+```+-->++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ README.md view
@@ -0,0 +1,64 @@+# github-workflow-commands++For printing workflow commands in GitHub Actions.++See [Workflow commands for GitHub Actions](https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions).++The code herein is based on [GitHub Actions Toolkit](https://github.com/actions/toolkit/tree/main/packages/core/src).++---++<!--+```haskell+module Main (main) where++import Prelude++import Text.Markdown.Unlit ()+```+-->++```haskell+import qualified GitHub.Workflow.Command.Annotation as GH+import Control.Lens+```++An annotation is at minimum just a string.++```haskell+example1 :: IO ()+example1 =+ GH.printByteStringLn $+ GH.error "Something failed."+```++An annotation can also include a location.++```haskell+someLocation :: GH.Location+someLocation =+ GH.inFile "app.js"+ & GH.position ?~+ ( GH.atLine 13+ & GH.extent ?~ GH.ToLine 16+ )+```++```haskell+example2 :: IO ()+example2 =+ GH.printByteStringLn $+ GH.warning "Something seems amiss here."+ & GH.location ?~ someLocation+```++<!--+```haskell+main :: IO ()+main = example1 >> example2+```+-->++---++[CHANGELOG](./CHANGELOG.md) | [LICENSE](./LICENSE)
+ github-workflow-commands.cabal view
@@ -0,0 +1,162 @@+cabal-version: 1.18+name: github-workflow-commands+version: 0.0.0.0+license: MIT+license-file: LICENSE+maintainer: Freckle Education+homepage: https://github.com/freckle/github-workflow-commands#readme+bug-reports: https://github.com/freckle/github-workflow-commands/issues+synopsis: GitHub Actions workflow commands+description:+ For printing workflow commands in GitHub Actions.+ .+ See https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions++category: GitHub+build-type: Simple+extra-source-files: package.yaml+extra-doc-files:+ README.md+ CHANGELOG.md++source-repository head+ type: git+ location: https://github.com/freckle/github-workflow-commands++library+ exposed-modules:+ GitHub.Workflow.Command.Annotation+ GitHub.Workflow.Command.Annotation.Commands.Debug+ GitHub.Workflow.Command.Annotation.Commands.Error+ GitHub.Workflow.Command.Annotation.Commands.Generic+ GitHub.Workflow.Command.Annotation.Commands.Notice+ GitHub.Workflow.Command.Annotation.Commands.Warning+ GitHub.Workflow.Command.Annotation.File+ GitHub.Workflow.Command.Annotation.Location+ GitHub.Workflow.Command.Annotation.Position+ GitHub.Workflow.Command.Annotation.Position.Column+ GitHub.Workflow.Command.Annotation.Position.Columns+ GitHub.Workflow.Command.Annotation.Position.Extent+ GitHub.Workflow.Command.Annotation.Position.Line+ GitHub.Workflow.Command.Annotation.Properties+ GitHub.Workflow.Command.Syntax+ GitHub.Workflow.Command.Syntax.Command+ GitHub.Workflow.Command.Syntax.Key+ GitHub.Workflow.Command.Syntax.Message+ GitHub.Workflow.Command.Syntax.Name+ GitHub.Workflow.Command.Syntax.Properties+ GitHub.Workflow.Command.Syntax.ToByteString+ GitHub.Workflow.Command.Syntax.Value++ hs-source-dirs: library+ other-modules: Paths_github_workflow_commands+ default-language: GHC2021+ default-extensions:+ AllowAmbiguousTypes BlockArguments DataKinds DeriveAnyClass+ DerivingStrategies DerivingVia DuplicateRecordFields GADTs+ LambdaCase NoFieldSelectors NoImplicitPrelude+ NoMonomorphismRestriction NoPostfixOperators OverloadedRecordDot+ OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe++ build-depends:+ base >=4.16.4.0 && <5,+ bytestring >=0.11.4.0,+ containers >=0.6.5.1,+ lens >=5.1.1,+ text >=1.2.5.0++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++test-suite readme+ type: exitcode-stdio-1.0+ main-is: README.lhs+ other-modules: Paths_github_workflow_commands+ default-language: GHC2021+ default-extensions:+ AllowAmbiguousTypes BlockArguments DataKinds DeriveAnyClass+ DerivingStrategies DerivingVia DuplicateRecordFields GADTs+ LambdaCase NoFieldSelectors NoImplicitPrelude+ NoMonomorphismRestriction NoPostfixOperators OverloadedRecordDot+ OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -pgmL+ markdown-unlit++ build-depends:+ base >=4.16.4.0 && <5,+ github-workflow-commands,+ lens >=5.1.1,+ markdown-unlit >=0.5.1++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module++test-suite spec+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs: tests+ other-modules:+ GitHub.Workflow.Command.AnnotationSpec+ GitHub.Workflow.Command.SyntaxSpec+ SpecHook+ Paths_github_workflow_commands++ default-language: GHC2021+ default-extensions:+ AllowAmbiguousTypes BlockArguments DataKinds DeriveAnyClass+ DerivingStrategies DerivingVia DuplicateRecordFields GADTs+ LambdaCase NoFieldSelectors NoImplicitPrelude+ NoMonomorphismRestriction NoPostfixOperators OverloadedRecordDot+ OverloadedStrings QuasiQuotes TemplateHaskell TypeFamilies++ ghc-options:+ -fwrite-ide-info -Weverything -Wno-all-missed-specialisations+ -Wno-missed-specialisations -Wno-missing-exported-signatures+ -Wno-missing-import-lists -Wno-missing-local-signatures+ -Wno-monomorphism-restriction -Wno-safe -Wno-unsafe -threaded+ -rtsopts -with-rtsopts=-N++ build-depends:+ base >=4.16.4.0 && <5,+ github-workflow-commands,+ hspec >=2.11.9,+ hspec-junit-formatter >=1.1.2.1,+ lens >=5.1.1++ if impl(ghc >=9.8)+ ghc-options:+ -Wno-missing-poly-kind-signatures -Wno-missing-role-annotations++ if impl(ghc >=9.2)+ ghc-options: -Wno-missing-kind-signatures++ if impl(ghc >=8.10)+ ghc-options:+ -Wno-missing-safe-haskell-mode -Wno-prepositive-qualified-module
+ library/GitHub/Workflow/Command/Annotation.hs view
@@ -0,0 +1,76 @@+module GitHub.Workflow.Command.Annotation+ ( -- * Annotations++ -- ** Debug+ debug+ , Debug (..)++ -- ** Error+ , error+ , Error (..)++ -- ** Warning+ , warning+ , Warning (..)++ -- ** Notice+ , notice+ , Notice (..)++ -- * Message+ , Message (..)+ , FromMessage (..)++ -- * Properties+ , Properties (..)++ -- ** Location+ , Location (..)+ , HasLocationMaybe (..)++ -- ** File+ , File (..)+ , inFile+ , file++ -- ** Position+ , Position (..)+ , position+ , Extent (..)+ , extent+ , Columns (..)+ , line+ , startColumn+ , endColumn+ , Line (..)+ , atLine+ , Column (..)+ , atColumn++ -- * Output+ , ToCommand (..)+ , toCommand+ , ToByteString (..)+ , printByteStringLn+ ) 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.Annotation.Properties+import GitHub.Workflow.Command.Syntax+ ( FromMessage (..)+ , Message (..)+ , ToByteString (..)+ , ToCommand (..)+ , printByteStringLn+ , toCommand+ )
+ library/GitHub/Workflow/Command/Annotation/Commands/Debug.hs view
@@ -0,0 +1,45 @@+module GitHub.Workflow.Command.Annotation.Commands.Debug+ ( debug+ , Debug (..)+ ) where++import Control.Lens.TH+import GitHub.Workflow.Command.Annotation.Commands.Generic+import GitHub.Workflow.Command.Annotation.Properties+import GitHub.Workflow.Command.Annotation.Properties qualified as Properties+import GitHub.Workflow.Command.Syntax+ ( FromMessage+ , HasMessage+ , Message+ , ToByteString+ , ToCommand+ )+import GitHub.Workflow.Command.Syntax qualified as Syntax++newtype Debug = Debug+ { message :: Message+ }++makeLensesFor+ [ ("message", "debugMessage")+ ]+ ''Debug++deriving via GenericAnnotation Debug instance ToCommand Debug++deriving via GenericAnnotation Debug instance ToByteString Debug++instance IsAnnotationType Debug where+ annotationTypeName = "debug"++instance HasMessage Debug where+ message = debugMessage++instance FromMessage Debug where+ fromMessage = debug++instance GetProperties Debug where+ getProperties _ = Properties.empty++debug :: Message -> Debug+debug x = Debug {message = x}
+ library/GitHub/Workflow/Command/Annotation/Commands/Error.hs view
@@ -0,0 +1,55 @@+module GitHub.Workflow.Command.Annotation.Commands.Error+ ( error+ , Error (..)+ ) where++import Control.Category+import Control.Lens.TH+import GitHub.Workflow.Command.Annotation.Commands.Generic+import GitHub.Workflow.Command.Annotation.Location+import GitHub.Workflow.Command.Annotation.Properties+import GitHub.Workflow.Command.Annotation.Properties qualified as Properties+import GitHub.Workflow.Command.Syntax+ ( FromMessage+ , HasMessage+ , Message+ , ToByteString+ , ToCommand+ )+import GitHub.Workflow.Command.Syntax qualified as Syntax++data Error = Error+ { message :: Message+ , properties :: Properties+ }++makeLensesFor+ [ ("message", "errorMessage")+ , ("properties", "errorProperties")+ ]+ ''Error++deriving via GenericAnnotation Error instance ToCommand Error++deriving via GenericAnnotation Error instance ToByteString Error++instance IsAnnotationType Error where+ annotationTypeName = "error"++instance HasMessage Error where+ message = errorMessage++instance HasProperties Error where+ annotationProperties = errorProperties++instance HasLocationMaybe Error where+ location = annotationProperties . location++instance FromMessage Error where+ fromMessage = error++instance GetProperties Error where+ getProperties = (.properties)++error :: Message -> Error+error x = Error {message = x, properties = Properties.empty}
+ library/GitHub/Workflow/Command/Annotation/Commands/Generic.hs view
@@ -0,0 +1,42 @@+module GitHub.Workflow.Command.Annotation.Commands.Generic+ ( GenericAnnotation (..)+ , IsAnnotationType (..)+ ) where++import Control.Category+import Control.Lens (Iso', coerced, over, (.~), (^.))+import GitHub.Workflow.Command.Annotation.Location+import GitHub.Workflow.Command.Annotation.Properties+import GitHub.Workflow.Command.Syntax+ ( ByteStringViaCommand+ , HasMessage+ , Name+ , ToByteString+ , ToCommand+ )+import GitHub.Workflow.Command.Syntax qualified as Syntax++class IsAnnotationType a where+ annotationTypeName :: Name++newtype GenericAnnotation a = GenericAnnotation a++unwrapped :: Iso' (GenericAnnotation a) a+unwrapped = coerced++deriving via+ (ByteStringViaCommand a)+ instance+ ToCommand a => ToByteString (GenericAnnotation a)++instance+ (IsAnnotationType a, HasMessage a, GetProperties a)+ => ToCommand (GenericAnnotation a)+ where+ addToCommand x =+ (Syntax.name .~ annotationTypeName @a)+ . (Syntax.message .~ (x ^. (unwrapped . Syntax.message)))+ . over Syntax.properties (Syntax.addToProperties (getProperties (x ^. unwrapped)))++instance HasProperties a => HasLocationMaybe (GenericAnnotation a) where+ location = unwrapped . annotationProperties . location
+ library/GitHub/Workflow/Command/Annotation/Commands/Notice.hs view
@@ -0,0 +1,55 @@+module GitHub.Workflow.Command.Annotation.Commands.Notice+ ( notice+ , Notice (..)+ ) where++import Control.Category+import Control.Lens.TH+import GitHub.Workflow.Command.Annotation.Commands.Generic+import GitHub.Workflow.Command.Annotation.Location+import GitHub.Workflow.Command.Annotation.Properties+import GitHub.Workflow.Command.Annotation.Properties qualified as Properties+import GitHub.Workflow.Command.Syntax+ ( FromMessage+ , HasMessage+ , Message+ , ToByteString+ , ToCommand+ )+import GitHub.Workflow.Command.Syntax qualified as Syntax++data Notice = Notice+ { message :: Message+ , properties :: Properties+ }++makeLensesFor+ [ ("message", "noticeMessage")+ , ("properties", "noticeProperties")+ ]+ ''Notice++deriving via GenericAnnotation Notice instance ToCommand Notice++deriving via GenericAnnotation Notice instance ToByteString Notice++instance IsAnnotationType Notice where+ annotationTypeName = "notice"++instance HasMessage Notice where+ message = noticeMessage++instance HasProperties Notice where+ annotationProperties = noticeProperties++instance HasLocationMaybe Notice where+ location = annotationProperties . location++instance GetProperties Notice where+ getProperties = (.properties)++instance FromMessage Notice where+ fromMessage = notice++notice :: Message -> Notice+notice x = Notice {message = x, properties = Properties.empty}
+ library/GitHub/Workflow/Command/Annotation/Commands/Warning.hs view
@@ -0,0 +1,55 @@+module GitHub.Workflow.Command.Annotation.Commands.Warning+ ( warning+ , Warning (..)+ ) where++import Control.Category+import Control.Lens.TH+import GitHub.Workflow.Command.Annotation.Commands.Generic+import GitHub.Workflow.Command.Annotation.Location+import GitHub.Workflow.Command.Annotation.Properties+import GitHub.Workflow.Command.Annotation.Properties qualified as Properties+import GitHub.Workflow.Command.Syntax+ ( FromMessage+ , HasMessage+ , Message+ , ToByteString+ , ToCommand+ )+import GitHub.Workflow.Command.Syntax qualified as Syntax++data Warning = Warning+ { message :: Message+ , properties :: Properties+ }++makeLensesFor+ [ ("message", "warningMessage")+ , ("properties", "warningProperties")+ ]+ ''Warning++deriving via GenericAnnotation Warning instance ToCommand Warning++deriving via GenericAnnotation Warning instance ToByteString Warning++instance IsAnnotationType Warning where+ annotationTypeName = "warning"++instance HasMessage Warning where+ message = warningMessage++instance HasProperties Warning where+ annotationProperties = warningProperties++instance HasLocationMaybe Warning where+ location = annotationProperties . location++instance FromMessage Warning where+ fromMessage = warning++instance GetProperties Warning where+ getProperties = (.properties)++warning :: Message -> Warning+warning x = Warning {message = x, properties = Properties.empty}
+ library/GitHub/Workflow/Command/Annotation/File.hs view
@@ -0,0 +1,16 @@+module GitHub.Workflow.Command.Annotation.File+ ( File (..)+ , fileValue+ ) where++import Control.Category+import Data.String (IsString)+import Data.Text (Text)+import GitHub.Workflow.Command.Syntax (Value (..))+import Prelude (Eq, Ord, Show)++newtype File = File {text :: Text}+ deriving newtype (Eq, Ord, Show, IsString)++fileValue :: File -> Value+fileValue = Value . (.text)
+ library/GitHub/Workflow/Command/Annotation/Location.hs view
@@ -0,0 +1,45 @@+module GitHub.Workflow.Command.Annotation.Location+ ( Location (..)+ , HasLocationMaybe (..)+ , file+ , position+ , inFile+ ) where++import Control.Category+import Control.Lens (Lens', simple, (?~))+import Control.Lens.TH+import Data.Maybe (Maybe (..), maybe)+import Data.String (IsString (..))+import GitHub.Workflow.Command.Annotation.File+import GitHub.Workflow.Command.Annotation.Position+import GitHub.Workflow.Command.Syntax (AddToProperties (..), property)++data Location = Location+ { file :: File+ -- ^ The path of the file for which the annotation should be created+ , position :: Maybe Position+ }++makeLensesFor+ [ ("file", "file")+ , ("position", "position")+ ]+ ''Location++instance IsString Location where+ fromString = inFile . fromString++instance AddToProperties Location where+ addToProperties x =+ (property "file" ?~ fileValue x.file)+ . maybe id addToProperties x.position++inFile :: File -> Location+inFile x = Location {file = x, position = Nothing}++class HasLocationMaybe a where+ location :: Lens' a (Maybe Location)++instance HasLocationMaybe (Maybe Location) where+ location = simple
+ library/GitHub/Workflow/Command/Annotation/Position.hs view
@@ -0,0 +1,34 @@+module GitHub.Workflow.Command.Annotation.Position+ ( Position (..)+ , line+ , extent+ , atLine+ ) where++import Control.Category+import Control.Lens ((?~))+import Control.Lens.TH+import Data.Maybe (Maybe (..), maybe)+import GitHub.Workflow.Command.Annotation.Position.Extent+import GitHub.Workflow.Command.Annotation.Position.Line+import GitHub.Workflow.Command.Syntax (AddToProperties (..), property)++-- | Where an annotation is marked within a file+data Position = Position+ { line :: Line+ , extent :: Maybe Extent+ }++makeLensesFor+ [ ("line", "line")+ , ("extent", "extent")+ ]+ ''Position++instance AddToProperties Position where+ addToProperties x =+ (property "line" ?~ lineValue x.line)+ . maybe id addToProperties x.extent++atLine :: Line -> Position+atLine x = Position {line = x, extent = Nothing}
+ library/GitHub/Workflow/Command/Annotation/Position/Column.hs view
@@ -0,0 +1,23 @@+module GitHub.Workflow.Command.Annotation.Position.Column+ ( Column (..)+ , columnText+ , columnValue+ ) where++import Control.Category+import Data.Text (Text)+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB+import Data.Text.Lazy.Builder.Int qualified as TL+import GitHub.Workflow.Command.Syntax (Value (..))+import Numeric.Natural+import Prelude (Eq, Num, Ord, Show)++newtype Column = Column {natural :: Natural}+ deriving newtype (Eq, Ord, Show, Num)++columnText :: Column -> Text+columnText = TL.toStrict . TB.toLazyText . TL.decimal . (.natural)++columnValue :: Column -> Value+columnValue = Value . columnText
+ library/GitHub/Workflow/Command/Annotation/Position/Columns.hs view
@@ -0,0 +1,32 @@+module GitHub.Workflow.Command.Annotation.Position.Columns+ ( Columns (..)+ , atColumn+ , startColumn+ , endColumn+ ) where++import Control.Category+import Control.Lens ((?~))+import Control.Lens.TH+import Data.Maybe (Maybe (..), maybe)+import GitHub.Workflow.Command.Annotation.Position.Column+import GitHub.Workflow.Command.Syntax (AddToProperties (..), property)++data Columns = Columns+ { start :: Column+ , end :: Maybe Column+ }++makeLensesFor+ [ ("start", "startColumn")+ , ("end", "endColumn")+ ]+ ''Columns++instance AddToProperties Columns where+ addToProperties x =+ (property "col" ?~ columnValue x.start)+ . maybe id (\y -> property "endColumn" ?~ columnValue y) x.end++atColumn :: Column -> Columns+atColumn x = Columns {start = x, end = Nothing}
+ library/GitHub/Workflow/Command/Annotation/Position/Extent.hs view
@@ -0,0 +1,18 @@+module GitHub.Workflow.Command.Annotation.Position.Extent+ ( Extent (..)+ ) where++import Control.Lens ((?~))+import GitHub.Workflow.Command.Annotation.Position.Columns+import GitHub.Workflow.Command.Annotation.Position.Line+import GitHub.Workflow.Command.Syntax (AddToProperties (..), property)++-- | Extra positional data, as a modification to the start 'Line'+data Extent+ = WithinLine Columns+ | ToLine Line++instance AddToProperties Extent where+ addToProperties = \case+ WithinLine x -> addToProperties x+ ToLine x -> property "endLine" ?~ lineValue x
+ library/GitHub/Workflow/Command/Annotation/Position/Line.hs view
@@ -0,0 +1,23 @@+module GitHub.Workflow.Command.Annotation.Position.Line+ ( Line (..)+ , lineText+ , lineValue+ ) where++import Control.Category+import Data.Text (Text)+import Data.Text.Lazy qualified as TL+import Data.Text.Lazy.Builder qualified as TB+import Data.Text.Lazy.Builder.Int qualified as TL+import GitHub.Workflow.Command.Syntax (Value (..))+import Numeric.Natural+import Prelude (Eq, Num, Ord, Show)++newtype Line = Line {natural :: Natural}+ deriving newtype (Eq, Ord, Show, Num)++lineText :: Line -> Text+lineText = TL.toStrict . TB.toLazyText . TL.decimal . (.natural)++lineValue :: Line -> Value+lineValue = Value . lineText
+ library/GitHub/Workflow/Command/Annotation/Properties.hs view
@@ -0,0 +1,49 @@+module GitHub.Workflow.Command.Annotation.Properties+ ( Properties (..)+ , HasProperties (..)+ , GetProperties (..)+ , empty+ ) where++import Control.Category+import Control.Lens (Lens', simple, (?~))+import Control.Lens.TH+import Data.Maybe (Maybe (..), maybe)+import Data.Text (Text)+import GitHub.Workflow.Command.Annotation.Location+import GitHub.Workflow.Command.Syntax (Value (..))+import GitHub.Workflow.Command.Syntax qualified as Syntax++data Properties = Properties+ { title :: Maybe Text+ -- ^ A title for the annotation+ , location :: Maybe Location+ }++makeLensesFor+ [ ("location", "propertiesLocation")+ ]+ ''Properties++instance HasLocationMaybe Properties where+ location = propertiesLocation++instance Syntax.AddToProperties Properties where+ addToProperties x =+ maybe id (\t -> Syntax.property "title" ?~ Value t) x.title+ . maybe id Syntax.addToProperties x.location++class HasProperties a where+ annotationProperties :: Lens' a Properties++instance HasProperties Properties where+ annotationProperties = simple++class GetProperties a where+ getProperties :: a -> Properties++instance GetProperties Properties where+ getProperties = id++empty :: Properties+empty = Properties Nothing Nothing
+ library/GitHub/Workflow/Command/Syntax.hs view
@@ -0,0 +1,37 @@+module GitHub.Workflow.Command.Syntax+ ( -- * Command+ Command+ , command+ , ToCommand (..)+ , toCommand++ -- * Name+ , Name (..)+ , HasName (..)++ -- * Message+ , Message (..)+ , HasMessage (..)+ , FromMessage (..)++ -- * Properties+ , Properties+ , Key (..)+ , Value (..)+ , property+ , HasProperties (..)+ , AddToProperties (..)++ -- * Output+ , ToByteString (..)+ , ByteStringViaCommand (..)+ , printByteStringLn+ ) where++import GitHub.Workflow.Command.Syntax.Command+import GitHub.Workflow.Command.Syntax.Key+import GitHub.Workflow.Command.Syntax.Message+import GitHub.Workflow.Command.Syntax.Name+import GitHub.Workflow.Command.Syntax.Properties+import GitHub.Workflow.Command.Syntax.ToByteString+import GitHub.Workflow.Command.Syntax.Value
+ library/GitHub/Workflow/Command/Syntax/Command.hs view
@@ -0,0 +1,79 @@+module GitHub.Workflow.Command.Syntax.Command+ ( Command+ , command+ , ToCommand (..)+ , toCommand+ , ByteStringViaCommand (..)+ ) where++import Control.Category+import Control.Lens (lens)+import Control.Monad (mfilter)+import Data.Foldable (foldMap)+import Data.Maybe (Maybe)+import Data.String (IsString (fromString))+import GitHub.Workflow.Command.Syntax.Message+import GitHub.Workflow.Command.Syntax.Name+import GitHub.Workflow.Command.Syntax.Properties+import GitHub.Workflow.Command.Syntax.Properties qualified as Properties+import GitHub.Workflow.Command.Syntax.ToByteString+import Prelude (Eq, Maybe (..), Ord, Show, not, (<>))++data Command = Command+ { name :: Name+ , properties :: Properties+ , message :: Message+ }+ deriving stock (Eq, Ord, Show)++instance IsString Command where+ fromString = command . fromString++instance HasName Command where+ name = lens+ (.name)+ \x y -> x {name = y}++instance HasMessage Command where+ message = lens+ (.message)+ \x y -> x {message = y}++instance HasProperties Command where+ properties = lens+ (.properties)+ \x y -> x {properties = y}++-- | Construct a minimal command with a command 'Name' e.g. "warning" or "error"+--+-- See the 'GitHub.Workflow.Command.Syntax.Properties.property' and+-- 'GitHub.Workflow.Command.Syntax.Message.message' lenses for other+-- information include in a command.+command :: Name -> Command+command x =+ Command+ { name = x+ , properties = Properties.empty+ , message = ""+ }++instance ToByteString Command where+ toByteStringBuilder x =+ "::"+ <> toByteStringBuilder x.name+ <> foldMap @Maybe+ (\p -> " " <> toByteStringBuilder p)+ (mfilter (not . Properties.null) (Just x.properties))+ <> "::"+ <> toByteStringBuilder x.message++class ToCommand a where+ addToCommand :: a -> Command -> Command++toCommand :: ToCommand a => a -> Command+toCommand x = addToCommand x (command "")++newtype ByteStringViaCommand a = ByteStringViaCommand a++instance ToCommand a => ToByteString (ByteStringViaCommand a) where+ toByteStringBuilder = toByteStringBuilder . toCommand . (\(ByteStringViaCommand x) -> x)
+ library/GitHub/Workflow/Command/Syntax/Key.hs view
@@ -0,0 +1,16 @@+module GitHub.Workflow.Command.Syntax.Key+ ( Key (..)+ ) where++import Control.Category+import Data.String (IsString)+import Data.Text (Text)+import Data.Text.Encoding qualified as T+import GitHub.Workflow.Command.Syntax.ToByteString+import Prelude (Eq, Ord, Show)++newtype Key = Key {text :: Text}+ deriving newtype (Eq, Ord, Show, IsString)++instance ToByteString Key where+ toByteStringBuilder = T.encodeUtf8Builder . (.text)
+ library/GitHub/Workflow/Command/Syntax/Message.hs view
@@ -0,0 +1,41 @@+module GitHub.Workflow.Command.Syntax.Message+ ( Message (..)+ , HasMessage (..)+ , FromMessage (..)+ ) where++import Control.Category+import Control.Lens (Lens', simple)+import Data.String (IsString)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import GitHub.Workflow.Command.Syntax.ToByteString+import Prelude (Eq, Ord, Show)++newtype Message = Message {text :: Text}+ deriving newtype (Eq, Ord, Show, IsString)++instance ToByteString Message where+ toByteStringBuilder =+ T.encodeUtf8Builder+ . T.concatMap+ ( \case+ '%' -> "%25"+ '\r' -> "%0D"+ '\n' -> "%0A"+ x -> T.singleton x+ )+ . (.text)++class HasMessage a where+ message :: Lens' a Message++instance HasMessage Message where+ message = simple++class FromMessage a where+ fromMessage :: Message -> a++instance FromMessage Message where+ fromMessage = id
+ library/GitHub/Workflow/Command/Syntax/Name.hs view
@@ -0,0 +1,28 @@+module GitHub.Workflow.Command.Syntax.Name+ ( Name (..)+ , HasName (..)+ ) where++import Control.Category+import Control.Lens (Lens', simple)+import Data.String (IsString)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import GitHub.Workflow.Command.Syntax.ToByteString+import Prelude (Eq, Ord, Show)++newtype Name = Name {text :: Text}+ deriving newtype (Eq, Ord, Show, IsString)++instance ToByteString Name where+ toByteStringBuilder =+ T.encodeUtf8Builder+ . (\x -> if T.null x then "missing.command" else x)+ . (.text)++class HasName a where+ name :: Lens' a Name++instance HasName Name where+ name = simple
+ library/GitHub/Workflow/Command/Syntax/Properties.hs view
@@ -0,0 +1,56 @@+module GitHub.Workflow.Command.Syntax.Properties+ ( Properties+ , HasProperties (..)+ , AddToProperties (..)+ , property+ , empty+ , null+ ) where++import Control.Category+import Control.Lens (Lens', at, iso, simple)+import Data.Foldable (fold)+import Data.Functor+import Data.List qualified as List+import Data.Map.Strict (Map)+import Data.Map.Strict qualified as Map+import Data.Maybe (Maybe (..))+import Data.Semigroup+import GitHub.Workflow.Command.Syntax.Key (Key)+import GitHub.Workflow.Command.Syntax.ToByteString+import GitHub.Workflow.Command.Syntax.Value (Value)+import Prelude (Bool, Eq, Ord, Show)++newtype Properties = Properties {map :: Map Key Value}+ deriving stock (Eq, Ord, Show)++empty :: Properties+empty = Properties Map.empty++null :: Properties -> Bool+null = Map.null . (.map)++instance ToByteString Properties where+ toByteStringBuilder =+ fold+ . List.intersperse ","+ . fmap+ ( \(key, value) ->+ toByteStringBuilder key+ <> "="+ <> toByteStringBuilder value+ )+ . Map.toAscList+ . (.map)++class HasProperties a where+ properties :: Lens' a Properties++instance HasProperties Properties where+ properties = simple++property :: HasProperties a => Key -> Lens' a (Maybe Value)+property k = properties . iso (.map) Properties . at k++class AddToProperties a where+ addToProperties :: a -> Properties -> Properties
+ library/GitHub/Workflow/Command/Syntax/ToByteString.hs view
@@ -0,0 +1,25 @@+module GitHub.Workflow.Command.Syntax.ToByteString+ ( ToByteString (..)+ , printByteStringLn+ ) where++import Control.Category+import Control.Monad.IO.Class (MonadIO, liftIO)+import Data.ByteString+import Data.ByteString.Builder qualified as BSB+import Data.ByteString.Lazy qualified as BSL+import Data.Semigroup ((<>))+import System.IO (stdout)++class ToByteString a where+ toByteStringBuilder :: a -> BSB.Builder++ toByteString :: a -> ByteString+ toByteString = BSL.toStrict . BSB.toLazyByteString . toByteStringBuilder++printByteStringLn :: (ToByteString a, MonadIO m) => a -> m ()+printByteStringLn =+ liftIO+ . BSB.hPutBuilder stdout+ . (<> BSB.char7 '\n')+ . toByteStringBuilder
+ library/GitHub/Workflow/Command/Syntax/Value.hs view
@@ -0,0 +1,28 @@+module GitHub.Workflow.Command.Syntax.Value+ ( Value (..)+ ) where++import Control.Category+import Data.String (IsString)+import Data.Text (Text)+import Data.Text qualified as T+import Data.Text.Encoding qualified as T+import GitHub.Workflow.Command.Syntax.ToByteString+import Prelude (Eq, Ord, Show)++newtype Value = Value {text :: Text}+ deriving newtype (Eq, Ord, Show, IsString)++instance ToByteString Value where+ toByteStringBuilder =+ T.encodeUtf8Builder+ . T.concatMap+ ( \case+ '%' -> "%25"+ '\r' -> "%0D"+ '\n' -> "%0A"+ ':' -> "%3A"+ ',' -> "%2C"+ x -> T.singleton x+ )+ . (.text)
+ package.yaml view
@@ -0,0 +1,93 @@+name: github-workflow-commands+version: 0.0.0.0+maintainer: Freckle Education+category: GitHub+github: freckle/github-workflow-commands+synopsis: GitHub Actions workflow commands+description: |+ For printing workflow commands in GitHub Actions.++ See https://docs.github.com/en/actions/using-workflows/workflow-commands-for-github-actions++extra-doc-files:+ - README.md+ - CHANGELOG.md++extra-source-files:+ - package.yaml++ghc-options:+ - -fwrite-ide-info+ - -Weverything+ - -Wno-all-missed-specialisations+ - -Wno-missed-specialisations+ - -Wno-missing-exported-signatures+ - -Wno-missing-import-lists+ - -Wno-missing-local-signatures+ - -Wno-monomorphism-restriction+ - -Wno-safe+ - -Wno-unsafe++when:+ - condition: "impl(ghc >= 9.8)"+ ghc-options:+ - -Wno-missing-poly-kind-signatures+ - -Wno-missing-role-annotations+ - condition: "impl(ghc >= 9.2)"+ ghc-options:+ - -Wno-missing-kind-signatures+ - condition: "impl(ghc >= 8.10)"+ ghc-options:+ - -Wno-missing-safe-haskell-mode+ - -Wno-prepositive-qualified-module++dependencies:+ - base < 5++language: GHC2021++default-extensions:+ - AllowAmbiguousTypes+ - BlockArguments+ - DataKinds+ - DeriveAnyClass+ - DerivingStrategies+ - DerivingVia+ - DuplicateRecordFields+ - GADTs+ - LambdaCase+ - NoFieldSelectors+ - NoImplicitPrelude+ - NoMonomorphismRestriction+ - NoPostfixOperators+ - OverloadedRecordDot+ - OverloadedStrings+ - QuasiQuotes+ - TemplateHaskell+ - TypeFamilies++library:+ source-dirs: library+ dependencies:+ - bytestring+ - containers+ - lens+ - text++tests:+ spec:+ main: Spec.hs+ source-dirs: tests+ ghc-options: -threaded -rtsopts "-with-rtsopts=-N"+ dependencies:+ - github-workflow-commands+ - hspec+ - hspec-junit-formatter+ - lens+ readme:+ main: README.lhs+ ghc-options: -pgmL markdown-unlit+ dependencies:+ - github-workflow-commands+ - lens+ - markdown-unlit
+ tests/GitHub/Workflow/Command/AnnotationSpec.hs view
@@ -0,0 +1,72 @@+module GitHub.Workflow.Command.AnnotationSpec+ ( spec+ ) where++import Control.Lens ((?~))+import Data.Function (($), (&))+import GitHub.Workflow.Command.Annotation+import Test.Hspec++spec :: Spec+spec =+ context "Annotation" do+ context "with no properties" do+ specify "" $+ toByteString (debug "Set the Octocat variable")+ `shouldBe` "::debug::Set the Octocat variable"++ specify "" $+ toByteString (error "Missing semicolon")+ `shouldBe` "::error::Missing semicolon"++ context "with file" do+ specify "" $+ toByteString (error "Missing semicolon" & location ?~ "app.js")+ `shouldBe` "::error file=app.js::Missing semicolon"++ context "with line number" do+ specify "" $+ toByteString+ ( error "Missing semicolon"+ & location ?~ (inFile "app.js" & position ?~ atLine 1)+ )+ `shouldBe` "::error file=app.js,line=1::Missing semicolon"++ context "with column" do+ specify "" $+ toByteString+ ( error "Missing semicolon"+ & location+ ?~ (inFile "app.js" & position ?~ (atLine 7 & extent ?~ WithinLine (atColumn 64)))+ )+ `shouldBe` "::error col=64,file=app.js,line=7::Missing semicolon"++ context "with column range" do+ specify "" $+ toByteString+ ( notice "Missing semicolon"+ & location+ ?~ ( inFile "app.js"+ & position ?~ (atLine 1 & extent ?~ WithinLine (atColumn 5 & endColumn ?~ 7))+ )+ )+ `shouldBe` "::notice col=5,endColumn=7,file=app.js,line=1::Missing semicolon"++ specify "" $+ toByteString+ ( warning+ "Missing semicolon"+ & location+ ?~ ( inFile "app.js"+ & position ?~ (atLine 1 & extent ?~ WithinLine (atColumn 15 & endColumn ?~ 32))+ )+ )+ `shouldBe` "::warning col=15,endColumn=32,file=app.js,line=1::Missing semicolon"++ context "with line range" do+ it "" $+ toByteString+ ( warning "Missing semicolon"+ & location ?~ (inFile "app.js" & position ?~ (atLine 13 & extent ?~ ToLine 16))+ )+ `shouldBe` "::warning endLine=16,file=app.js,line=13::Missing semicolon"
+ tests/GitHub/Workflow/Command/SyntaxSpec.hs view
@@ -0,0 +1,33 @@+module GitHub.Workflow.Command.SyntaxSpec+ ( spec+ ) where++import Control.Lens ((.~), (?~))+import Data.Function (($), (&))+import GitHub.Workflow.Command.Syntax+import Test.Hspec++spec :: Spec+spec =+ context "Syntax" do+ specify "empty command name" $+ toByteString (command "") `shouldBe` "::missing.command::"++ specify "endgroup" $+ toByteString (command "endgroup") `shouldBe` "::endgroup::"++ specify "error" $+ toByteString+ ( command "error"+ & message .~ "Missing semicolon"+ & property "file" ?~ "app.js"+ & property "line" ?~ "1"+ )+ `shouldBe` "::error file=app.js,line=1::Missing semicolon"++ specify "debug" $+ toByteString+ ( command "debug"+ & message .~ "Set the Octocat variable"+ )+ `shouldBe` "::debug::Set the Octocat variable"
+ tests/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ tests/SpecHook.hs view
@@ -0,0 +1,11 @@+module SpecHook+ ( hook+ ) where++import Prelude++import Test.Hspec+import Test.Hspec.JUnit.Formatter.Env as Formatter++hook :: Spec -> Spec+hook = Formatter.whenEnabled Formatter.add . parallel