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

import qualified Distribution.FieldGrammar as C
import qualified Distribution.ModuleName   as C
import qualified Distribution.Parsec       as C
import qualified Distribution.Pretty       as C
import qualified Text.PrettyPrint          as PP

import CabalFmt.Fields
import CabalFmt.Prelude

exposedModulesF :: FieldDescrs () ()
exposedModulesF :: FieldDescrs () ()
exposedModulesF = forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"exposed-modules" [ModuleName] -> Doc
pretty forall (m :: * -> *). CabalParsing m => m [ModuleName]
parse

otherModulesF :: FieldDescrs () ()
otherModulesF :: FieldDescrs () ()
otherModulesF = forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"other-modules" [ModuleName] -> Doc
pretty forall (m :: * -> *). CabalParsing m => m [ModuleName]
parse

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

pretty :: [C.ModuleName] -> PP.Doc
pretty :: [ModuleName] -> Doc
pretty
    = [Doc] -> Doc
PP.vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Pretty a => a -> Doc
C.pretty
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => [a] -> [a]
nub
    forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (forall {a}. Ord a => [a] -> [a] -> Ordering
cmp forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` forall a b. (a -> b) -> [a] -> [b]
map String -> String
strToLower forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> [String]
C.components)
  where
    cmp :: [a] -> [a] -> Ordering
cmp [a]
a [a]
b = case forall a. Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix [a]
a [a]
b of
        ([], [])  -> Ordering
EQ
        ([], a
_:[a]
_) -> Ordering
LT
        (a
_:[a]
_, []) -> Ordering
GT
        ([a]
a', [a]
b')  -> forall a. Ord a => a -> a -> Ordering
compare [a]
a' [a]
b'

strToLower :: String -> String
strToLower :: String -> String
strToLower = forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toLower

dropCommonPrefix :: Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix :: forall a. Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix [] [] = ([], [])
dropCommonPrefix [] [a]
ys = ([], [a]
ys)
dropCommonPrefix [a]
xs [] = ([a]
xs, [])
dropCommonPrefix xs :: [a]
xs@(a
x:[a]
xs') ys :: [a]
ys@(a
y:[a]
ys')
    | a
x forall a. Eq a => a -> a -> Bool
== a
y    = forall a. Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix [a]
xs' [a]
ys'
    | Bool
otherwise = ([a]
xs, [a]
ys)