{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE NoImplicitPrelude #-}

module HWM.Integrations.Toolchain.Lib
  ( Library (..),
    updateDependencies,
    updateLibrary,
    updateLibraries,
    checkDependencies,
    checkLibrary,
    checkLibraries,
    BoundsDiff,
    Libraries,
  )
where

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson.KeyMap (delete)
# else
import Data.HashMap.Lazy (delete)
#endif
import Control.Monad.Except (catchError)
import Data.Aeson.Types
  ( FromJSON (..),
    GFromJSON,
    Object,
    Parser,
    ToJSON (..),
    Value (..),
    Zero,
    genericParseJSON,
    genericToJSON,
    withObject,
  )
import qualified Data.Map.Strict as Map
import GHC.Generics (Generic (..))
import HWM.Core.Common (Name)
import HWM.Core.Formatting (Format (..))
import HWM.Core.Pkg (PkgName)
import HWM.Core.Result (Issue (..), IssueDetails (..), MonadIssue (..), Severity (..))
import HWM.Domain.Bounds (Bounds)
import HWM.Domain.Config (getRule)
import HWM.Domain.ConfigT (ConfigT, config, pkgs)
import HWM.Domain.Dependencies (Dependencies, Dependency (..), fromDependencyList, toDependencyList)
import HWM.Runtime.Files (aesonYAMLOptions)
import Relude

type Libraries = Map Name Library

type BoundsDiff = (Text, PkgName, Bounds, Bounds)

data Library = Library
  { Library -> Text
sourceDirs :: Name,
    Library -> Maybe Dependencies
dependencies :: Maybe Dependencies,
    Library -> Maybe Object
__unknownFields :: Maybe Object
  }
  deriving
    ( Int -> Library -> ShowS
[Library] -> ShowS
Library -> String
(Int -> Library -> ShowS)
-> (Library -> String) -> ([Library] -> ShowS) -> Show Library
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Library -> ShowS
showsPrec :: Int -> Library -> ShowS
$cshow :: Library -> String
show :: Library -> String
$cshowList :: [Library] -> ShowS
showList :: [Library] -> ShowS
Show,
      (forall x. Library -> Rep Library x)
-> (forall x. Rep Library x -> Library) -> Generic Library
forall x. Rep Library x -> Library
forall x. Library -> Rep Library x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Library -> Rep Library x
from :: forall x. Library -> Rep Library x
$cto :: forall x. Rep Library x -> Library
to :: forall x. Rep Library x -> Library
Generic
    )

instance FromJSON Library where
  parseJSON :: Value -> Parser Library
parseJSON = (Library -> Maybe Object -> Library) -> Value -> Parser Library
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
(a -> Maybe Object -> a) -> Value -> Parser a
fromObject (\Library
t Maybe Object
o -> Library
t {__unknownFields = o})

instance ToJSON Library where
  toJSON :: Library -> Value
toJSON Library
t = Object -> Value
Object (Value -> Object
toObject (Options -> Library -> Value
forall a.
(Generic a, GToJSON' Value Zero (Rep a)) =>
Options -> a -> Value
genericToJSON Options
aesonYAMLOptions Library
t) Object -> Object -> Object
forall a. Semigroup a => a -> a -> a
<> Object -> Maybe Object -> Object
forall a. a -> Maybe a -> a
fromMaybe Object
forall a. Monoid a => a
mempty (Library -> Maybe Object
__unknownFields Library
t))

fromObject :: (Generic a, GFromJSON Zero (Rep a)) => (a -> Maybe Object -> a) -> Value -> Parser a
fromObject :: forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
(a -> Maybe Object -> a) -> Value -> Parser a
fromObject a -> Maybe Object -> a
f Value
v = do
  a
t <- Options -> Value -> Parser a
forall a.
(Generic a, GFromJSON Zero (Rep a)) =>
Options -> Value -> Parser a
genericParseJSON Options
aesonYAMLOptions Value
v
  Object
o <- String -> (Object -> Parser Object) -> Value -> Parser Object
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Lib" Object -> Parser Object
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
  a -> Parser a
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Maybe Object -> a
f a
t (Object -> Maybe Object
forall a. a -> Maybe a
Just Object
o))

toObject :: Value -> Object
toObject :: Value -> Object
toObject (Object Object
x) = Key -> Object -> Object
forall v. Key -> KeyMap v -> KeyMap v
delete Key
"__unknown-fields" Object
x
toObject Value
_ = Object
forall a. Monoid a => a
mempty

updateDependency :: PkgName -> ConfigT Bounds
updateDependency :: PkgName -> ConfigT Bounds
updateDependency PkgName
name = do
  Config
cfg <- (Env IO -> Config) -> ConfigT Config
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> Config
forall (m :: * -> *). Env m -> Config
config
  PkgRegistry
pkgs <- (Env IO -> PkgRegistry) -> ConfigT PkgRegistry
forall r (m :: * -> *) a. MonadReader r m => (r -> a) -> m a
asks Env IO -> PkgRegistry
forall (m :: * -> *). Env m -> PkgRegistry
pkgs
  PkgName -> PkgRegistry -> Config -> ConfigT Bounds
forall (m :: * -> *).
MonadError Issue m =>
PkgName -> PkgRegistry -> Config -> m Bounds
getRule PkgName
name PkgRegistry
pkgs Config
cfg

-- | Process dependencies with error handling - shared logic for both check and update
processDependencies :: Text -> Text -> FilePath -> Dependencies -> (Dependency -> Maybe Bounds -> Maybe a) -> ConfigT [a]
processDependencies :: forall a.
Text
-> Text
-> String
-> Dependencies
-> (Dependency -> Maybe Bounds -> Maybe a)
-> ConfigT [a]
processDependencies Text
memberId Text
scope String
path Dependencies
deps Dependency -> Maybe Bounds -> Maybe a
processor = [a] -> [(Text, Text, Text, Text)] -> [Dependency] -> ConfigT [a]
go [] [] (Dependencies -> [Dependency]
toDependencyList Dependencies
deps)
  where
    go :: [a] -> [(Text, Text, Text, Text)] -> [Dependency] -> ConfigT [a]
go [a]
results [(Text, Text, Text, Text)]
issues [] = do
      -- Inject accumulated dependency issues at the end
      Bool -> ConfigT () -> ConfigT ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([(Text, Text, Text, Text)] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Text, Text, Text, Text)]
