{-# LANGUAGE OverloadedStrings #-} -- | -- License: GPL-3.0-or-later -- Copyright: Oleg Grenrus module CabalGild.Fields.Modules ( otherModulesF, exposedModulesF, ) where import CabalGild.Fields import CabalGild.Prelude 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 exposedModulesF :: FieldDescrs () () exposedModulesF = singletonF "exposed-modules" pretty parse otherModulesF :: FieldDescrs () () otherModulesF = singletonF "other-modules" pretty parse parse :: (C.CabalParsing m) => m [C.ModuleName] parse = unpack' (C.alaList' C.VCat C.MQuoted) <$> C.parsec pretty :: [C.ModuleName] -> PP.Doc pretty = PP.vcat . map C.pretty . nub . sortBy (cmp `on` map strToLower . C.components) where cmp :: (Ord a) => [a] -> [a] -> Ordering cmp a b = case dropCommonPrefix a b of ([], []) -> EQ ([], _ : _) -> LT (_ : _, []) -> GT (a', b') -> compare a' b' strToLower :: String -> String strToLower = map toLower dropCommonPrefix :: (Eq a) => [a] -> [a] -> ([a], [a]) dropCommonPrefix [] [] = ([], []) dropCommonPrefix [] ys = ([], ys) dropCommonPrefix xs [] = (xs, []) dropCommonPrefix xs@(x : xs') ys@(y : ys') | x == y = dropCommonPrefix xs' ys' | otherwise = (xs, ys)