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 :: Extent -> Properties -> Properties
addToProperties = \case
    WithinLine Columns
x -> Columns -> Properties -> Properties
forall a. AddToProperties a => a -> Properties -> Properties
addToProperties Columns
x
    ToLine Line
x -> Key -> Lens' Properties (Maybe Value)
forall a. HasProperties a => Key -> Lens' a (Maybe Value)
property Key
"endLine" ((Maybe Value -> Identity (Maybe Value))
 -> Properties -> Identity Properties)
-> Value -> Properties -> Properties
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Line -> Value
lineValue Line
x