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
  { Location -> File
file :: File
  -- ^ The path of the file for which the annotation should be created
  , Location -> Maybe Position
position :: Maybe Position
  }

makeLensesFor
  [ ("file", "file")
  , ("position", "position")
  ]
  ''Location

instance IsString Location where
  fromString :: String -> Location
fromString = File -> Location
inFile (File -> Location) -> (String -> File) -> String -> Location
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. String -> File
forall a. IsString a => String -> a
fromString

instance AddToProperties Location where
  addToProperties :: Location -> Properties -> Properties
addToProperties Location
x =
    (Key -> Lens' Properties (Maybe Value)
forall a. HasProperties a => Key -> Lens' a (Maybe Value)
property Key
"file" ((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
?~ File -> Value
fileValue Location
x.file)
      (Properties -> Properties)
-> (Properties -> Properties) -> Properties -> Properties
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Properties -> Properties)
-> (Position -> Properties -> Properties)
-> Maybe Position
-> Properties
-> Properties
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Properties -> Properties
forall a. a -> a
forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Position -> Properties -> Properties
forall a. AddToProperties a => a -> Properties -> Properties
addToProperties Location
x.position

inFile :: File -> Location
inFile :: File -> Location
inFile File
x = Location {$sel:file:Location :: File
file = File
x, $sel:position:Location :: Maybe Position
position = Maybe Position
forall a. Maybe a
Nothing}

class HasLocationMaybe a where
  location :: Lens' a (Maybe Location)

instance HasLocationMaybe (Maybe Location) where
  location :: Lens' (Maybe Location) (Maybe Location)
location = (Maybe Location -> f (Maybe Location))
-> Maybe Location -> f (Maybe Location)
forall {k2} (a :: k2) k3 (p :: k2 -> k3 -> *) (f :: k2 -> k3).
p a (f a) -> p a (f a)
simple