-- |
-- License: GPL-3.0-or-later
-- Copyright: Oleg Grenrus
{-# LANGUAGE OverloadedStrings #-}
module CabalFmt.Fields.BuildDepends (
    buildDependsF,
    setupDependsF,
    ) where

import qualified Distribution.CabalSpecVersion      as C
import qualified Distribution.Parsec                as C
import qualified Distribution.Parsec.Newtypes       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.PackageName     as C
import qualified Distribution.Types.Version         as C
import qualified Distribution.Types.VersionInterval as C
import qualified Distribution.Types.VersionRange    as C
import qualified Text.PrettyPrint                   as PP

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

setupDependsF :: Options -> FieldDescrs () ()
setupDependsF :: Options -> FieldDescrs () ()
setupDependsF Options
opts = FieldName
-> ([Dependency] -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m [Dependency])
-> FieldDescrs () ()
forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"setup-depends" (Options -> [Dependency] -> Doc
pretty Options
opts) forall (m :: * -> *). CabalParsing m => m [Dependency]
parse

buildDependsF :: Options -> FieldDescrs () ()
buildDependsF :: Options -> FieldDescrs () ()
buildDependsF Options
opts = FieldName
-> ([Dependency] -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m [Dependency])
-> FieldDescrs () ()
forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"build-depends" (Options -> [Dependency] -> Doc
pretty Options
opts) forall (m :: * -> *). CabalParsing m => m [Dependency]
parse

parse :: C.CabalParsing m => m [C.Dependency]
parse :: m [Dependency]
parse = ([Dependency] -> List CommaVCat (Identity Dependency) Dependency)
-> List CommaVCat (Identity Dependency) Dependency -> [Dependency]
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' (CommaVCat
-> [Dependency] -> List CommaVCat (Identity Dependency) Dependency
forall sep a. sep -> [a] -> List sep (Identity a) a
C.alaList CommaVCat
C.CommaVCat) (List CommaVCat (Identity Dependency) Dependency -> [Dependency])
-> m (List CommaVCat (Identity Dependency) Dependency)
-> m [Dependency]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (List CommaVCat (Identity Dependency) Dependency)
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec

pretty :: Options -> [C.Dependency] -> PP.Doc
pretty :: Options -> [Dependency] -> Doc
pretty Options { optSpecVersion :: Options -> CabalSpecVersion
optSpecVersion = CabalSpecVersion
v, optTabular :: Options -> Bool
optTabular = Bool
tab } [Dependency]
deps = case [Dependency]
deps of
    []    -> Doc
PP.empty
    [Dependency
dep] -> PackageName -> Doc
forall a. Pretty a => a -> Doc
C.pretty (Dependency -> PackageName
C.depPkgName Dependency
dep) Doc -> Doc -> Doc
PP.<+> VersionRange -> Doc
prettyVR VersionRange
vr'
      where
        vr' :: VersionRange
vr' = ([VersionInterval] -> VersionRange)
-> (VersionRange -> VersionRange)
-> Either [VersionInterval] VersionRange
-> VersionRange
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (VersionIntervals -> VersionRange
C.fromVersionIntervals (VersionIntervals -> VersionRange)
-> ([VersionInterval] -> VersionIntervals)
-> [VersionInterval]
-> VersionRange
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [VersionInterval] -> VersionIntervals
C.mkVersionIntervals) VersionRange -> VersionRange
forall a. a -> a
id
            (Either [VersionInterval] VersionRange -> VersionRange)
-> Either [VersionInterval] VersionRange -> VersionRange
forall a b. (a -> b) -> a -> b
$ [VersionInterval] -> Either [VersionInterval] VersionRange
norm (VersionRange -> [VersionInterval]
C.asVersionIntervals (VersionRange -> [VersionInterval])
-> VersionRange -> [VersionInterval]
forall a b. (a -> b) -> a -> b
$ Dependency -> VersionRange
C.depVerRange Dependency
dep)

        prettyVR :: VersionRange -> Doc
prettyVR VersionRange
vr | VersionRange
vr VersionRange -> VersionRange -> Bool
forall a. Eq a => a -> a -> Bool
== VersionRange
C.anyVersion = Doc
PP.empty
                    | VersionRange
