content: -- |
  -- License: GPL-3.0-or-later
  -- Copyright: Oleg Grenrus
  {-# LANGUAGE BangPatterns      #-}
  {-# LANGUAGE OverloadedStrings #-}
  module CabalFmt.Fields.TestedWith (
      testedWithF,
      ) where
  
  import qualified Data.Map.Strict               as Map
  import qualified Data.Set                      as Set
  import qualified Distribution.CabalSpecVersion as C
  import qualified Distribution.Compiler         as C
  import qualified Distribution.FieldGrammar     as C
  import qualified Distribution.Parsec           as C
  import qualified Distribution.Pretty           as C
  import qualified Distribution.Version          as C
  import qualified Text.PrettyPrint              as PP
  
  import CabalFmt.Fields
  import CabalFmt.Options
  import CabalFmt.Prelude
  
  testedWithF :: Options -> FieldDescrs () ()
  testedWithF Options { optSpecVersion = ver } = singletonF "tested-with" pretty parse where
      parse :: C.CabalParsing m => m [(C.CompilerFlavor, C.VersionRange)]
      parse = unpack' (C.alaList' C.FSep C.TestedWith) <$> C.parsec
  
      pretty :: [(C.CompilerFlavor, C.VersionRange)] -> PP.Doc
      pretty tw0 = leadingComma ver
          [ prettyC c PP.<+> prettyVr vr
          | (c, vr) <- Map.toList tw1
          ]
        where
          tw1 :: Map.Map C.CompilerFlavor C.VersionRange
          tw1 = Map.fromListWith C.unionVersionRanges tw0
  
          -- TODO: Cabal 3.0 formatting!
          prettyVr vr = case isVersionSet vr of
              Just vs -> PP.sep $ mapTail (\doc -> PP.nest (-3) $ PP.text "||" PP.<+> doc) [ C.pretty (C.thisVersion v) | v <- Set.toList vs ]
              Nothing -> C.pretty vr
  
          prettyC C.GHC   = PP.text "GHC"
          prettyC C.GHCJS = PP.text "GHCJS"
          prettyC c       = C.pretty c
  
  leadingComma :: C.CabalSpecVersion -> [PP.Doc] -> PP.Doc
  leadingComma _ []  = PP.empty
  leadingComma _ [x] = x
  leadingComma v xs = PP.vcat $ zipWith comma (True : repeat False) xs where
      comma :: Bool -> PP.Doc -> PP.Doc
      comma isFirst doc
          | isFirst, v < C.CabalSpecV3_0 = PP.char ' ' PP.<+> doc
          | otherwise                    = PP.char ',' PP.<+> doc
  
  isVersionSet :: C.VersionRange -> Maybe (Set C.Version)
  isVersionSet vr = go Set.empty (C.asVersionIntervals vr) where
      go !acc [] = Just acc
      go acc (C.VersionInterval (C.LowerBound v C.InclusiveBound) (C.UpperBound u C.InclusiveBound) : vis)
          | v == u    = go (Set.insert v acc) vis
      go _ _ = Nothing
  
  mapTail :: (a -> a) -> [a] -> [a]
  mapTail _ []     = []
  mapTail f (x:xs) = x : map f xs
  