{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module CabalGild.Unstable.Type.List where

import qualified CabalGild.Unstable.Extra.List as List
import qualified Data.Proxy as Proxy
import qualified Distribution.CabalSpecVersion as CabalSpecVersion
import qualified Distribution.Compat.Newtype as Newtype
import qualified Distribution.FieldGrammar.Newtypes as Newtypes
import qualified Distribution.Parsec as Parsec
import qualified Distribution.Pretty as Pretty
import qualified Text.PrettyPrint as PrettyPrint

-- | A thin wrapper around 'Newtypes.List'. This is used to define custom
-- instances of 'Pretty.Pretty' that use trailing commas when the Cabal spec
-- version is recent enough (at least @2.2@).
newtype List s b a = List
  { forall s b a. List s b a -> List s b a
unwrap :: Newtypes.List s b a
  }

instance Newtype.Newtype [a] (List s b a) where
  pack :: [a] -> List s b a
pack = List s b a -> List s b a
forall s b a. List s b a -> List s b a
List (List s b a -> List s b a)
-> ([a] -> List s b a) -> [a] -> List s b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> List s b a
forall o n. Newtype o n => o -> n
Newtype.pack
  unpack :: List s b a -> [a]
unpack = List s b a -> [a]
forall o n. Newtype o n => n -> o
Newtype.unpack (List s b a -> [a])
-> (List s b a -> List s b a) -> List s b a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List s b a -> List s b a
forall s b a. List s b a -> List s b a
unwrap

instance
  ( Newtype.Newtype a b,
    Parsec.Parsec b,
    Newtypes.Sep s
  ) =>
  Parsec.Parsec (List s b a)
  where
  parsec :: forall (m :: * -> *). CabalParsing m => m (List s b a)
parsec = List s b a -> List s b a
forall s b a. List s b a -> List s b a
List (List s b a -> List s b a) -> m (List s b a) -> m (List s b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (List s b a)
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m (List s b a)
Parsec.parsec

instance
  ( Newtype.Newtype a b,
    Pretty.Pretty b,
    Newtypes.Sep s
  ) =>
  Pretty.Pretty (List s b a)
  where
  pretty :: List s b a -> Doc
pretty = CabalSpecVersion -> List s b a -> Doc
forall a. Pretty a => CabalSpecVersion -> a -> Doc
Pretty.prettyVersioned CabalSpecVersion
CabalSpecVersion.CabalSpecV1_0
  prettyVersioned :: CabalSpecVersion -> List s b a -> Doc
prettyVersioned CabalSpecVersion
v =
    Proxy s -> [Doc] -> Doc
forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
Newtypes.prettySep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy.Proxy @s)
      ([Doc] -> Doc) -> (List s b a -> [Doc]) -> List s b a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Pretty a => CabalSpecVersion -> a -> Doc
Pretty.prettyVersioned @b CabalSpecVersion
v (b -> Doc) -> (a -> b) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall o n. Newtype o n => o -> n
Newtype.pack)
      ([a] -> [Doc]) -> (List s b a -> [a]) -> List s b a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List s b a -> [a]
forall o n. Newtype o n => n -> o
Newtype.unpack

-- | Overlaps the more general instance in order to use trailing commas when
-- possible.
instance
  {-# OVERLAPPING #-}
  ( Newtype.Newtype a b,
    Pretty.Pretty b
  ) =>
  Pretty.Pretty (List Newtypes.CommaFSep b a)
  where
  pretty :: List CommaFSep b a -> Doc
pretty = CabalSpecVersion -> List CommaFSep b a -> Doc
forall a. Pretty a => CabalSpecVersion -> a -> Doc
Pretty.prettyVersioned CabalSpecVersion
CabalSpecVersion.CabalSpecV1_0
  prettyVersioned :: CabalSpecVersion -> List CommaFSep b a -> Doc
prettyVersioned CabalSpecVersion
v =
    ( \[Doc]
xs ->
        if [Doc] -> Int -> Ordering
forall a. [a] -> Int -> Ordering
List.compareLength [Doc]
xs Int
1 Ordering -> Ordering -> Bool
forall a. Eq a => a -> a -> Bool
== Ordering
GT Bool -> Bool -> Bool
&& CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecVersion.CabalSpecV2_2
          then [Doc] -> Doc
PrettyPrint.fsep ([Doc] -> Doc) -> [Doc] -> Doc
forall a b. (a -> b) -> a -> b
$ (Doc -> Doc) -> [Doc] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Doc -> Doc -> Doc
forall a. Semigroup a => a -> a -> a
<> Doc
PrettyPrint.comma) [Doc]
xs
          else Proxy CommaFSep -> [Doc] -> Doc
forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
Newtypes.prettySep (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy.Proxy @Newtypes.CommaFSep) [Doc]
xs
    )
      ([Doc] -> Doc)
-> (List CommaFSep b a -> [Doc]) -> List CommaFSep b a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall a. Pretty a => CabalSpecVersion -> a -> Doc
Pretty.prettyVersioned @b CabalSpecVersion
v (b -> Doc) -> (a -> b) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> b
forall o n. Newtype o n => o -> n
Newtype.pack)
      ([a] -> [Doc])
-> (List CommaFSep b a -> [a]) -> List CommaFSep b a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List CommaFSep b a -> [a]
forall o n. Newtype o n => n -> o
Newtype.unpack