{-# LANGUAGE Haskell2010, Safe, TypeFamilies #-}
-- {-# OPTIONS -Wall #-}

module Haskell.X.Prelude (
    
    Bool (True, False), (&&), (||), not, otherwise,

    Maybe (Nothing, Just), maybe, isJust, isNothing,
    fromJust, fromMaybe, listToMaybe, maybeToList, catMaybes,
    mapMaybe,

    Either (Left, Right), either, lefts, rights,
    partitionEithers, uneither,

    Ordering (LT, EQ, GT),

    Char,
    isControl, isSpace, isLower, isUpper, isAlpha, isAlphaNum,
    isPrint, isDigit, isOctDigit, isHexDigit, isLetter, isMark,
    isNumber, isPunctuation, isSymbol, isSeparator,
    isAscii, isLatin1, isAsciiUpper, isAsciiLower,

    IsString (fromString),

    toUpper, toLower, toTitle,
    digitToInt, intToDigit, ord, chr,

    AtLeastPair (..),
    curry, uncurry, swap,

    Eq ((==), (/=)),
    Ord (compare, (<), (>=), (>), (<=), max, min),
    Enum (succ, pred, toEnum, fromEnum, enumFrom, enumFromThen, enumFromTo, enumFromThenTo),
    Bounded (minBound, maxBound),

    Int, Integer, Float, Double,
    Int8, Int16, Int32, Int64,
    Word8, Word16, Word32, Word64,

    Rational, Ratio,

    Num (
        (+), (*), (-), negate, abs, signum, fromInteger
    ),
    Real (toRational),
    Integral (
        quot, rem, div, mod, quotRem, divMod, toInteger
    ),
    Fractional (
        (/), recip, fromRational
    ),
    Floating (
        pi, exp, sqrt, log, (**), logBase,
        sin, tan, cos, asin, atan, acos,
        sinh, tanh, cosh, asinh, atanh, acosh
    ),
    RealFrac (
        properFraction, truncate, round, ceiling, floor
    ),
    RealFloat (
        floatRadix, floatDigits, floatRange,
        decodeFloat, encodeFloat, exponent, significand,
        scaleFloat, isNaN, isInfinite, isDenormalized,
        isNegativeZero, isIEEE, atan2
    ),

    Complex, realPart, imagPart, mkPolar, cis, polar,
    magnitude, phase, conjugate,

    subtract, even, odd, gcd, lcm, (^), (^^),
    fromIntegral, realToFrac,

    Functor (fmap, (<$)),
    id, const, (.), flip, ($), fix, on,
    until, asTypeOf, error, undefined, seq, ($!),

    Applicative (pure, (<*>), (*>), (<*)),

    Monad ((>>=), (>>), return, fail), (=<<), (>=>), (<=<),
    forever, void, join,

    MonadPlus (mzero, mplus),
    mapM, mapM_, forM, forM_, sequence, sequence_,
    msum, mfilter, filterM,
    mapAndUnzipM, zipWithM, zipWithM_,
    foldM, foldM_,
    replicateM, replicateM_,
    guard, when, unless,
    liftM, liftM2, liftM3, liftM4, liftM5,
    ap,

    Monoid (mempty, mappend, mconcat),
    (<>),
    Dual (..), Endo (..),
    All (..), Any (..),
    Sum (..), Product (..),
    First (..), Last (..),

    Alternative ((<|>), empty, some, many),

    Const (..),
    WrappedMonad (..),
    WrappedArrow (..),
    ZipList (..),

    (<$>), (<**>), liftA, liftA2, liftA3, optional,

    Arrow (arr, first, second, (***), (&&&)),
    Kleisli (..),
    returnA, (^>>), (>>^), (>>>), (<<<),
    (<<^), (^<<),
    ArrowZero (zeroArrow),
    ArrowPlus ((<+>)),
    ArrowChoice (left, right, (+++), (|||)),
    ArrowApply (app),
    ArrowMonad (..),
    leftApp,

    ArrowLoop (loop),

    map, (++), (!!), reverse,
    filter, head, last, tail, init, null, length,

    Traversable (traverse, sequenceA),

    Foldable (fold, foldMap, foldr, foldl, foldr1, foldl1),
    foldrM, foldlM, traverse_, for_, sequenceA_, asum,
    foldl', foldr', toList, find,

    and, or, any, all, sum, product, concat, concatMap,
    maximum, minimum,

    scanl, scanl1, scanr, scanr1,

    iterate, repeat, replicate, cycle,
    take, drop, splitAt, takeWhile, dropWhile,
    span, break,

    elem, notElem, lookup,

    intersperse, intercalate, transpose, subsequences, permutations,
    mapAccumL, mapAccumR, unfoldr,

    stripPrefix, group, inits, tails, isPrefixOf, isSuffixOf, isInfixOf,
    partition, elemIndex, elemIndices, findIndex, findIndices,

    zip, zip3, zip4, zip5, zip6, zip7,
    zipWith, zipWith3, zipWith4, zipWith5, zipWith6, zipWith7,
    unzip, unzip3, unzip4, unzip5, unzip6, unzip7,

    nub, delete, union, intersect, sort, insert,
    nubBy, deleteBy, deleteFirstsBy, unionBy, intersectBy, groupBy,
    sortBy, insertBy, maximumBy, minimumBy,

    lines, words, unlines, unwords,

    ShowS, Show (..), shows, showChar, showString, showParen,
    ReadS, Read (..), reads, readParen, read, lex,

    IO,

    putChar, putStr, putStrLn, print,
    getChar, getLine, getContents, interact,

    readFile, writeFile, appendFile,
    readIO, readLn,

    (->>),

    SomeException, Exception (toException, fromException),

    IOException, ioError, userError,
    throw, throwIO, throwTo,
    catch, catches,

    Handler (Handler),

    catchJust,
    handle, handleJust,
    try, tryJust,
    evaluate,
    mapException,
    mask, mask_,
    uninterruptibleMask, uninterruptibleMask_,
    getMaskingState, allowInterrupt,

    assert, bracket, bracket_, bracketOnError, finally, onException,
    
    Data (..),
    Typeable (..),

    exhaustively, exhaustivelyM, exhaustivelyBy, exhaustivelyByM,
    uniqSort, aggregate, aggregateBy, aggregateAL, tr,
    segment2, segment3, count2, count3, count4

  ) where

import Prelude hiding (
    fst, snd, id, (.), catch,
    map, foldl, foldl1, foldr, foldr1, and, or,
    concat, minimum, maximum, all, any, sum, product,
    concatMap, elem, notElem,
    mapM_, sequence_
 )
import qualified Prelude

import Control.Applicative
import Control.Arrow
import Control.Category
import Control.Exception
import Control.Monad hiding (mapM_, sequence_, forM_, forM, msum)

import Data.Bool
import Data.Char
import Data.Complex
import Data.Data
import Data.Either
import Data.Foldable
import Data.Function (fix, on)
import Data.Functor
import Data.Int
import Data.List hiding (
    map, foldl, foldl1, foldr, foldr1, and, or,
    concat, minimum, maximum, all, any, sum, product,
    concatMap, elem, notElem, foldl', minimumBy, maximumBy,
    find, mapAccumL, mapAccumR
 )
import Data.Maybe (
    Maybe (..),
    fromJust, isJust, isNothing, listToMaybe,
    maybeToList, catMaybes, fromMaybe, mapMaybe
 )
import Data.Monoid (
    Monoid (..), (<>),
    Dual (..), Endo (..), All (..), Any (..),
    Sum (..), Product (..), First (..), Last (..)
 )
import Data.Ratio (
    Ratio, Rational
 )
import Data.String (
    IsString (..),
    lines, unlines, words, unwords
 )
import Data.Traversable hiding (mapM, sequence)
import Data.Tuple
import Data.Typeable
import Data.Word

import System.Environment
import System.Exit
import System.IO

import Haskell.X
import Haskell.X.Ops

map :: Functor f => (a -> b) -> f a -> f b
map = fmap

class AtLeastPair a where
    type Fst a
    type Snd a

    fst :: a -> Fst a
    snd :: a -> Snd a

instance AtLeastPair (a, b) where
    type Fst (a, b) = a
    type Snd (a, b) = b

    fst (a, _) = a
    snd (_, b) = b

instance AtLeastPair (a, b, c) where
    type Fst (a, b, c) = a
    type Snd (a, b, c) = b
    
    fst (a, _, _) = a
    snd (_, b, _) = b

instance AtLeastPair (a, b, c, d) where
    type Fst (a, b, c, d) = a
    type Snd (a, b, c, d) = b
    
    fst (a, _, _, _) = a
    snd (_, b, _, _) = b

instance AtLeastPair (a, b, c, d, e) where
    type Fst (a, b, c, d, e) = a
    type Snd (a, b, c, d, e) = b
    
    fst (a, _, _, _, _) = a
    snd (_, b, _, _, _) = b