issues)
        (ConfigT () -> ConfigT ()) -> ConfigT () -> ConfigT ()
forall a b. (a -> b) -> a -> b
$ Issue -> ConfigT ()
forall (m :: * -> *). MonadIssue m => Issue -> m ()
injectIssue
          Issue
            { issueTopic :: Text
issueTopic = Text
memberId,
              issueMessage :: Text
issueMessage = Int -> Text
forall b a. (Show a, IsString b) => a -> b
show ([(Text, Text, Text, Text)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Text, Text, Text, Text)]
issues) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" dependency issue(s) in " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
scope,
              issueSeverity :: Severity
issueSeverity = Severity
SeverityWarning,
              issueDetails :: Maybe IssueDetails
issueDetails =
                IssueDetails -> Maybe IssueDetails
forall a. a -> Maybe a
Just
                  DependencyIssue
                    { issueDependencies :: [(Text, Text, Text, Text)]
issueDependencies = [(Text, Text, Text, Text)]
issues,
                      issueFile :: String
issueFile = String
path
                    }
            }
      [a] -> ConfigT [a]
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a] -> [a]
forall a. [a] -> [a]
reverse [a]
results)
    go [a]
results [(Text, Text, Text, Text)]
issues (dep :: Dependency
dep@(Dependency PkgName
depName Bounds
depBounds) : [Dependency]
rest) = do
      Maybe Bounds
result <- ConfigT (Maybe Bounds)
-> (Issue -> ConfigT (Maybe Bounds)) -> ConfigT (Maybe Bounds)
forall a. ConfigT a -> (Issue -> ConfigT a) -> ConfigT a
forall e (m :: * -> *) a.
MonadError e m =>
m a -> (e -> m a) -> m a
catchError (Bounds -> Maybe Bounds
forall a. a -> Maybe a
Just (Bounds -> Maybe Bounds)
-> ConfigT Bounds -> ConfigT (Maybe Bounds)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgName -> ConfigT Bounds
updateDependency PkgName
depName) (\Issue
_ -> Maybe Bounds -> ConfigT (Maybe Bounds)
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Bounds
forall a. Maybe a
Nothing)
      let ([(Text, Text, Text, Text)]
newIssues, Maybe a
maybeItem) = case Maybe Bounds
result of
            Maybe Bounds
Nothing -> ((Text
scope, PkgName -> Text
forall a. Format a => a -> Text
format PkgName
depName, Bounds -> Text
forall a. Format a => a -> Text
format Bounds
depBounds, Text
"unknown") (Text, Text, Text, Text)
-> [(Text, Text, Text, Text)] -> [(Text, Text, Text, Text)]
forall a. a -> [a] -> [a]
: [(Text, Text, Text, Text)]
issues, Dependency -> Maybe Bounds -> Maybe a
processor Dependency
dep Maybe Bounds
forall a. Maybe a
Nothing)
            Just Bounds
