module CabalBounds.Update
   ( update
   , Libraries
   ) where

import qualified Distribution.PackageDescription as D
import qualified Distribution.Package as P
import qualified Distribution.Version as V
import Control.Lens
import CabalBounds.Bound (UpdateBound(..))
import CabalBounds.Dependencies (Dependencies(..), filterDependency)
import CabalBounds.VersionComp (VersionComp(..))
import qualified CabalLenses as CL
import Data.List (foldl')
import qualified Data.HashMap.Strict as HM
import Data.Maybe (fromMaybe)

type PkgName    = String
type LibName    = String
type LibVersion = V.Version
type Libraries  = HM.HashMap LibName LibVersion


update :: UpdateBound -> [CL.Section] -> Dependencies -> Libraries -> D.GenericPackageDescription -> D.GenericPackageDescription
update bound sections deps libs pkgDescrp =
   foldl' updateSection pkgDescrp sections
   where
      updateSection pkgDescrp section =
         pkgDescrp & CL.dependencyIf condVars section . filterDep %~ updateDep

      filterDep = filterDependency deps
      updateDep = updateDependency bound libs
      condVars  = CL.fromDefaults pkgDescrp


updateDependency :: UpdateBound -> Libraries -> P.Dependency -> P.Dependency
updateDependency (UpdateLower comp ifMissing) libs dep =
   fromMaybe dep $
      if ifMissing && lowerBound_ /= noLowerBound
         then return dep
         else do
            version <- HM.lookup pkgName_ libs
            let newLowerVersion = comp `compOf` version
                newLowerBound   = V.LowerBound newLowerVersion V.InclusiveBound
                vrange          = fromMaybe (V.orLaterVersion newLowerVersion)
                                            (modifyVersionIntervals (updateLower newLowerBound) versionRange_)
            return $ mkDependency pkgName_ vrange
   where
      updateLower newLowerBound []        = [(newLowerBound, V.NoUpperBound)]
      updateLower newLowerBound intervals = intervals & _head . lowerBound .~ newLowerBound

      pkgName_      = pkgName dep
      versionRange_ = versionRange dep
      lowerBound_   = fromMaybe noLowerBound $ V.asVersionIntervals versionRange_ ^? _head . lowerBound

updateDependency (UpdateUpper comp ifMissing) libs dep =
   fromMaybe dep $
      if ifMissing && upperBound_ /= V.NoUpperBound
         then return dep
         else do
            upperVersion <- HM.lookup pkgName_ libs
            let newUpperVersion = comp `compOf` upperVersion
                newUpperBound   = V.UpperBound (nextVersion newUpperVersion) V.ExclusiveBound
            vrange <- modifyVersionIntervals (updateUpper newUpperBound) versionRange_
            return $ mkDependency pkgName_ vrange
   where
      versionRange_ = versionRange dep
      pkgName_      = pkgName dep
      upperBound_   = fromMaybe V.NoUpperBound $ V.asVersionIntervals versionRange_ ^? _head . upperBound

      updateUpper newUpperBound []        = [(noLowerBound, newUpperBound)]
      updateUpper newUpperBound intervals = intervals & _last . upperBound .~ newUpperBound

updateDependency (UpdateBoth lowerComp upperComp ifMissing) libs dep =
    updateDependency (UpdateLower lowerComp ifMissing) libs $
    updateDependency (UpdateUpper upperComp ifMissing) libs dep


modifyVersionIntervals :: ([V.VersionInterval] -> [V.VersionInterval]) -> V.VersionRange -> Maybe V.VersionRange
modifyVersionIntervals f = fmap V.fromVersionIntervals . V.mkVersionIntervals . f . V.asVersionIntervals


compOf :: VersionComp -> V.Version -> V.Version
Major1 `compOf` version =
   version & CL.versionBranchL %~ take 1
           & CL.versionTagsL   .~ []

Major2 `compOf` version =
   version & CL.versionBranchL %~ take 2
           & CL.versionTagsL   .~ []

Minor `compOf` version =
   version & CL.versionTagsL .~ []


nextVersion :: V.Version -> V.Version
nextVersion version =
   version & CL.versionBranchL %~ increaseLastComp
   where
      increaseLastComp = reverse . (& ix 0 %~ (+ 1)) . reverse


pkgName :: P.Dependency -> PkgName
pkgName (P.Dependency (P.PackageName name) _) = name


versionRange :: P.Dependency -> V.VersionRange
versionRange (P.Dependency _ vrange) = vrange


mkDependency :: PkgName -> V.VersionRange -> P.Dependency
mkDependency name = P.Dependency (P.PackageName name)


lowerBound :: Lens' V.VersionInterval V.LowerBound
lowerBound = _1


upperBound :: Lens' V.VersionInterval V.UpperBound
upperBound = _2


noLowerBound :: V.LowerBound
noLowerBound = V.LowerBound (V.Version [0] []) V.InclusiveBound