{-|

  This library provides couple utility functions and re-exports some
  useful modules.

  Some modules are useful but names of functions in them are
  confliting to Prelude's one. So if we want to use them, we need
  qualified import or specifing no implict importing prelude.

  This library takes over these boilerplates.

  So, write after your module header

  > import Prelude ()
  > import Prelude.Plus
  >
  > -- Then your code goes here.

  So you can use function @or@ has type @Traversable t => t Bool ->
  Bool@, @putStrLn@ works for any utf8 strings, even Applicative
  operators, etc.

  Yes, <Control.Applicative> doesn't need qualified importing but
  importing such modules are also boilerplates, IMO.

-}
module Prelude.Plus (
  -- * Exposed modules
  module Control.Applicative
, module Control.Arrow
, module Control.Exception
, module Data.Traversable
, module Data.Foldable
, module Data.Monoid
, module Data.List
, module Data.Function
, module Prelude
, module System.IO
, module System.IO.UTF8
, module System.Environment.UTF8

  -- * Misc Tuple Functions
, dup, swap

  -- * Generic Functions
, null, size
) where

-- import Prelude but hiding some functions
import Prelude hiding (
    catch,ioError
  , appendFile,getContents,getLine,interact
  , print,putStr,putStrLn,readFile,readLn,writeFile
  , foldr,all,and,any,concat,concatMap,elem,null
  , foldl,foldr1,notElem,or,mapM,sequence,mapM_,sequence_,foldl1
  , maximum,minimum,product,sum )

-- importing utility modules
import Control.Applicative
import Control.Arrow
import Control.Exception
import Data.Traversable
import Data.Foldable
import Data.Monoid

-- XXX: operations for Sets are not polymorphic
import Data.List hiding (
    foldr,all,and,any,concat,concatMap,elem,foldl,foldr1
  , notElem,or,foldl1,maximum,minimum,product,sum,find,foldl'
  , maximumBy,minimumBy,mapAccumL,mapAccumR,null
  , (++),map,(!!),break,cycle,drop,dropWhile,filter
  , head,init,iterate,last,length,lookup,repeat,replicate
  , reverse,scanl,scanl1,scanr,scanr1,span,splitAt,tail,take
  , takeWhile,unzip,unzip3,zip,zip3,zipWith,zipWith3,lines
  , unlines,unwords,words )
import Data.Function hiding ((.),($),const,flip,id)

-- using utf8-string for any io
-- but ghc >= 6.12 ghc's Handle will recognize arbitrary encodings
import System.IO hiding (
    IO,FilePath,appendFile,getContents,getLine,interact
  , print,putStr,putStrLn,readFile,readLn,writeFile
  , hGetContents,hGetLine,hPutStr,hPutStrLn
  , openBinaryFile,withBinaryFile
  , getChar,putChar,readIO )
import System.IO.UTF8
import System.Environment.UTF8

dup :: a -> (a,a)
dup a = (a,a)

swap :: (a,b) -> (b,a)
swap ~(a,b) = (b,a)

null :: (Foldable t) => t a -> Bool
null = foldr (const . const False) True

size :: (Foldable t) => t a -> Int
size = getSum . foldMap (const $ Sum 1)