expected -> ([(Text, Text, Text, Text)]
issues, Dependency -> Maybe Bounds -> Maybe a
processor Dependency
dep (Bounds -> Maybe Bounds
forall a. a -> Maybe a
Just Bounds
expected))
      case Maybe a
maybeItem of
        Maybe a
Nothing -> [a] -> [(Text, Text, Text, Text)] -> [Dependency] -> ConfigT [a]
go [a]
results [(Text, Text, Text, Text)]
newIssues [Dependency]
rest
        Just a
item -> [a] -> [(Text, Text, Text, Text)] -> [Dependency] -> ConfigT [a]
go (a
item a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
results) [(Text, Text, Text, Text)]
newIssues [Dependency]
rest

updateDependencies :: Text -> Text -> FilePath -> Dependencies -> ConfigT Dependencies
updateDependencies :: Text -> Text -> String -> Dependencies -> ConfigT Dependencies
updateDependencies Text
memberId Text
scope String
path Dependencies
deps = do
  [Dependency]
updated <- Text
-> Text
-> String
-> Dependencies
-> (Dependency -> Maybe Bounds -> Maybe Dependency)
-> ConfigT [Dependency]
forall a.
Text
-> Text
-> String
-> Dependencies
-> (Dependency -> Maybe Bounds -> Maybe a)
-> ConfigT [a]
processDependencies Text
memberId Text
scope String
path Dependencies
deps ((Dependency -> Maybe Bounds -> Maybe Dependency)
 -> ConfigT [Dependency])
-> (Dependency -> Maybe Bounds -> Maybe Dependency)
-> ConfigT [Dependency]
forall a b. (a -> b) -> a -> b
$ \(Dependency PkgName
depName Bounds
depBounds) Maybe Bounds
maybeExpected ->
    case Maybe Bounds
maybeExpected of
      Maybe Bounds
Nothing -> Dependency -> Maybe Dependency
forall a. a -> Maybe a
Just (PkgName -> Bounds -> Dependency
Dependency PkgName
depName Bounds
depBounds) -- Preserve original when lookup fails
      Just Bounds
expected -> Dependency -> Maybe Dependency
forall a. a -> Maybe a
Just (PkgName -> Bounds -> Dependency
Dependency PkgName
depName Bounds
expected)
  -- Return updated dependencies using fromDependencyList
  Dependencies -> ConfigT Dependencies
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Dependencies -> ConfigT Dependencies)
-> Dependencies -> ConfigT Dependencies
forall a b. (a -> b) -> a -> b
$ [Dependency] -> Dependencies
fromDependencyList [Dependency]
updated

checkDependencies :: Text -> Text -> FilePath -> Dependencies -> ConfigT [BoundsDiff]
checkDependencies :: Text -> Text -> String -> Dependencies -> ConfigT [BoundsDiff]
checkDependencies Text
memberId Text
scope String
path Dependencies
deps =
  Text
-> Text
-> String
-> Dependencies
-> (Dependency -> Maybe Bounds -> Maybe BoundsDiff)
-> ConfigT [BoundsDiff]
forall a.
Text
-> Text
-> String
-> Dependencies
-> (Dependency -> Maybe Bounds -> Maybe a)
-> ConfigT [a]
processDependencies Text
memberId Text
scope String
path Dependencies
deps ((Dependency -> Maybe Bounds -> Maybe BoundsDiff)
 -> ConfigT [BoundsDiff])
-> (Dependency -> Maybe Bounds -> Maybe BoundsDiff)
-> ConfigT [BoundsDiff]
forall a b. (a -> b) -> a -> b
$ \(Dependency PkgName
depName Bounds
depBounds) Maybe Bounds
maybeExpected ->
    case Maybe Bounds
maybeExpected of
      Maybe Bounds
Nothing -> Maybe BoundsDiff
forall a. Maybe a
Nothing -- Skip unknown dependencies in diff
      Just Bounds
expected ->
        if Bounds
depBounds Bounds -> Bounds -> Bool
forall a. Eq a => a -> a -> Bool
== Bounds
expected
          then Maybe BoundsDiff
forall a. Maybe a
Nothing
          else BoundsDiff -> Maybe BoundsDiff
forall a. a -> Maybe a
Just (Text
scope, PkgName
depName, Bounds
depBounds, Bounds
expected)

