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

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

import CabalFmt.Prelude
import CabalFmt.Fields

exposedModulesF :: FieldDescrs () ()
exposedModulesF :: FieldDescrs () ()
exposedModulesF = FieldName
-> ([ModuleName] -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m [ModuleName])
-> FieldDescrs () ()
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 = FieldName
-> ([ModuleName] -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m [ModuleName])
-> FieldDescrs () ()
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 :: m [ModuleName]
parse = ([ModuleName] -> List VCat (MQuoted ModuleName) ModuleName)
-> List VCat (MQuoted ModuleName) ModuleName -> [ModuleName]
forall o n. Newtype o n => (o -> n) -> n -> o
unpack' (VCat
-> (ModuleName -> MQuoted ModuleName)
-> [ModuleName]
-> List VCat (MQuoted ModuleName) ModuleName
forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
C.alaList' VCat
C.VCat ModuleName -> MQuoted ModuleName
forall a. a -> MQuoted a
C.MQuoted) (List VCat (MQuoted ModuleName) ModuleName -> [ModuleName])
-> m (List VCat (MQuoted ModuleName) ModuleName) -> m [ModuleName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (List VCat (MQuoted ModuleName) ModuleName)
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
C.parsec

pretty :: [C.ModuleName] -> PP.Doc
pretty :: [ModuleName] -> Doc
pretty
    = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> ([ModuleName] -> [Doc]) -> [ModuleName] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> Doc) -> [ModuleName] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map ModuleName -> Doc
forall a. Pretty a => a -> Doc
C.pretty
    ([ModuleName] -> [Doc])
-> ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [ModuleName] -> [ModuleName]
forall a. Eq a => [a] -> [a]
nub
    ([ModuleName] -> [ModuleName])
-> ([ModuleName] -> [ModuleName]) -> [ModuleName] -> [ModuleName]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ModuleName -> ModuleName -> Ordering)
-> [ModuleName] -> [ModuleName]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([String] -> [String] -> Ordering
forall a. Ord a => [a] -> [a] -> Ordering
cmp ([String] -> [String] -> Ordering)
-> (ModuleName -> [String]) -> ModuleName -> ModuleName -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
strToLower ([String] -> [String])
-> (ModuleName -> [String]) -> ModuleName -> [String]
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 [a] -> [a] -> ([a], [a])
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')  -> [a] -> [a] -> Ordering
forall a. Ord a => a -> a -> Ordering
compare [a]
a' [a]
b'

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

dropCommonPrefix :: Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix :: [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 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
y    = [a] -> [a] -> ([a], [a])
forall a. Eq a => [a] -> [a] -> ([a], [a])
dropCommonPrefix [a]
xs' [a]
ys'
    | Bool
otherwise = ([a]
xs, [a]
ys)