-- |
-- 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.Parsec           as C
import qualified Distribution.Parsec.Newtypes  as C
import qualified Distribution.Pretty           as C
import qualified Distribution.Version          as C
import qualified Text.PrettyPrint              as PP

import CabalFmt.Prelude
import CabalFmt.Fields
import CabalFmt.Options

testedWithF :: Options -> FieldDescrs () ()
testedWithF :: Options -> FieldDescrs () ()
testedWithF Options { optSpecVersion :: Options -> CabalSpecVersion
optSpecVersion = CabalSpecVersion
ver } = FieldName
-> ([(CompilerFlavor, VersionRange)] -> Doc)
-> (forall (m :: * -> *).
    CabalParsing m =>
    m [(CompilerFlavor, VersionRange)])
-> FieldDescrs () ()
forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"tested-with" [(CompilerFlavor, VersionRange)] -> Doc
pretty forall (m :: * -> *).
CabalParsing m =>
m [(CompilerFlavor, VersionRange)]
parse where
    parse :: C.CabalParsing m => m [(C.CompilerFlavor, C.VersionRange)]
    parse :: m [(CompilerFlavor, VersionRange)]
parse = ([(CompilerFlavor, VersionRange)]
 -> List FSep TestedWith (CompilerFlavor, VersionRange))
-> List FSep TestedWith (CompilerFlavor, VersionRange)
-> [(CompilerFlavor, VersionRange)]
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' (FSep
-> ((CompilerFlavor, VersionRange) -> TestedWith)
-> [(CompilerFlavor, VersionRange)]
-> List FSep TestedWith (CompilerFlavor, VersionRange)
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' FSep
C.FSep (CompilerFlavor, VersionRange) -> TestedWith
C.TestedWith) (List FSep TestedWith (CompilerFlavor, VersionRange)
 -> [(CompilerFlavor, VersionRange)])
-> m (List FSep TestedWith (CompilerFlavor, VersionRange))
-> m [(CompilerFlavor, VersionRange)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (List FSep TestedWith (CompilerFlavor, VersionRange))
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec

    pretty :: [(C.CompilerFlavor, C.VersionRange)] -> PP.Doc
    pretty :: [(CompilerFlavor, VersionRange)] -> Doc
pretty [(CompilerFlavor, VersionRange)]
tw0 = CabalSpecVersion -> [Doc] -> Doc
leadingComma CabalSpecVersion
ver
        [ CompilerFlavor -> Doc
prettyC CompilerFlavor
c Doc -> Doc -> Doc
PP.<+> VersionRange -> Doc
prettyVr VersionRange
vr
        | (CompilerFlavor
c, VersionRange
vr) <- Map CompilerFlavor VersionRange -> [(CompilerFlavor, VersionRange)]
forall k a. Map k a -> [(k, a)]
Map.toList Map CompilerFlavor VersionRange
tw1
        ]
      where
        tw1 :: Map.Map C.CompilerFlavor C.VersionRange
        tw1 :: Map CompilerFlavor VersionRange
tw1 = (VersionRange -> VersionRange -> VersionRange)
-> [(CompilerFlavor, VersionRange)]
-> Map CompilerFlavor VersionRange
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith VersionRange -> VersionRange -> VersionRange
C.unionVersionRanges [(CompilerFlavor, VersionRange)]
tw0

        -- TODO: Cabal 3.0 formatting!
        prettyVr :: VersionRange -> Doc
prettyVr VersionRange
vr = case VersionRange -> Maybe (Set Version)
isVersionSet VersionRange
vr of
            Just Set Version
vs -> [Doc] -> Doc
PP.sep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a. (a -> a) -> [a] -> [a]
mapTail (\Doc
doc -> Int -> Doc -> Doc
PP.nest (-Int
3) (Doc -> Doc) -> Doc -> Doc
forall a b. (a -> b) -> a -> b
$ String -> Doc
PP.text String
"||" Doc -> Doc -> Doc
PP.<+> Doc
doc) [ VersionRange -> Doc
forall a. Pretty a => a -> Doc
C.pretty (Version -> VersionRange
C.thisVersion Version
v) | Version
v <- Set Version -> [Version]
forall a. Set a -> [a]
Set.toList Set Version
vs ]
            Maybe (Set Version)
Nothing -> VersionRange -> Doc
forall a. Pretty a => a -> Doc
C.pretty VersionRange
vr

        prettyC :: CompilerFlavor -> Doc
prettyC CompilerFlavor
C.GHC   = String -> Doc
PP.text String
"GHC"
        prettyC CompilerFlavor
C.GHCJS = String -> Doc
PP.text String
"GHCJS"
        prettyC CompilerFlavor
c       = CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
C.pretty CompilerFlavor
c

leadingComma :: C.CabalSpecVersion -> [PP.Doc] -> PP.Doc
leadingComma :: CabalSpecVersion -> [Doc] -> Doc
leadingComma CabalSpecVersion
_ []  = Doc
PP.empty
leadingComma CabalSpecVersion
_ [Doc
x] = Doc
x
leadingComma CabalSpecVersion
v [Doc]
xs = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Bool -> Doc -> Doc) -> [Bool] -> [Doc] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> Doc -> Doc
comma (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [Doc]
xs where
    comma :: Bool -> PP.Doc -> PP.Doc
    comma :: Bool -> Doc -> Doc
comma Bool
isFirst Doc
doc
        | Bool
isFirst, CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
C.CabalSpecV3_0 = Char -> Doc
PP.char Char
' ' Doc -> Doc -> Doc
PP.<+> Doc
doc
        | Bool
otherwise                    = Char -> Doc
PP.char Char
',' Doc -> Doc -> Doc
PP.<+> Doc
doc

isVersionSet :: C.VersionRange -> Maybe (Set C.Version)
isVersionSet :: VersionRange -> Maybe (Set Version)
isVersionSet VersionRange
vr = Set Version -> [(LowerBound, UpperBound)] -> Maybe (Set Version)
go Set Version
forall a. Set a
Set.empty (VersionRange -> [(LowerBound, UpperBound)]
C.asVersionIntervals VersionRange
vr) where
    go :: Set Version -> [(LowerBound, UpperBound)] -> Maybe (Set Version)
go !Set Version
acc [] = Set Version -> Maybe (Set Version)
forall a. a -> Maybe a
Just Set Version
acc
    go Set Version
acc ((C.LowerBound Version
v Bound
C.InclusiveBound, C.UpperBound Version
u Bound
C.InclusiveBound) : [(LowerBound, UpperBound)]
vis)
        | Version
v Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
u    = Set Version -> [(LowerBound, UpperBound)] -> Maybe (Set Version)
go (Version -> Set Version -> Set Version
forall a. Ord a => a -> Set a -> Set a
Set.insert Version
v Set Version
acc) [(LowerBound, UpperBound)]
vis
    go Set Version
_ [(LowerBound, UpperBound)]
_ = Maybe (Set Version)
forall a. Maybe a
Nothing

mapTail :: (a -> a) -> [a] -> [a]
mapTail :: (a -> a) -> [a] -> [a]
mapTail a -> a
_ []     = []
mapTail a -> a
f (a
x:[a]
xs) = a
x a -> [a] -> [a]
forall a. a -> [a] -> [a]
: (a -> a) -> [a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map a -> a
f [a]
xs