vr VersionRange -> VersionRange -> Bool
forall a. Eq a => a -> a -> Bool
== VersionRange
C.noVersion  = String -> Doc
PP.text String
"<0"
                    | Bool
otherwise          = VersionRange -> Doc
forall a. Pretty a => a -> Doc
C.pretty VersionRange
vr

    [Dependency]
_ -> [Doc] -> Doc
PP.vcat ((Bool -> (String, [VersionInterval]) -> Doc)
-> [Bool] -> [(String, [VersionInterval])] -> [Doc]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> (String, [VersionInterval]) -> Doc
pretty' (Bool
True Bool -> [Bool] -> [Bool]
forall a. a -> [a] -> [a]
: Bool -> [Bool]
forall a. a -> [a]
repeat Bool
False) [(String, [VersionInterval])]
deps')
      where
        deps' :: [(String, [C.VersionInterval])]
        deps' :: [(String, [VersionInterval])]
deps' = ((String, [VersionInterval]) -> String)
-> [(String, [VersionInterval])] -> [(String, [VersionInterval])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn ((Char -> Char) -> String -> String
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower (String -> String)
-> ((String, [VersionInterval]) -> String)
-> (String, [VersionInterval])
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [VersionInterval]) -> String
forall a b. (a, b) -> a
fst)
              ([(String, [VersionInterval])] -> [(String, [VersionInterval])])
-> [(String, [VersionInterval])] -> [(String, [VersionInterval])]
forall a b. (a -> b) -> a -> b
$ (Dependency -> (String, [VersionInterval]))
-> [Dependency] -> [(String, [VersionInterval])]
forall a b. (a -> b) -> [a] -> [b]
map (PackageName -> String
C.unPackageName (PackageName -> String)
-> (Dependency -> PackageName) -> Dependency -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> PackageName
C.depPkgName (Dependency -> String)
-> (Dependency -> [VersionInterval])
-> Dependency
-> (String, [VersionInterval])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& VersionRange -> [VersionInterval]
C.asVersionIntervals (VersionRange -> [VersionInterval])
-> (Dependency -> VersionRange) -> Dependency -> [VersionInterval]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> VersionRange
C.depVerRange)
              ([Dependency] -> [(String, [VersionInterval])])
-> [Dependency] -> [(String, [VersionInterval])]
forall a b. (a -> b) -> a -> b
$ DependencyMap -> [Dependency]
C.fromDepMap (DependencyMap -> [Dependency])
-> ([Dependency] -> DependencyMap) -> [Dependency] -> [Dependency]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dependency] -> DependencyMap
C.toDepMap -- this combines duplicate packages
              ([Dependency] -> [Dependency]) -> [Dependency] -> [Dependency]
forall a b. (a -> b) -> a -> b
$ [Dependency]
deps

        width :: Int
width = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((String, [VersionInterval]) -> Int)
-> [(String, [VersionInterval])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (String -> Int)
-> ((String, [VersionInterval]) -> String)
-> (String, [VersionInterval])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [VersionInterval]) -> String
forall a b. (a, b) -> a
fst) [(String, [VersionInterval])]
deps') Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
        width' :: Int
width' = [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum (Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: ((String, [VersionInterval]) -> Int)
-> [(String, [VersionInterval])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([VersionInterval] -> Int
firstComponent ([VersionInterval] -> Int)
-> ((String, [VersionInterval]) -> [VersionInterval])
-> (String, [VersionInterval])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, [VersionInterval]) -> [VersionInterval]
forall a b. (a, b) -> b
snd) [(String, [VersionInterval])]
deps')

        -- we assume cabal-version: 2.2 or higher
        pretty' :: Bool -> (String, [C.VersionInterval]) -> PP.Doc
        pretty' :: Bool -> (String, [VersionInterval]) -> Doc
pretty' Bool
isFirst (String
name, [VersionInterval]
vis)
            | [VersionInterval] -> Bool
empty [VersionInterval]
vis = Doc
comma Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
name Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
"<0"
            | [VersionInterval] -> Bool
full  [VersionInterval]
vis = Doc
comma Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
name
            | Bool
