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

import System.FilePath.Posix (splitDirectories)

import qualified Distribution.Fields          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.Fields
import CabalFmt.Prelude

sourceFilesF :: [FieldDescrs () ()]
sourceFilesF :: [FieldDescrs () ()]
sourceFilesF =
    [ FieldName
-> ([FilePath] -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m [FilePath])
-> FieldDescrs () ()
forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
f [FilePath] -> Doc
pretty forall (m :: * -> *). CabalParsing m => m [FilePath]
parse
    | FieldName
f <- [FieldName]
fileFields
    ]

fileFields :: [C.FieldName]
fileFields :: [FieldName]
fileFields =
    [ FieldName
"extra-source-files"
    , FieldName
"extra-doc-files"
    , FieldName
"data-files"
    , FieldName
"license-files"
    , FieldName
"asm-sources"
    , FieldName
"cmm-sources"
    , FieldName
"c-sources"
    , FieldName
"cxx-sources"
    , FieldName
"js-sources"
    , FieldName
"includes"
    , FieldName
"install-includes"
    ]

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

pretty :: [FilePath] -> PP.Doc
pretty :: [FilePath] -> Doc
pretty
    = [Doc] -> Doc
PP.vcat ([Doc] -> Doc) -> ([FilePath] -> [Doc]) -> [FilePath] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> Doc) -> [FilePath] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> Doc
C.showFilePath
    ([FilePath] -> [Doc])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub
    ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath -> FilePath -> Ordering) -> [FilePath] -> [FilePath]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy ([FilePath] -> [FilePath] -> Ordering
forall a. Ord a => [a] -> [a] -> Ordering
cmp ([FilePath] -> [FilePath] -> Ordering)
-> (FilePath -> [FilePath]) -> FilePath -> FilePath -> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
strToLower ([FilePath] -> [FilePath])
-> (FilePath -> [FilePath]) -> FilePath -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
splitDirectories)
  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 :: FilePath -> FilePath
strToLower = (Char -> Char) -> FilePath -> FilePath
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)