-- |
-- 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 qualified Distribution.CabalSpecVersion    as C
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.VersionRange  as C
import qualified Text.PrettyPrint                 as PP

import CabalFmt.Fields
import CabalFmt.Options
import CabalFmt.Prelude
import VersionInterval  (normaliseVersionRange, ConversionProblem (..))

setupDependsF :: Options -> FieldDescrs () ()
setupDependsF :: Options -> FieldDescrs () ()
setupDependsF Options
opts = 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 = 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

buildToolDependsF :: Options -> FieldDescrs () ()
buildToolDependsF :: Options -> FieldDescrs () ()
buildToolDependsF Options
opts = forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"build-tool-depends" (Options -> [ExeDependency] -> Doc
prettyExe Options
opts) forall (m :: * -> *). CabalParsing m => m [ExeDependency]
parseExe

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

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

normaliseVersionRange' :: C.VersionRange -> C.VersionRange
normaliseVersionRange' :: VersionRange -> VersionRange
normaliseVersionRange' VersionRange
vr = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ConversionProblem -> VersionRange
fromConversionProblem forall a. a -> a
id (VersionRange -> Either ConversionProblem VersionRange
normaliseVersionRange VersionRange
vr) where
    fromConversionProblem :: ConversionProblem -> C.VersionRange
    fromConversionProblem :: ConversionProblem -> VersionRange
fromConversionProblem ConversionProblem
IntervalsEmpty         = VersionRange
C.noVersion
    fromConversionProblem ConversionProblem
OtherConversionProblem = VersionRange
vr

pretty :: Options -> [C.Dependency] -> PP.Doc
pretty :: Options -> [Dependency] -> Doc
pretty Options
opts [Dependency]
deps = case [Dependency]
deps of
    []    -> Doc
PP.empty
    [Dependency
dep] -> [Char] -> Doc
PP.text (Dependency -> [Char]
prettyDepNoVersion Dependency
dep) Doc -> Doc -> Doc
PP.<+> VersionRange -> Doc
prettyVR VersionRange
vr'
      where
        vr' :: VersionRange
vr' = VersionRange -> VersionRange
normaliseVersionRange' (Dependency -> VersionRange
C.depVerRange Dependency
dep)

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

    [Dependency]
_ -> Options -> [([Char], VersionRange)] -> Doc
prettyMany Options
opts [([Char], VersionRange)]
deps'
      where
        deps' :: [(String, C.VersionRange)]
        deps' :: [([Char], VersionRange)]
deps' = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (Dependency -> [Char]
prettyDepNoVersion forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Dependency -> VersionRange
C.depVerRange)
              forall a b. (a -> b) -> a -> b
$ DependencyMap -> [Dependency]
C.fromDepMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Dependency] -> DependencyMap
C.toDepMap -- this combines duplicate packages
              forall a b. (a -> b) -> a -> b
$ [Dependency]
deps
    where
      prettyDepNoVersion :: C.Dependency -> String
      prettyDepNoVersion :: Dependency -> [Char]
prettyDepNoVersion (C.Dependency PackageName
pkg VersionRange
_ NonEmptySet LibraryName
libs) =
        forall a. Pretty a => a -> [Char]
C.prettyShow (PackageName
-> VersionRange -> NonEmptySet LibraryName -> Dependency
C.Dependency PackageName
pkg VersionRange
C.anyVersion NonEmptySet LibraryName
libs)


prettyExe :: Options -> [C.ExeDependency] -> PP.Doc
prettyExe :: Options -> [ExeDependency] -> Doc
prettyExe Options
opts [ExeDependency]
deps = case [ExeDependency]
deps of
    []    -> Doc
PP.empty
    [ExeDependency
dep] -> [Char] -> Doc
PP.text (ExeDependency -> [Char]
exeDepExeName ExeDependency
dep) Doc -> Doc -> Doc
PP.<+> VersionRange -> Doc
prettyVR VersionRange
vr'
      where
        vr' :: VersionRange
vr' = VersionRange -> VersionRange
normaliseVersionRange' (ExeDependency -> VersionRange
exeDepVerRange ExeDependency
dep)

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

    [ExeDependency]
_ -> Options -> [([Char], VersionRange)] -> Doc
prettyMany Options
opts [([Char], VersionRange)]
deps'
      where
        deps' :: [(String, C.VersionRange)]
        deps' :: [([Char], VersionRange)]
deps' = forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)
              forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (ExeDependency -> [Char]
exeDepExeName forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& ExeDependency -> VersionRange
exeDepVerRange)
              -- C.fromDepMap . C.toDepMap -- this combines duplicate packages
              forall a b. (a -> b) -> a -> b
$ [ExeDependency]
deps

exeDepExeName :: C.ExeDependency -> String
exeDepExeName :: ExeDependency -> [Char]
exeDepExeName (C.ExeDependency PackageName
name UnqualComponentName
exe VersionRange
_) =
    forall a. Pretty a => a -> [Char]
C.prettyShow PackageName
name forall a. [a] -> [a] -> [a]
++ [Char]
":" forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> [Char]
C.prettyShow UnqualComponentName
exe

