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

import qualified Distribution.FieldGrammar  as C
import qualified Distribution.Parsec        as C
import qualified Distribution.Pretty        as C
import qualified Language.Haskell.Extension as C
import qualified Text.PrettyPrint           as PP

import CabalFmt.Fields
import CabalFmt.Prelude

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

defaultExtensionsF :: FieldDescrs () ()
defaultExtensionsF :: FieldDescrs () ()
defaultExtensionsF = forall f s a.
FieldName
-> (f -> Doc)
-> (forall (m :: * -> *). CabalParsing m => m f)
-> FieldDescrs s a
singletonF FieldName
"default-extensions" [Extension] -> Doc
pretty forall (m :: * -> *). CabalParsing m => m [Extension]
parse

parse :: C.CabalParsing m => m [C.Extension]
parse :: forall (m :: * -> *). CabalParsing m => m [Extension]
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' FSep
C.FSep 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.Extension] -> PP.Doc
pretty :: [Extension] -> 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 b a. Ord b => (a -> b) -> [a] -> [a]
sortOn forall a. Pretty a => a -> String
C.prettyShow