otherwise = case [VersionInterval] -> Either [VersionInterval] VersionRange
norm [VersionInterval]
vis of
                Left [] -> Doc
comma Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
name
                Left (VersionInterval
vi : [VersionInterval]
vis') ->
                    Doc
comma Doc -> Doc -> Doc
PP.<+>
                    String -> Doc
PP.text (Int -> String -> String
lp Int
width String
name) Doc -> Doc -> Doc
PP.<+>
                    [Doc] -> Doc
PP.hsep
                        ( VersionInterval -> Doc
prettyVi VersionInterval
vi
                        Doc -> [Doc] -> [Doc]
forall a. a -> [a] -> [a]
: (VersionInterval -> Doc) -> [VersionInterval] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (\VersionInterval
vi' -> String -> Doc
PP.text String
"||" Doc -> Doc -> Doc
PP.<+> VersionInterval -> Doc
prettyVi' VersionInterval
vi') [VersionInterval]
vis'
                        )
                Right VersionRange
vr ->
                    Doc
comma Doc -> Doc -> Doc
PP.<+>
                    String -> Doc
PP.text (Int -> String -> String
lp Int
width String
name) Doc -> Doc -> Doc
PP.<+>
                    VersionRange -> Doc
forall a. Pretty a => a -> Doc
C.pretty VersionRange
vr
          where
            comma :: Doc
comma | Bool
isFirst, CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
C.CabalSpecV2_2 = String -> Doc
PP.text String
" "
                  | Bool
otherwise = Doc
PP.comma

        -- indent first
        prettyVi :: VersionInterval -> Doc
prettyVi (C.LowerBound Version
l Bound
lb, UpperBound
C.NoUpperBound) =
            Bound -> Doc
prettyLowerBound Bound
lb Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
l
        prettyVi (C.LowerBound Version
l Bound
C.InclusiveBound, C.UpperBound Version
u Bound
C.InclusiveBound)
            | Version
l Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
u = String -> Doc
PP.text String
"==" Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
l
        prettyVi (C.LowerBound Version
l Bound
C.InclusiveBound, C.UpperBound Version
u Bound
ub)
            | Version
l Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
C.version0
            = Bound -> Doc
prettyUpperBound Bound
ub Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
u
        prettyVi (C.LowerBound Version
l Bound
lb, C.UpperBound Version
u Bound
ub) =
            Bound -> Doc
prettyLowerBound Bound
lb Doc -> Doc -> Doc
PP.<> String -> Doc
PP.text (Int -> String -> String
lp Int
width' String
l')
            Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
"&&" Doc -> Doc -> Doc
PP.<+>
            Bound -> Doc
prettyUpperBound Bound
ub Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
u
          where
            l' :: String
l' = Version -> String
forall a. Pretty a => a -> String
C.prettyShow Version
l

        prettyVi' :: VersionInterval -> Doc
prettyVi' (C.LowerBound Version
l Bound
lb, UpperBound
C.NoUpperBound) =
            Bound -> Doc
prettyLowerBound Bound
lb Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
l
        prettyVi' (C.LowerBound Version
l Bound
C.InclusiveBound, C.UpperBound Version
u Bound
C.InclusiveBound)
            | Version
l Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
u = String -> Doc
PP.text String
"==" Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
l
        prettyVi' (C.LowerBound Version
l Bound
lb, C.UpperBound Version
u Bound
ub) =
            Bound -> Doc
prettyLowerBound Bound
lb Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
l Doc -> Doc -> Doc
PP.<+> String -> Doc
PP.text String
"&&" Doc -> Doc -> Doc
PP.<+>
            Bound -> Doc
prettyUpperBound Bound
ub Doc -> Doc -> Doc
PP.<> Version -> Doc
forall a. Pretty a => a -> Doc
C.pretty Version
u

        prettyLowerBound :: C.Bound -> PP.Doc
        prettyLowerBound :: Bound -> Doc
prettyLowerBound Bound
C.InclusiveBound = String -> Doc
PP.text String
">="
        prettyLowerBound Bound
C.ExclusiveBound = String -> Doc
PP.text String
">"

        prettyUpperBound :: C.Bound -> PP.Doc
        prettyUpperBound :: Bound -> Doc
