{-# LANGUAGE TypeOperators              #-}
{-# LANGUAGE FlexibleContexts           #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE MultiParamTypeClasses      #-}
{-# LANGUAGE OverlappingInstances       #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Generics.EMGM.Functions.Collect
-- Copyright   :  (c) 2008 Universiteit Utrecht
-- License     :  BSD3
--
-- Maintainer  :  generics@haskell.org
-- Stability   :  experimental
-- Portability :  non-portable
--
-- Summary: Generic function that collects all values of a specified type from a
-- generic value.
--
-- 'collect' works by searching a datatype for values that are the same type as
-- the return type specified. Here are some examples using the same value but
-- different return types:
--
-- @
--   GHCi> collect [Just 1, Nothing, Just (2 :: Int)] :: [Int]
--   [1,2]
--   GHCi> collect [Just 1, Nothing, Just (2 :: Int)] :: [Maybe Int]
--   [Just 1,Nothing,Just 2]
--   GHCi> collect [Just 1, Nothing, Just (2 :: Int)] :: [[Maybe Int]]
--   [[Just 1,Nothing,Just 2]]
-- @
--
-- Note that the number @2@ has the type @Int@. Some arguments (such as numeric
-- constants which have type @Num a => a@) may need explicit type annotations.
-- By design, there is no connection that can be inferred between the return
-- type and the argument type.
--
-- 'collect' only works if the return type has been made an instance of 'Rep'.
-- The library provides instances for all datatypes with included
-- representation.
--
-- An instance is trivial to write. Given a type @D@, the 'Rep' instance looks
-- like this:
--
-- >  {-# LANGUAGE OverlappingInstances #-}
-- >
-- >  data D = ...
-- >
-- >  instance Rep (Collect D) D where
-- >    rep = Collect (:[])
--
-- (Note the requirement of overlapping instances.) This instance triggers when
-- the result type (the first @D@) matches some value type (the second @D@)
-- contained within the argument to 'collect'. See the source of this module for
-- more examples.
-----------------------------------------------------------------------------

module Generics.EMGM.Functions.Collect (
  Collect(..),
  collect,
) where

import Generics.EMGM.Common

-----------------------------------------------------------------------------
-- Types
-----------------------------------------------------------------------------

-- | Type for 'collect'
newtype Collect b a = Collect { selCollect :: a -> [b] }

-----------------------------------------------------------------------------
-- Generic instance declaration
-----------------------------------------------------------------------------

rconstantCollect :: a -> [b]
rconstantCollect _ = []

rsumCollect :: Collect c a -> Collect c b -> a :+: b -> [c]
rsumCollect ra _  (L a) = selCollect ra a
rsumCollect _  rb (R b) = selCollect rb b

rprodCollect :: Collect c a -> Collect c b -> a :*: b -> [c]
rprodCollect ra rb (a :*: b) = selCollect ra a ++ selCollect rb b

rtypeCollect :: EP b a -> Collect c a -> b -> [c]
rtypeCollect ep ra b = selCollect ra (from ep b)

rconCollect :: ConDescr -> Collect c a -> a -> [c]
rconCollect _ = selCollect

instance Generic (Collect b) where
  rconstant      = Collect rconstantCollect
  rsum     ra rb = Collect (rsumCollect ra rb)
  rprod    ra rb = Collect (rprodCollect ra rb)
  rcon  cd ra    = Collect (rconCollect cd ra)
  rtype ep ra    = Collect (rtypeCollect ep ra)

-----------------------------------------------------------------------------
-- Rep instance declarations
-----------------------------------------------------------------------------

instance Rep (Collect Int) Int where
  rep = Collect (:[])

instance Rep (Collect Integer) Integer where
  rep = Collect (:[])

instance Rep (Collect Float) Float where
  rep = Collect (:[])

instance Rep (Collect Double) Double where
  rep = Collect (:[])

instance Rep (Collect Char) Char where
  rep = Collect (:[])

instance Rep (Collect Bool) Bool where
  rep = Collect (:[])

instance Rep (Collect (Either a b)) (Either a b) where
  rep = Collect (:[])

instance Rep (Collect [a]) [a] where
  rep = Collect (:[])

instance Rep (Collect (Maybe a)) (Maybe a) where
  rep = Collect (:[])

instance Rep (Collect ()) () where
  rep = Collect (:[])

instance Rep (Collect (a,b)) (a,b) where
  rep = Collect (:[])

instance Rep (Collect (a,b,c)) (a,b,c) where
  rep = Collect (:[])

instance Rep (Collect (a,b,c,d)) (a,b,c,d) where
  rep = Collect (:[])

instance Rep (Collect (a,b,c,d,e)) (a,b,c,d,e) where
  rep = Collect (:[])

instance Rep (Collect (a,b,c,d,e,f)) (a,b,c,d,e,f) where
  rep = Collect (:[])

instance Rep (Collect (a,b,c,d,e,f,h)) (a,b,c,d,e,f,h) where
  rep = Collect (:[])

-----------------------------------------------------------------------------
-- Exported functions
-----------------------------------------------------------------------------

-- | Collect values of type @b@ from some value of type @a@. An empty list means
-- no values were collected. If you expected otherwise, be sure that you have an
-- instance such as @'Rep' ('Collect' B) B@ for the type @B@ that you are
-- collecting. See the description of this module for details.
collect :: (Rep (Collect b) a) => a -> [b]
collect = selCollect rep