content: -- |
  -- License: GPL-3.0-or-later
  -- Copyright: Oleg Grenrus
  {-# LANGUAGE OverloadedStrings #-}
  {-# OPTIONS_GHC -Wno-deprecations #-}
  module CabalFmt.Fields.BuildDepends (
      buildDependsF,
      setupDependsF,
      buildToolDependsF,
  ) where
  
  import Data.List (dropWhileEnd)
  
  import           CabalFmt.Fields
  import           CabalFmt.Options
  import           CabalFmt.Prelude
  import qualified Distribution.CabalSpecVersion    as C
  import qualified Distribution.Compat.NonEmptySet  as NES
  import qualified Distribution.FieldGrammar        as C
  import qualified Distribution.Parsec              as C
  import qualified Distribution.Pretty              as C
  import qualified Distribution.Types.Dependency    as C
  import qualified Distribution.Types.DependencyMap as C
  import qualified Distribution.Types.ExeDependency as C
  import qualified Distribution.Types.LibraryName   as C
  import qualified Distribution.Types.VersionRange  as C
  import qualified Text.PrettyPrint                 as PP
  import           VersionInterval
                   (ConversionProblem (..), normaliseVersionRange)
  
  setupDependsF :: Options -> FieldDescrs () ()
  setupDependsF opts = singletonF "setup-depends" (pretty opts) parse
  
  buildDependsF :: Options -> FieldDescrs () ()
  buildDependsF opts = singletonF "build-depends" (pretty opts) parse
  
  buildToolDependsF :: Options -> FieldDescrs () ()
  buildToolDependsF opts = singletonF "build-tool-depends" (prettyExe opts) parseExe
  
  parse :: C.CabalParsing m => m [C.Dependency]
  parse = unpack' (C.alaList C.CommaVCat) <$> C.parsec
  
  parseExe :: C.CabalParsing m => m [C.ExeDependency]
  parseExe = unpack' (C.alaList C.CommaVCat) <$> C.parsec
  
  normaliseVersionRange' :: C.VersionRange -> C.VersionRange
  normaliseVersionRange' vr = either fromConversionProblem id (normaliseVersionRange vr) where
      fromConversionProblem :: ConversionProblem -> C.VersionRange
      fromConversionProblem IntervalsEmpty         = C.noVersion
      fromConversionProblem OtherConversionProblem = vr
  
  pretty :: Options -> [C.Dependency] -> PP.Doc
  pretty opts deps = case deps' of
      []    -> PP.empty
      [dep] -> PP.text (prettyDepNoVersion dep) PP.<+> prettyVR vr'
        where
          vr' = normaliseVersionRange' (C.depVerRange dep)
  
          prettyVR vr | vr == C.anyVersion = PP.empty
                      | vr == C.noVersion  = PP.text "<0"
                      | otherwise          = C.pretty vr
  
      _ -> prettyMany opts deps''
        where
          deps'' :: [(String, C.VersionRange)]
          deps'' =
              sortOn (map toLower . fst) $
              map (prettyDepNoVersion &&& C.depVerRange) deps'
      where
        -- combined and expanded dependencies
        deps' :: [C.Dependency]
        deps' = concatMap expandDep $ C.fromDepMap $ C.toDepMap deps
  
        prettyDepNoVersion :: C.Dependency -> String
        prettyDepNoVersion (C.Dependency pkg _ libs) =
          C.prettyShow (C.Dependency pkg C.anyVersion libs)
  
        expandDep :: C.Dependency -> [C.Dependency]
        expandDep (C.Dependency pkg vr libs) = makeDep $ sortOn f (NES.toList libs)
          where
            f C.LMainLibName    = Nothing
            f (C.LSubLibName n) = Just (map toLower (C.prettyShow n))
  
            -- attach version range to the first dependency of the group.
            makeDep :: [C.LibraryName] -> [C.Dependency]
            makeDep []         = []
            makeDep (ln : lns) =
                C.Dependency pkg vr (NES.singleton ln) :
                map (\ln' -> C.Dependency pkg C.anyVersion (NES.singleton ln')) lns
  
  prettyExe :: Options -> [C.ExeDependency] -> PP.Doc
  prettyExe opts deps = case deps of
      []    -> PP.empty
      [dep] -> PP.text (exeDepExeName dep) PP.<+> prettyVR vr'
        where
          vr' = normaliseVersionRange' (exeDepVerRange dep)
  
          prettyVR vr | vr == C.anyVersion = PP.empty
                      | vr == C.noVersion  = PP.text "<0"
                      | otherwise          = C.pretty vr
  
      _ -> prettyMany opts deps'
        where
          deps' :: [(String, C.VersionRange)]
          deps' = sortOn (map toLower . fst)
                $ map (exeDepExeName &&& exeDepVerRange)
                -- C.fromDepMap . C.toDepMap -- this combines duplicate packages
                $ deps
  
  exeDepExeName :: C.ExeDependency -> String
  exeDepExeName (C.ExeDependency name exe _) =
      C.prettyShow name ++ ":" ++ C.prettyShow exe
  
  exeDepVerRange :: C.ExeDependency -> C.VersionRange
  exeDepVerRange (C.ExeDependency _ _ vr) = vr
  
  prettyMany :: Options -> [(String, C.VersionRange)] -> PP.Doc
  prettyMany Options { optSpecVersion = v, optTabular = tab } deps'
      = PP.vcat
      $ map PP.text
      $ tbl
      $ zipWith cols (True : repeat False) deps'
    where
      cols :: Bool -> (String, C.VersionRange) -> [String]
      cols isFirst (name, vr)
          | full vr'  = [comma, name]
          | otherwise = comma : name : "" : words (C.prettyShow vr')
        where
          vr' = normaliseVersionRange' vr
  
          comma | isFirst, v < C.CabalSpecV2_2 = " "
                | otherwise                    = ","
  
      full :: C.VersionRange -> Bool
      full vr = vr == C.anyVersion
  
      tbl :: [[String]] -> [String]
      tbl = if tab then table else map (concatSpaces . unwords)
  
  -- returns rows.
  table :: [[String]] -> [String]
  table cells = map strip rows
    where
      cols      :: Int
      rowWidths :: [Int]
      rows      :: [String]
  
      (cols, rowWidths, rows) = foldr go (0, repeat 0, []) cells
  
      go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])
      go xs (c, w, yss) =
          ( max c (length xs)
          , zipWith max w (map length xs ++ repeat 0)
          , unwords (take cols (zipWith fill xs rowWidths))
            : yss
          )
  
      fill :: String -> Int -> String
      fill s n = s ++ replicate (n - length s) ' '
  
  strip :: String -> String
  strip = dropWhileEnd (' ' ==)
  
  concatSpaces :: String -> String
  concatSpaces []        = []
  concatSpaces (' ' : s) = ' ' : concatSpaces s
  concatSpaces (c0 : s0)   = c0 : go s0 where
      go (' ' : ' ' : s) = go (' ' : s)
      go (c:s)           = c : go s
      go []              = []
  