exeDepVerRange :: C.ExeDependency -> C.VersionRange
exeDepVerRange :: ExeDependency -> VersionRange
exeDepVerRange (C.ExeDependency PackageName
_ UnqualComponentName
_ VersionRange
vr) = VersionRange
vr

prettyMany :: Options -> [(String, C.VersionRange)] -> PP.Doc
prettyMany :: Options -> [([Char], VersionRange)] -> Doc
prettyMany Options { optSpecVersion :: Options -> CabalSpecVersion
optSpecVersion = CabalSpecVersion
v, optTabular :: Options -> Bool
optTabular = Bool
tab } [([Char], VersionRange)]
deps'
    = [Doc] -> Doc
PP.vcat
    forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map [Char] -> Doc
PP.text
    forall a b. (a -> b) -> a -> b
$ [[[Char]]] -> [[Char]]
tbl
    forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Bool -> ([Char], VersionRange) -> [[Char]]
cols (Bool
True forall a. a -> [a] -> [a]
: forall a. a -> [a]
repeat Bool
False) [([Char], VersionRange)]
deps'
  where
    cols :: Bool -> (String, C.VersionRange) -> [String]
    cols :: Bool -> ([Char], VersionRange) -> [[Char]]
cols Bool
isFirst ([Char]
name, VersionRange
vr)
        | VersionRange -> Bool
full VersionRange
vr'  = [[Char]
comma, [Char]
name]
        | Bool
otherwise = [Char]
comma forall a. a -> [a] -> [a]
: [Char]
name forall a. a -> [a] -> [a]
: [Char]
"" forall a. a -> [a] -> [a]
: [Char] -> [[Char]]
words (forall a. Pretty a => a -> [Char]
C.prettyShow VersionRange
vr')
      where
        vr' :: VersionRange
vr' = VersionRange -> VersionRange
normaliseVersionRange' VersionRange
vr

        comma :: [Char]
comma | Bool
isFirst, CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
C.CabalSpecV2_2 = [Char]
" "
              | Bool
otherwise                    = [Char]
","

    full :: C.VersionRange -> Bool
    full :: VersionRange -> Bool
full VersionRange
vr = VersionRange
vr forall a. Eq a => a -> a -> Bool
== VersionRange
C.anyVersion

    tbl :: [[String]] -> [String]
    tbl :: [[[Char]]] -> [[Char]]
tbl = if Bool
tab then [[[Char]]] -> [[Char]]
table else forall a b. (a -> b) -> [a] -> [b]
map ([Char] -> [Char]
concatSpaces forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[Char]] -> [Char]
unwords)

-- returns rows.
table :: [[String]] -> [String]
table :: [[[Char]]] -> [[Char]]
table [[[Char]]]
cells = forall a b. (a -> b) -> [a] -> [b]
map [Char] -> [Char]
strip [[Char]]
rows
  where
    cols      :: Int
    rowWidths :: [Int]
    rows      :: [String]

    (Int
cols, [Int]
rowWidths, [[Char]]
rows) = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr [[Char]] -> (Int, [Int], [[Char]]) -> (Int, [Int], [[Char]])
go (Int
0, forall a. a -> [a]
repeat Int
0, []) [[[Char]]]
cells

    go :: [String] -> (Int, [Int], [String]) -> (Int, [Int], [String])
    go :: [[Char]] -> (Int, [Int], [[Char]]) -> (Int, [Int], [[Char]])
go [[Char]]
xs (Int
c, [Int]
w, [[Char]]
yss) =
        ( forall a. Ord a => a -> a -> a
max Int
c (forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs)
        , forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall a. Ord a => a -> a -> a
max [Int]
w (forall a b. (a -> b) -> [a] -> [b]
map forall (t :: * -> *) a. Foldable t => t a -> Int
length [[Char]]
xs forall a. [a] -> [a] -> [a]
++ forall a. a -> [a]
repeat Int
0)
        , [[Char]] -> [Char]
unwords (forall a. Int -> [a] -> [a]
take Int
cols (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith [Char] -> Int -> [Char]
fill [[Char]]
xs [Int]
rowWidths))
          forall a. a -> [a] -> [a]
: [[Char]]
yss
        )

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

strip :: String -> String
strip :: [Char] -> [Char]
strip = forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char
' ' forall a. Eq a => a -> a -> Bool
==)

concatSpaces :: String -> String
concatSpaces :: [Char] -> [Char]
concatSpaces []        = []
concatSpaces (Char
' ' : [Char]
s) = Char
' ' forall a. a -> [a] -> [a]
: [Char] -> [Char]
concatSpaces [Char]
s
concatSpaces (Char
c0 : [Char]
s0)   = Char
c0 forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
s0 where
    go :: [Char] -> [Char]
go (Char
' ' : Char
' ' : [Char]
s) = [Char] -> [Char]
go (Char
' ' forall a. a -> [a] -> [a]
: [Char]
s)
    go (Char
c:[Char]
s)           = Char
c forall a. a -> [a] -> [a]
: [Char] -> [Char]
go [Char]
s
    go []              = []