prettyUpperBound Bound
C.InclusiveBound = String -> Doc
PP.text String
"<="
        prettyUpperBound Bound
C.ExclusiveBound = String -> Doc
PP.text String
"<"
  where
    full :: [C.VersionInterval] -> Bool
    full :: [VersionInterval] -> Bool
full [(C.LowerBound Version
l Bound
C.InclusiveBound, UpperBound
C.NoUpperBound)] = Version
l Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== [Int] -> Version
C.mkVersion [Int
0]
    full [VersionInterval]
_                                                   = Bool
False

    empty :: [C.VersionInterval] -> Bool
    empty :: [VersionInterval] -> Bool
empty [] = Bool
True
    empty [VersionInterval]
_  = Bool
False

    norm :: [C.VersionInterval] -> Either [C.VersionInterval] C.VersionRange
    norm :: [VersionInterval] -> Either [VersionInterval] VersionRange
norm []                                                                    = VersionRange -> Either [VersionInterval] VersionRange
forall a b. b -> Either a b
Right VersionRange
C.noVersion
    norm [(C.LowerBound Version
l Bound
C.InclusiveBound, UpperBound
C.NoUpperBound)] | Version
l Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
C.version0 = VersionRange -> Either [VersionInterval] VersionRange
forall a b. b -> Either a b
Right VersionRange
C.anyVersion
    norm (VersionInterval
i:[VersionInterval]
is) = Either [VersionInterval] VersionRange
-> (VersionRange -> Either [VersionInterval] VersionRange)
-> Maybe VersionRange
-> Either [VersionInterval] VersionRange
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([VersionInterval] -> Either [VersionInterval] VersionRange
forall a b. a -> Either a b
Left ([VersionInterval] -> Either [VersionInterval] VersionRange)
-> [VersionInterval] -> Either [VersionInterval] VersionRange
forall a b. (a -> b) -> a -> b
$ VersionInterval
iVersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
:[VersionInterval]
is) VersionRange -> Either [VersionInterval] VersionRange
forall a b. b -> Either a b
Right (Maybe VersionRange -> Either [VersionInterval] VersionRange)
-> Maybe VersionRange -> Either [VersionInterval] VersionRange
forall a b. (a -> b) -> a -> b
$
        (VersionRange -> VersionRange -> VersionRange)
-> [VersionRange] -> VersionRange
forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a
foldr1 VersionRange -> VersionRange -> VersionRange
C.unionVersionRanges ([VersionRange] -> VersionRange)
-> Maybe [VersionRange] -> Maybe VersionRange
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (VersionInterval -> Maybe VersionRange)
-> [VersionInterval] -> Maybe [VersionRange]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse VersionInterval -> Maybe VersionRange
f (VersionInterval
i VersionInterval -> [VersionInterval] -> [VersionInterval]
forall a. a -> [a] -> [a]
: [VersionInterval]
is)
      where
        f :: C.VersionInterval -> Maybe C.VersionRange
        f :: VersionInterval -> Maybe VersionRange
f (C.LowerBound Version
l Bound
C.InclusiveBound, C.UpperBound Version
u Bound
C.ExclusiveBound)
            | CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
C.CabalSpecV2_0, Version
u Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version -> Version
C.majorUpperBound Version
l =
                VersionRange -> Maybe VersionRange
forall a. a -> Maybe a
Just (Version -> VersionRange
C.majorBoundVersion Version
l)
        f VersionInterval
_ = Maybe VersionRange
forall a. Maybe a
Nothing

    firstComponent :: [C.VersionInterval] -> Int
    firstComponent :: [VersionInterval] -> Int
firstComponent [] = Int
0
    firstComponent ((C.LowerBound Version
l Bound
_, UpperBound
_) : [VersionInterval]
_) = String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length (Version -> String
forall a. Pretty a => a -> String
C.prettyShow Version
l)

    lp :: Int -> String -> String
lp | Bool
tab       = Int -> String -> String
leftpad
       | Bool
otherwise = \Int
_ String
x -> String
x

leftpad :: Int -> String -> String
leftpad :: Int -> String -> String
leftpad Int
w String
s = String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
w Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '