content: {-# LANGUAGE DeriveDataTypeable #-}
  module Distribution.Utils.NubList
      ( NubList    -- opaque
      , toNubList  -- smart construtor
      , fromNubList
      , overNubList
  
      , NubListR
      , toNubListR
      , fromNubListR
      , overNubListR
      ) where
  
  import Prelude ()
  import Distribution.Compat.Prelude
  
  import Distribution.Simple.Utils
  
  import qualified Text.Read as R
  
  -- | NubList : A de-duplicated list that maintains the original order.
  newtype NubList a =
      NubList { fromNubList :: [a] }
      deriving (Eq, Typeable)
  
  -- NubList assumes that nub retains the list order while removing duplicate
  -- elements (keeping the first occurence). Documentation for "Data.List.nub"
  -- does not specifically state that ordering is maintained so we will add a test
  -- for that to the test suite.
  
  -- | Smart constructor for the NubList type.
  toNubList :: Ord a => [a] -> NubList a
  toNubList list = NubList $ ordNub list
  
  -- | Lift a function over lists to a function over NubLists.
  overNubList :: Ord a => ([a] -> [a]) -> NubList a -> NubList a
  overNubList f (NubList list) = toNubList . f $ list
  
  -- | Monoid operations on NubLists.
  -- For a valid Monoid instance we need to satistfy the required monoid laws;
  -- identity, associativity and closure.
  --
  -- Identity : by inspection:
  --      mempty `mappend` NubList xs == NubList xs `mappend` mempty
  --
  -- Associativity : by inspection:
  --      (NubList xs `mappend` NubList ys) `mappend` NubList zs
  --      == NubList xs `mappend` (NubList ys `mappend` NubList zs)
  --
  -- Closure : appending two lists of type a and removing duplicates obviously
  -- does not change the type.
  
  instance Ord a => Monoid (NubList a) where
      mempty = NubList []
      mappend = (<>)
  
  instance Ord a => Semigroup (NubList a) where
      (NubList xs) <> (NubList ys) = NubList $ xs `listUnion` ys
  
  instance Show a => Show (NubList a) where
      show (NubList list) = show list
  
  instance (Ord a, Read a) => Read (NubList a) where
      readPrec = readNubList toNubList
  
  -- | Helper used by NubList/NubListR's Read instances.
  readNubList :: (Read a) => ([a] -> l a) -> R.ReadPrec (l a)
  readNubList toList = R.parens . R.prec 10 $ fmap toList R.readPrec
  
  -- | Binary instance for 'NubList a' is the same as for '[a]'. For 'put', we
  -- just pull off constructor and put the list. For 'get', we get the list and
  -- make a 'NubList' out of it using 'toNubList'.
  instance (Ord a, Binary a) => Binary (NubList a) where
      put (NubList l) = put l
      get = fmap toNubList get
  
  -- | NubListR : A right-biased version of 'NubList'. That is @toNubListR
  -- ["-XNoFoo", "-XFoo", "-XNoFoo"]@ will result in @["-XFoo", "-XNoFoo"]@,
  -- unlike the normal 'NubList', which is left-biased. Built on top of
  -- 'ordNubRight' and 'listUnionRight'.
  newtype NubListR a =
      NubListR { fromNubListR :: [a] }
      deriving Eq
  
  -- | Smart constructor for the NubListR type.
  toNubListR :: Ord a => [a] -> NubListR a
  toNubListR list = NubListR $ ordNubRight list
  
  -- | Lift a function over lists to a function over NubListRs.
  overNubListR :: Ord a => ([a] -> [a]) -> NubListR a -> NubListR a
  overNubListR f (NubListR list) = toNubListR . f $ list
  
  instance Ord a => Monoid (NubListR a) where
    mempty = NubListR []
    mappend = (<>)
  
  instance Ord a => Semigroup (NubListR a) where
    (NubListR xs) <> (NubListR ys) = NubListR $ xs `listUnionRight` ys
  
  instance Show a => Show (NubListR a) where
    show (NubListR list) = show list
  
  instance (Ord a, Read a) => Read (NubListR a) where
      readPrec = readNubList toNubListR
  