-- Copyright 2020 Google LLC
--
-- Licensed under the Apache License, Version 2.0 (the "License");
-- you may not use this file except in compliance with the License.
-- You may obtain a copy of the License at
--
--      http://www.apache.org/licenses/LICENSE-2.0
--
-- Unless required by applicable law or agreed to in writing, software
-- distributed under the License is distributed on an "AS IS" BASIS,
-- WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-- See the License for the specific language governing permissions and
-- limitations under the License.

{-# LANGUAGE OverloadedStrings #-}
-- | Code to make sure every version-specific third-party Haskell package in
--   Google3 has a properly configured version-agnostic package.
--
--   TODO(georgevdd): Merge this and cabal2build into a single third-party
--   code maintenance tool.
module Google.Google3.Tools.Cabal2Build.VersionAgnosticThirdParty
    ( createOrUpdateWrapperPackage
    ) where

import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as Text
import System.FilePath ((</>))
import System.Process (readProcess)

import qualified Google.Google3.Name as Google3
import qualified Google.Google3.Package as Google3
import qualified Google.Google3.Buildifier as Buildifier
import qualified Google.Google3.VCSClient as VCSClient


blazeQuery :: Google3.PackageName -> IO Text
blazeQuery package =
    Text.pack <$> readProcess "blaze" [
             "query", "--noshow_loading_progress", "--noannounce_rc",
             "attr(tags, 'haskell-exposed', " ++ targets ++ ")",
             "--output=label_kind"] ""
  where
    targets = show (Google3.Label package $ Google3.TargetName "all")

ruleKinds :: Google3.PackageName -> IO [(Google3.Label, Google3.RuleClass)]
ruleKinds = fmap parse . blazeQuery
  where parse = mapMaybe (collect . Text.words) . Text.lines
        collect [kind, "rule", label] = Just (Google3.parseLabel label, kind)
        collect _ = Nothing

unversionedPackageName :: Google3.PackageName -> Google3.PackageName
unversionedPackageName (Google3.PackageName package) =
    Google3.PackageName (init package)

haskellBinary, haskellLibrary, filegroup, shBinary :: Text
haskellBinary = "haskell_binary"
haskellLibrary = "haskell_library"
filegroup = "filegroup"
shBinary = "sh_binary"

wrapperRule :: Google3.Label -> Google3.RuleClass -> Maybe Google3.Rule
wrapperRule label@(Google3.Label _ target) kind
    | kind == haskellBinary
        = Just (rule shBinary)
            { Google3.ruleSrcs = [Google3.LabelSource label] }
    | kind == haskellLibrary
        =  Just (rule haskellLibrary)
            { Google3.ruleDeps = [Google3.Labelled label] }
    | kind == filegroup
        = Just (rule filegroup)
            { Google3.ruleSrcs = [Google3.LabelSource label] }
    | otherwise = Nothing
  where
    rule ruleClass = Google3.Rule {
        Google3.ruleClass = ruleClass,
        Google3.ruleName = target,
        Google3.ruleSrcs = [],
        Google3.ruleDeps = [],
        Google3.ruleOtherAttrs = []
    }

wrapperPackage
    :: Google3.PackageName
    -> [Google3.License]
    -> [(Google3.Label, Google3.RuleClass)]
    -> Google3.Package
wrapperPackage packageName licenses rulesAndKinds =
  Google3.Package
    (unversionedPackageName packageName)
    ""  -- preamble
    (Google3.PackageAttributes [Google3.parseLabel "//visibility:public"])
    licenses
    ""  -- packageLicenseFile
    rules
    []
 where
  rules = mapMaybe (uncurry wrapperRule) rulesAndKinds'
  -- Don't forward the autogenerated "Paths_foo" library.
  rulesAndKinds' = filter (not . isPathsLibrary . fst) rulesAndKinds
  isPathsLibrary (Google3.Label _ (Google3.TargetName n))
      = "Paths_" `Text.isPrefixOf` n

makeWrapperPackage
    :: Google3.PackageName
    -> [Google3.License]
    -> IO Google3.Package
makeWrapperPackage latestVersion licenses
    = wrapperPackage latestVersion licenses <$> ruleKinds latestVersion

writeBuildFile :: Google3.Package -> FilePath -> IO ()
writeBuildFile pkg bfile = do
  writeFile bfile (show . Google3.pPrint . Google3.packageSyntax $ pkg)
  Buildifier.call [bfile]

createOrUpdateWrapperPackage
    :: VCSClient.VCSClient
    -> Google3.PackageName
    -> [Google3.License]
    -> IO ()
createOrUpdateWrapperPackage vcs package licenses = do
  wrapper <- makeWrapperPackage package licenses
  let wrapperBuildFile =
          Google3.google3absolutePath
             (VCSClient.g3Dir vcs)
             (Google3.packageName wrapper)
          </> "BUILD"
  VCSClient.withOpenFile vcs wrapperBuildFile $
      writeBuildFile wrapper wrapperBuildFile
