{-# LANGUAGE CPP #-}

--------------------------------------------------

{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE PackageImports    #-}

--------------------------------------------------

{-| This module re-exports several "standard" typeclasses (that every type should derive, if it can), and their methods. It only re-exports other (non-typeclass, non-method) definitions when they are convenient for manually defining instances.

Also include some shims for backwards-compability (motivated by the 2018 @reflex-platform@). 


= Notes

Derive 'Lift':

* either automatically via @-XDeriveLift@;
* or manually, which requires importing the method too, @import Language.Haskell.TH.Syntax (Lift(..))@ (this doesn't re-export it because 'Language.Haskell.TH.Syntax.lift' is too broad a name). 


= Re-Exports

@deepseq@:

* 'NFData'
* 'NFData1' (and 'rnf1')
* 'NFData2' (and 'rnf2')
* 'seq', 'whnf' (helpers for manual instances)



@hashable@:

* 'Hashable'
* 'hashUsing' (helpers for manual instances)



@data-default-class@:

* 'Default'



@exceptions@:

* 'MonadThrow'
* 'MonadCatch'
* 'MonadMask'



@mtl@:

* 'MonadReader'
* 'MonadWriter'
* 'MonadState'
* 'MonadError'

@transformers@:

* 'MonadTrans'

@template-haskell@

* 'Lift'


@base@ "stock deriveable":

* 'Show'
* 'Read'
* 'Eq'
* 'Ord'
* 'Enum'
* 'Bounded'
* 'Ix'

syntax: 

* 'IsList'
* 'IsString'
* (and, sans extensions, 'Num', 'Enum')

@base@ numbers:

* 'Num'
* 'Real'
* 'Integral'
* 'Fractional'
* 'Floating'
* 'RealFrac'
* 'RealFloat'

@base@ monoid:

* 'Semigroup'
* 'Monoid'

@base@ functor:

* 'Functor'

@base@ containers:

* 'Foldable'
* 'Traversable'

@base@ applicative:

* 'Applicative'
* 'Alternative'

@base@ monad:

* 'Monad'
* 'MonadPlus'
* 'MonadFail'
* 'MonadFix'

@base@ arrow (which I don't use):

* 'Arrow'
* 'ArrowZero'
* 'ArrowPlus'
* 'ArrowChoice'
* 'ArrowApply'
* 'ArrowLoop'

@base@ category:

* 'Category'

@base@ bifunctors:

* 'Bifunctor'
* 'Bifoldable'
* 'Bitraversable'

@base@ generics:

* 'Generic'
* 'Data'
* 'Typeable'

@base@ ffi:

* 'Storable'

@base@ (miscellaneous):

* 'MonadIO'
* 'Exception'

@base@ unary liftings (of standard nullary classes):

* 'Eq1' (and 'eq1')
* 'Ord1' (and 'compare1')
* 'Show1' (and 'showsPrec1')
* 'Read1' (and 'readsPrec1')

@base@ binary liftings (of standard nullary classes):

* 'Eq2' (and 'eq2')
* 'Ord2' (and 'compare2')
* 'Show2' (and 'showsPrec2')
* 'Read2' (and 'readsPrec2')





NOTES

Foldable:

@Foldable@ doesn't subclass @Functor@, and it absorbs several "secondary functions" as "primary methods", for efficiency:

@
-- e.g. list, the canonical foldable

instance Foldable [] where
    elem    = List.elem
    foldl   = List.foldl
    foldl'  = List.foldl'
    foldl1  = List.foldl1
    foldr   = List.foldr
    foldr1  = List.foldr1
    length  = List.length
    maximum = List.maximum
    minimum = List.minimum
    null    = List.null
    product = List.product
    sum     = List.sum
    toList  = id
@


@

Lifted Classes:

@
-- e.g. given already-defined `<C>1` instances for some "functor" (unary type constructor) or "transformer" (binary type constructor)...

instance (Eq1   f) => Eq1   (Validated f) where ...
instance (Ord1  f) => Ord1  (Validated f) where ...
instance (Read1 f) => Read1 (Validated f) where ...
instance (Show1 f) => Show1 (Validated f) where ...

-- .. you can derive the `<C>` instances...

instance (Eq1 f,   Eq a,   Eq b)   => Eq   (Validated f a b) where
  (==) = eq1

instance (Ord1 f,  Ord a,  Ord b)  => Ord  (Validated f a b) where
  compare = compare1

instance (Read1 f, Read a, Read b) => Read (Validated f a b) where
  readPrec     = readPrec1
  readListPrec = readListPrecDefault
  
instance (Show1 f, Show a, Show b) => Show (Validated f a b) where
  showsPrec = showsPrec1
@


@
-- e.g. the `C1` lifted instances for `Maybe`...

instance 'Eq1' Maybe where
    liftEq _  Nothing  Nothing  = True
    liftEq _  Nothing  (Just _) = False
    liftEq _  (Just _) Nothing  = False
    liftEq eq (Just x) (Just y) = eq x y

instance 'Ord1' Maybe where
    liftCompare _ Nothing Nothing = EQ
    liftCompare _ Nothing (Just _) = LT
    liftCompare _ (Just _) Nothing = GT
    liftCompare comp (Just x) (Just y) = comp x y

instance 'Read1' Maybe where
    liftReadPrec rp _ =
        parens ('expectP' ('Ident' "Nothing") *> pure Nothing)
        <|>
        readData ('readUnaryWith' rp "Just" Just)

    liftReadListPrec = 'liftReadListPrecDefault'
    liftReadList     = 'liftReadListDefault'

instance 'Show1' Maybe where
    liftShowsPrec _  _ _ Nothing  = 'showString' "Nothing"
    liftShowsPrec sp _ d (Just x) = 'showsUnaryWith' sp "Just" d x
@


@
-- e.g. the `C2` lifted instances for `Either`...

instance 'Eq2' Either where
    liftEq2 eq1 _  (Left  x) (Left  y) = eq1 x y
    liftEq2 _   _  (Left  _) (Right _) = False
    liftEq2 _   _  (Right _) (Left  _) = False
    liftEq2 _  eq2 (Right x) (Right y) = eq2 x y

instance 'Ord2' Either where
    liftCompare2 comp1 _     (Left  x) (Left  y) = comp1 x y
    liftCompare2 _     _     (Left  _) (Right _) = LT
    liftCompare2 _     _     (Right _) (Left  _) = GT
    liftCompare2 _     comp2 (Right x) (Right y) = comp2 x y

instance 'Read2' Either where
    liftReadPrec2 rp1 _ rp2 _ = 'readData' $ 'asum'
         [ readUnaryWith rp1 "Left"  Left 
         , readUnaryWith rp2 "Right" Right
         ]

    liftReadListPrec2 = 'liftReadListPrec2Default'
    liftReadList2     = 'liftReadList2Default'

instance 'Show2' Either where
    liftShowsPrec2 sp1 _ _   _ d (Left  x)
        = showsUnaryWith sp1 "Left" d x
    liftShowsPrec2 _   _ sp2 _ d (Right x)
        = showsUnaryWith sp2 "Right" d x

@


Standard Numeric Classes (copied from the @The Haskell 98 Report@):

@
class  ('Eq' a) => 'Num' a  where
    ('+'), ('-'), ('*')   :: a -> a -> a
    'negate'          :: a -> a
    'abs', 'signum'     :: a -> a
    'fromInteger'     :: Integer -> a

class  (Num 'a', Ord a) => 'Real' a  where
    'toRational' ::  a -> Rational

class  (Real a, 'Enum' a) => 'Integral' a  where
    'quot', 'rem', 'div', 'mod' :: a -> a -> a
    'quotRem', 'divMod'     :: a -> a -> (a,a)
    'toInteger'           :: a -> Integer

class  (Num a) => 'Fractional' a  where
    ('/')          :: a -> a -> a
    'recip'        :: a -> a
    'fromRational' :: Rational -> a

class  (Fractional a) => 'Floating' a  where
    'pi'                  :: a
    'exp', 'log', 'sqrt'      :: a -> a
    ('**'), 'logBase'       :: a -> a -> a
    'sin', 'cos', 'tan'       :: a -> a
    'asin', 'acos', 'atan'    :: a -> a
    'sinh', 'cosh', 'tanh'    :: a -> a
    'asinh', 'acosh', 'atanh' :: a -> a

class  (Real a, Fractional a) => 'RealFrac' a  where
    'properFraction'  :: (Integral b) => a -> (b,a)
    'truncate', 'round' :: (Integral b) => a -> b
    'ceiling', 'floor'  :: (Integral b) => a -> b

class  (RealFrac a, Floating a) => 'RealFloat' a  where
    'floatRadix'  :: a -> Integer
    'floatDigits' :: a -> Int
    'floatRange'  :: a -> (Int,Int)
    'decodeFloat' :: a -> (Integer,Int)
    'encodeFloat' :: Integer -> Int -> a
    'exponent'    :: a -> Int
    'significand' :: a -> a
    'scaleFloat'  :: Int -> a -> a
    'isNaN', 'isInfinite', 'isDenormalized', 'isNegativeZero', 'isIEEE' 
                :: a -> Bool
    'atan2'       :: a -> a -> a

-- 
'gcd', 'lcm' :: (Integral a) => a -> a-> a
('^')      :: (Num a, Integral b) => a -> b -> a
('^^')     :: (Fractional a, Integral b) => a -> b -> a
-- 
'fromIntegral' :: (Integral a, Num b) => a -> b
'realToFrac'   :: (Real a, Fractional b) => a -> b

@


Standard Enumeration Classes:

@

class Ord a => 'Ix' a where

For an enumeration, the nullary constructors are assumed to be numbered left-to-right with the indices being 0 to n-1 inclusive, like @Enum@. For example:

       data Colour = Red | Orange | Yellow | Green | Blue | Indigo | Violet

       'range'   (Yellow,Blue)        ==  [Yellow,Green,Blue]
       'index'   (Yellow,Blue) Green  ==  1
       'inRange' (Yellow,Blue) Red    ==  False
@

-}

--------------------------------------------------

module Prelude.Spiros.Classes

--------------------------------------------------

  ( module X
  , module Prelude.Spiros.Classes
  ) where

--------------------------------------------------

#include <sboo-base-feature-macros.h>

--------------------------------------------------
-- `deepseq`
--------------------------------------------------

import "deepseq" Control.DeepSeq                     as X (NFData(..))
import "base"    Prelude                             as X (seq)

#if HAS_DEEPSEQ_NFData1
import "deepseq" Control.DeepSeq                     as X (NFData1(..))
import "deepseq" Control.DeepSeq                     as X (rnf1)
#endif

#if HAS_DEEPSEQ_NFData2
import "deepseq" Control.DeepSeq                     as X (NFData2(..))
import "deepseq" Control.DeepSeq                     as X (rnf2)
#endif

#if MIN_VERSION_deepseq(1,4,3)
import "deepseq" Control.DeepSeq                     as X (rwhnf)
#else
-- see below
#endif

--------------------------------------------------
-- `hashable`
--------------------------------------------------

import "hashable" Data.Hashable                      as X (Hashable(..))
import "hashable" Data.Hashable                      as X (hashUsing)

#if HAS_HASHABLE_Hashable1
import "hashable" Data.Hashable.Lifted               as X (Hashable1(..))
import "hashable" Data.Hashable.Lifted               as X (hashWithSalt1)
#endif

#if HAS_HASHABLE_Hashable2
import "hashable" Data.Hashable.Lifted               as X (Hashable2(..))
import "hashable" Data.Hashable.Lifted               as X (hashWithSalt2)
#endif

--------------------------------------------------
-- `data-default-class`
--------------------------------------------------

import "data-default-class" Data.Default.Class       as X (Default(..))

--------------------------------------------------
-- `semigroups`
--------------------------------------------------

import "semigroups" Data.Semigroup.Generic           as X
 ( gmappend, gmempty
 )

--------------------------------------------------
-- `exceptions`
--------------------------------------------------

import "exceptions" Control.Monad.Catch              as X (MonadThrow(..))
import "exceptions" Control.Monad.Catch              as X (MonadCatch(..))
import "exceptions" Control.Monad.Catch              as X (MonadMask(..))

--------------------------------------------------
-- `generic-deriving`
--------------------------------------------------

import "generic-deriving" Generics.Deriving.Enum     as X
 ( GEnum(..)
 -- , GIx -- NOTE GIx's methods conflict with Ix.
 )

--------------------------------------------------
-- `mtl`
--------------------------------------------------

import "mtl" Control.Monad.Reader.Class              as X (MonadReader(..))
import "mtl" Control.Monad.Writer.Class              as X (MonadWriter(..))
import "mtl" Control.Monad.State.Class               as X (MonadState(..))
import "mtl" Control.Monad.Error.Class               as X (MonadError(..))

--------------------------------------------------
-- `transformers`
--------------------------------------------------

import "transformers" Control.Monad.Trans.Class      as X (MonadTrans(..))

--------------------------------------------------
-- `template-haskell`
--------------------------------------------------

import "template-haskell" Language.Haskell.TH.Syntax as X (Lift)

--------------------------------------------------
-- `base:Prelude`
--------------------------------------------------

import "base" Prelude                                as X (Show(..))
import "base" Prelude                                as X (Read(..))

import "base" Prelude                                as X (Eq(..))
import "base" Prelude                                as X
 (Ord((<=),(>=))) -- hide `>` / `<`

import "base" Prelude                                as X (Num(..))
import "base" Prelude                                as X (Real(..))
import "base" Prelude                                as X (Integral(..))
import "base" Prelude                                as X (Fractional(..))
import "base" Prelude                                as X (Floating(..))
import "base" Prelude                                as X (RealFrac(..))
import "base" Prelude                                as X (RealFloat(..))

--------------------------------------------------
-- `base`
--------------------------------------------------

import "base" Prelude                                as X (Enum(..))
import "base" Prelude                                as X (Bounded(..))
import "base" Data.Ix                                as X (Ix(..))
import "base" Data.Bits                              as X (Bits(..), FiniteBits(..))

import "base" Data.Monoid                            as X (Monoid(..))

import "base" Data.Functor                           as X (Functor(..))
import "base" Data.Foldable                          as X (Foldable(elem,foldl,foldl',foldl1,foldr,foldr1,length,maximum,minimum,null,product,sum)) -- `Foldable(toList)` conflicts with `IsList(toList)`
import "base" Data.Traversable                       as X (Traversable(..))

import "base" Control.Applicative                    as X (Applicative(..))
import "base" Control.Applicative                    as X (Alternative(..))

import "base" Control.Monad                          as X
 (Monad((>>=),return,(>>))) -- hide `fail`
import "base" Control.Monad                          as X (MonadPlus(..))

import "base" Control.Monad.Fix                      as X (MonadFix(..))

import "base" Control.Arrow                          as X (Arrow)
import "base" Control.Arrow                          as X (ArrowZero)
import "base" Control.Arrow                          as X (ArrowPlus)
import "base" Control.Arrow                          as X (ArrowChoice)
import "base" Control.Arrow                          as X (ArrowApply)
import "base" Control.Arrow                          as X (ArrowLoop)

import "base" Control.Category                       as X
 (Category) -- can't export `(.)` and `id`, which conflict with their specializations TODO?

import "base" Control.Exception                      as X (Exception(..))

import "base" Text.ParserCombinators.ReadP           as X
 ( ReadP,ReadS
 , readP_to_S,readS_to_P
 )
 -- for writing `Read` instances

import "base" Foreign.Storable                       as X (Storable(..))

{-

import "base" Text.Printf                            as X (PrintfArg(..))

import "base" Control.Category                       as X (Category(..))

import "string-conv" Data.String.Conv                as X (StringConv (..),Leniency (..))

import "base" Control.Arrow                          as X (Arrow(..))
import "base" Control.Arrow                          as X (ArrowZero(..))
import "base" Control.Arrow                          as X (ArrowPlus(..))
import "base" Control.Arrow                          as X (ArrowChoice(..))
import "base" Control.Arrow                          as X (ArrowApply(..))
import "base" Control.Arrow                          as X (ArrowLoop(..))

-}

--------------------------------------------------
-- Imports: CPP ----------------------------------
--------------------------------------------------

#if HAS_MONAD_FAIL
import "base" Control.Monad.Fail                     as X (MonadFail(..))
#endif

--------------------------------------------------

#if HAS_BASE_Semigroup
import "base" Data.Semigroup                         as X (Semigroup(..))
#endif

--------------------------------------------------

#if HAS_BASE_Bifunctor
import "base" Data.Bifunctor                         as X (Bifunctor(..))
#endif

--------------------------------------------------

#if HAS_BASE_Bifoldable_Bitraversable
import "base" Data.Bifoldable                        as X (Bifoldable(..))
import "base" Data.Bitraversable                     as X (Bitraversable(..))
#endif

--------------------------------------------------

#if HAS_BASE_MonadIO
import "base" Control.Monad.IO.Class                 as X (MonadIO(..))
#endif

--------------------------------------------------

#if HAS_BASE_UNARY_LIFTED_CLASSES
-- unary lifted classes
import "base" Data.Functor.Classes                          as X (Eq1(..),eq1)
import "base" Data.Functor.Classes                          as X (Ord1(..),compare1)
import "base" Data.Functor.Classes                          as X (Show1(..),showsPrec1)
import "base" Data.Functor.Classes                          as X (Read1(..),readsPrec1)
#endif

--------------------------------------------------

#if HAS_BASE_BINARY_LIFTED_CLASSES
-- binary lifted classes
import "base" Data.Functor.Classes                          as X (Eq2(..),eq2)
import "base" Data.Functor.Classes                          as X (Ord2(..),compare2)
import "base" Data.Functor.Classes                          as X (Show2(..),showsPrec2)
import "base" Data.Functor.Classes                          as X (Read2(..),readsPrec2)
#endif

--------------------------------------------------

#if HAS_BASE_Contravariant
import "base" Data.Functor.Contravariant                    as X
 ( Contravariant(..)
 )
#endif

--------------------------------------------------

#if IS_COMPILER_ghc
import "base" GHC.Generics                           as X (Generic, Rep)
import "base" GHC.Generics                           as X (Generic1, Rep1)
import "base" Data.Data                              as X (Data)
--import "base" Data.Typeable                          as X (Typeable)
import "base" GHC.Exts                               as X (IsList(Item,fromList))
 -- hide `toList`
import "base" GHC.Exts                               as X (IsString(..))
#endif

--------------------------------------------------
-- Non-Export Imports ----------------------------
--------------------------------------------------

#if IS_COMPILER_ghc
import qualified "base" GHC.Generics                 as Generic
#endif

--------------------------------------------------
-- Definitions -----------------------------------
--------------------------------------------------

-- shims for backwards-compability (motivated by the `2018 reflex-platform`)

#if MIN_VERSION_deepseq(1,4,3)
-- see above
#else
rwhnf :: a -> ()
rwhnf = (`seq` ())
#endif

--------------------------------------------------
-- generics

#if defined(__GLASGOW_HASKELL__)
-- | A generic representation, "specialized" to no additional metadata. 
--
-- (it still has the normal metadata about arity, constructor source location, field properties, etc). 
-- 
type Rep_ a = Rep a ()

-- | Convert from the datatype to its generic representation. 
--
-- @= 'Generic.from'@
--
-- Naming: like @fromEnum :: a -> Int@,
-- i.e. from the perspective of the instance type @a@. 
-- 
fromGeneric :: (Generic a) => a -> Rep a x
fromGeneric = Generic.from

-- | Convert to a generic representation from the datatype. 
--
-- @= 'Generic.to'@
--
-- Naming: like @toEnum :: Int -> a@,
-- i.e. from the perspective of the instance type @a@. 
-- 
toGeneric :: (Generic a) => Rep a x -> a
toGeneric = Generic.to

-- | Convert from the datatype to its generic representation. 
--
-- @= 'Generic.from1'@
--
-- Naming: like @fromEnum :: a -> Int@,
-- i.e. from the perspective of the instance type @a@. 
-- 
fromGeneric1 :: (Generic1 f) => f a -> Rep1 f a
fromGeneric1 = Generic.from1

-- | Convert to a generic representation from the datatype. 
--
-- @= 'Generic.to1'@
--
-- Naming: like @toEnum :: Int -> a@,
-- i.e. from the perspective of the instance type @a@. 
-- 
toGeneric1 :: (Generic1 f) => Rep1 f a -> f a
toGeneric1 = Generic.to1
#endif

--------------------------------------------------
-- Notes / Old Code / Other Comments -------------
--------------------------------------------------

--warning: [-Wdodgy-exports]
--    The export item `module Prelude.Spiros.Classes' exports nothing

{-TODO

class PrintfArg a where

Extending To New Types
This printf can be extended to format types other than those provided for by default. This is done by instantiating PrintfArg and providing a formatArg for the type. It is possible to provide a parseFormat to process type-specific modifiers, but the default instance is usually the best choice.

For example:

instance PrintfArg () where
  formatArg x fmt | fmtChar (vFmt 'U' fmt) == 'U' =
    formatString "()" (fmt { fmtChar = 's', fmtPrecision = Nothing })
  formatArg _ fmt = errorBadFormat $ fmtChar fmt

main :: IO ()
main = printf "[%-3.1U]\n" ()
prints "[() ]". Note the use of formatString to take care of field formatting specifications in a convenient way.


-}
--------------------------------------------------