updateLibrary :: Text -> Text -> FilePath -> Library -> ConfigT Library
updateLibrary :: Text -> Text -> String -> Library -> ConfigT Library
updateLibrary Text
memberId Text
scope String
path Library {Maybe Object
Maybe Dependencies
Text
sourceDirs :: Library -> Text
dependencies :: Library -> Maybe Dependencies
__unknownFields :: Library -> Maybe Object
sourceDirs :: Text
dependencies :: Maybe Dependencies
__unknownFields :: Maybe Object
..} = do
  Maybe Dependencies
newDependencies <- (Dependencies -> ConfigT Dependencies)
-> Maybe Dependencies -> ConfigT (Maybe Dependencies)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Maybe a -> f (Maybe b)
traverse (Text -> Text -> String -> Dependencies -> ConfigT Dependencies
updateDependencies Text
memberId Text
scope String
path) Maybe Dependencies
dependencies
  Library -> ConfigT Library
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Library -> ConfigT Library) -> Library -> ConfigT Library
forall a b. (a -> b) -> a -> b
$ Library {dependencies :: Maybe Dependencies
dependencies = Maybe Dependencies
newDependencies, Maybe Object
Text
sourceDirs :: Text
__unknownFields :: Maybe Object
sourceDirs :: Text
__unknownFields :: Maybe Object
..}

checkLibrary :: Text -> Text -> FilePath -> Library -> ConfigT [BoundsDiff]
checkLibrary :: Text -> Text -> String -> Library -> ConfigT [BoundsDiff]
checkLibrary Text
_ Text
_ String
_ Library {dependencies :: Library -> Maybe Dependencies
dependencies = Maybe Dependencies
Nothing} = [BoundsDiff] -> ConfigT [BoundsDiff]
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
checkLibrary Text
memberId Text
scope String
path Library {dependencies :: Library -> Maybe Dependencies
dependencies = Just Dependencies
deps} =
  Text -> Text -> String -> Dependencies -> ConfigT [BoundsDiff]
checkDependencies Text
memberId Text
scope String
path Dependencies
deps

updateLibraries :: Text -> Text -> FilePath -> Maybe Libraries -> ConfigT (Maybe Libraries)
updateLibraries :: Text
-> Text -> String -> Maybe Libraries -> ConfigT (Maybe Libraries)
updateLibraries Text
_ Text
_ String
_ Maybe Libraries
Nothing = Maybe Libraries -> ConfigT (Maybe Libraries)
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe Libraries
forall a. Maybe a
Nothing
updateLibraries Text
memberId Text
scope String
path (Just Libraries
libs) = do
  [(Text, Library)]
updated <- ((Text, Library) -> ConfigT (Text, Library))
-> [(Text, Library)] -> ConfigT [(Text, Library)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (\(Text
name, Library
lib) -> (Text
name,) (Library -> (Text, Library))
-> ConfigT Library -> ConfigT (Text, Library)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> String -> Library -> ConfigT Library
updateLibrary Text
memberId (Text
scope Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) String
path Library
lib) (Libraries -> [(Text, Library)]
forall k a. Map k a -> [(k, a)]
Map.toList Libraries
libs)
  Maybe Libraries -> ConfigT (Maybe Libraries)
forall a. a -> ConfigT a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Libraries -> ConfigT (Maybe Libraries))
-> Maybe Libraries -> ConfigT (Maybe Libraries)
forall a b. (a -> b) -> a -> b
$ Libraries -> Maybe Libraries
forall a. a -> Maybe a
Just (Libraries -> Maybe Libraries) -> Libraries -> Maybe Libraries
forall a b. (a -> b) -> a -> b
$ [(Text, Library)] -> Libraries
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Library)]
updated

checkLibraries :: Text -> Text -> FilePath -> Libraries -> ConfigT [BoundsDiff]
checkLibraries :: Text -> Text -> String -> Libraries -> ConfigT [BoundsDiff]
checkLibraries Text
memberId Text
scope String
path Libraries
libs = [[BoundsDiff]] -> [BoundsDiff]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[BoundsDiff]] -> [BoundsDiff])
-> ConfigT [[BoundsDiff]] -> ConfigT [BoundsDiff]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Text, Library) -> ConfigT [BoundsDiff])
-> [(Text, Library)] -> ConfigT [[BoundsDiff]]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Text, Library) -> ConfigT [BoundsDiff]
step (Libraries -> [(Text, Library)]
forall k a. Map k a -> [(k, a)]
Map.toList Libraries
libs)
  where
    step :: (Text, Library) -> ConfigT [BoundsDiff]
step (Text
name, Library
lib) = Text -> Text -> String -> Library -> ConfigT [BoundsDiff]
checkLibrary Text
memberId (Text
scope Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name) String
path Library
lib