{-# OPTIONS_GHC -fno-warn-orphans #-}

module Hydrogen.Prelude (
    module Prelude
  , module Control.Applicative
  , module Control.Arrow
  , module Control.Monad
  , module Data.Array
  , module Data.Bits
  , module Data.Bool
  , module Data.Char
  , module Data.Complex
  , module Data.Dynamic
  , module Data.Either
  , module Data.Fixed
  , module Data.Function
  , module Data.Functor.Identity
  , module Data.Functor.Reverse
  , module Data.Hashable
  , module Data.Foldable
  , module Data.Int
  , module Data.Ix
  , module Data.List
  , module Data.Maybe
  , module Data.Ord
  , module Data.Ratio
  , module Data.Serialize
  , module Data.String
  , module Data.Time
  , module Data.Time.Calendar.OrdinalDate
  , module Data.Traversable
  , module Data.Tuple
  , module Data.Typeable
  , module Data.Word
  , module Hydrogen.Version
  , module Numeric
  , module Text.Printf
  , (.&)
  , (.|)
  , (.^)
  , (=~)
  , (=~~)
  , (|>)
  , ($$)
  , ($$$)
  , ($$$$)
  , ($$$$$)
  , (<$$>)
  , (<$$$>)
  , (<$$$$>)
  , (<$$$$$>)
  , uuidFromString
  , randomUUID
  , safeHead
  , safeHeadAndTail
  , safeHeadAndTail2
  , firstJust
  , uncurry3
  , uncurry4
  , uncurry5
  , map
  , UUID
  , Generic
  , List
  , Map
  , MultiMap
  , Seq
  , Set
  , ShowBox
  , TMap (..)
  , Has (..)
  , Container (..)
  , Default (..)
  , Apply (..)
  , Applicator
  , __
  ) where

import "base" Prelude hiding (
    all
  , and
  , any
  , concat
  , concatMap
  , elem
  , foldl
  , foldl1
  , foldr
  , foldr1
  , map
  , mapM
  , mapM_
  , maximum
  , minimum
  , notElem
  , or
  , product
  , sequence
  , sequence_
  , sum
  )

import "base" Control.Applicative
import "base" Control.Arrow
import "base" Control.Monad hiding (
    forM
  , forM_
  , mapM
  , mapM_
  , msum
  , sequence
  , sequence_
  )

import "array" Data.Array hiding ((!))
import qualified "array" Data.Array as Array

import "base" Data.Bits hiding (bitSize)
import "base" Data.Bool
import "base" Data.Char
import "base" Data.Complex
import "base" Data.Dynamic
import "base" Data.Either
import "base" Data.Fixed
import "base" Data.Foldable
import "base" Data.Function
import "transformers" Data.Functor.Identity (Identity (..))
import "transformers" Data.Functor.Reverse (Reverse (..))
import "hashable" Data.Hashable
import "base" Data.Int
import "base" Data.Ix
import "base" Data.List hiding (
    all
  , and
  , any
  , concat
  , concatMap
  , elem
  , find
  , foldl
  , foldl'
  , foldl1
  , foldr
  , foldr1
  , map
  , mapAccumL
  , mapAccumR
  , maximum
  , maximumBy
  , minimum
  , minimumBy
  , notElem
  , or
  , product
  , sum
  )
import "base" Data.Maybe
import "base" Data.Ord
import "base" Data.Ratio
import "cereal" Data.Serialize
import "base" Data.String
import "time" Data.Time
import "time" Data.Time.Calendar.OrdinalDate
import "base" Data.Traversable
import "base" Data.Tuple
import "base" Data.Typeable
import "base" Data.Word

import "base" GHC.Generics (Generic)

import "base" Numeric

import "base" Text.Printf
import "regex-tdfa" Text.Regex.TDFA

import "containers" Data.Map (Map)
import qualified "containers" Data.Map as Map
import "containers" Data.Set (Set)
import qualified "containers" Data.Set as Set
import "containers" Data.Sequence (Seq)

import "hydrogen-multimap" Hydrogen.MultiMap (MultiMap)
import qualified "hydrogen-multimap" Hydrogen.MultiMap as MultiMap
import "hydrogen-version" Hydrogen.Version

import "uuid" Data.UUID (UUID)

import qualified "uuid" Data.UUID
import qualified "uuid" Data.UUID.V4


deriving instance Eq ZonedTime
deriving instance Generic Day
deriving instance Generic LocalTime
deriving instance Generic TimeZone
deriving instance Generic TimeOfDay
deriving instance Generic UniversalTime
deriving instance Generic ZonedTime

instance Serialize Day
instance Serialize LocalTime
instance Serialize TimeOfDay
instance Serialize TimeZone
instance Serialize UniversalTime
instance Serialize Version
instance Serialize ZonedTime

instance Serialize (Fixed E12) where
    put (MkFixed int) = put int

    get = MkFixed <$> get

instance Serialize UUID where

    put uuid = do
        let p = putWord32be
            (w1, w2, w3, w4) = Data.UUID.toWords uuid
        p w1 >> p w2 >> p w3 >> p w4

    get = let g = getWord32be in liftM4 Data.UUID.fromWords g g g g
      
data ShowBox where
    ShowBox :: forall a. (Show a) => a -> ShowBox

instance Show ShowBox where
    show (ShowBox a) = show a

(.|), (.&), (.^) :: (a -> Bool) -> (a -> Bool) -> (a -> Bool)
f .| g = \x -> f x || g x
f .& g = \x -> f x && g x
f .^ g = \x -> f x /= g x

(|>) :: a -> (a -> b) -> b
-- ^ @flip ('$')@
(|>) = flip ($)

__ :: a
-- ^ A shorthand for 'undefined'.
__ = error "Hydrogen.Prelude.undefined"

uuidFromString :: String -> Maybe UUID
uuidFromString = Data.UUID.fromString

randomUUID :: IO UUID
-- ^ Produces a random V4 UUID (alias for 'Data.UUID.V4.nextRandom').
randomUUID = Data.UUID.V4.nextRandom

safeHead
    :: a   -- ^ The default value for the case of the empty list.
    -> [a] -- ^ The list.
    -> a
-- ^ Returns the head of the list or the default value.
safeHead default_ = \case
    x : _ -> x
    _     -> default_

safeHeadAndTail :: a -> [a] -> (a, [a])
safeHeadAndTail default_ = \case
    x : xs -> (x, xs)
    _ -> (default_, [])

safeHeadAndTail2 :: a -> a -> [a] -> (a, a, [a])
safeHeadAndTail2 d1 d2 = \case
    x : y : xs -> (x, y, xs)
    x : xs -> (x, d2, xs)
    xs -> (d1, d2, xs)

firstJust :: [a -> Maybe b] -> a -> Maybe b
-- ^ Applies a bunch of functions on a given value,
--   returns the first result that is not Nothing
--   (or 'Nothing' if no 'Just' value was produced).
firstJust (f : fs) v = case f v of
    Nothing -> firstJust fs v
    x -> x
firstJust [] _ = Nothing

map :: Functor f => (a -> b) -> f a -> f b
-- ^ map as it should be: 'fmap'.
map = fmap

class TMap a where

    type Component x
    type Transform x

    tmap :: (Component a -> b) -> a -> Transform ((Component a -> b) -> a)


instance TMap (a, a) where

    type Component (a, a) = a
    type Transform ((a -> b) -> (a, a)) = (b, b)

    tmap f (a, b) = (f a, f b)

instance TMap (a, a, a) where

    type Component (a, a, a) = a
    type Transform ((a -> b) -> (a, a, a)) = (b, b, b)

    tmap f (a, b, c) = (f a, f b, f c)

instance TMap (a, a, a, a) where

    type Component (a, a, a, a) = a
    type Transform ((a -> b) -> (a, a, a, a)) = (b, b, b, b)

    tmap f (a, b, c, d) = (f a, f b, f c, f d)

instance TMap [a] where

    type Component [a] = a
    type Transform ((a -> b) -> [a]) = [b]

    tmap = fmap

instance TMap (Map k v) where

    type Component (Map k v) = v
    type Transform ((v -> w) -> Map k v) = Map k w

    tmap = fmap

instance TMap (MultiMap k v) where

    type Component (MultiMap k v) = v
    type Transform ((v -> w) -> MultiMap k v) = MultiMap k w

    tmap = fmap

instance TMap (Seq a) where

    type Component (Seq a) = a
    type Transform ((a -> b) -> Seq a) = Seq b

    tmap = fmap


type List a = [a]

class Has a where

    type HasKey a
    type HasValue a

    (!) :: a -> HasKey a -> HasValue a


instance Ord k => Has (Map k v) where

    type HasKey (Map k v) = k
    type HasValue (Map k v) = v

    (!) = (Map.!)

instance Eq k => Has [(k, v)] where

    type HasKey [(k, v)] = k
    type HasValue [(k, v)] = v

    list ! key = maybeKey (lookup key list)
      where
        maybeKey = maybe (error "Hydrogen.Prelude.! key not found") id

instance Ix i => Has (Array i e) where

    type HasKey (Array i e) = i
    type HasValue (Array i e) = e

    (!) = (Array.!)

instance Ord k => Has (MultiMap k v) where

    type HasKey (MultiMap k v) = k
    type HasValue (MultiMap k v) = [v]

    (!) = flip MultiMap.lookup


class Container a where

    type Contained a

    (?) :: a -> Contained a -> Bool


instance Ord a => Container (Set a) where

    type Contained (Set a) = a

    (?) = flip Set.member

instance Eq a => Container [a] where

    type Contained [a] = a

    (?) = flip elem

instance Eq a => Container (Seq a) where

    type Contained (Seq a) = a

    c ? e = any (== e) c

instance Ord k => Container (Map k v) where

    type Contained (Map k v) = k

    (?) = flip Map.member

instance Ord k => Container (MultiMap k v) where

    type Contained (MultiMap k v) = k

    (?) = flip MultiMap.member


class Default a where

    def :: a

instance Default Int where def = 0
instance Default Int8 where def = 0
instance Default Int16 where def = 0
instance Default Int32 where def = 0
instance Default Int64 where def = 0
instance Default Word8 where def = 0
instance Default Word16 where def = 0
instance Default Word32 where def = 0
instance Default Word64 where def = 0
instance Default Integer where def = 0

instance Default Bool where def = False
instance Default [a] where def = []
instance Default (Maybe a) where def = Nothing

type family Applicator a b where

    Applicator (a, b, c, d, e) z = (a -> b -> c -> d -> e -> z)
    Applicator (a, b, c, d) z = (a -> b -> c -> d -> z)
    Applicator (a, b, c) z = (a -> b -> c -> z)
    Applicator (a, b) z = (a -> b -> z)

    Applicator (f (a, b, c, d, e)) (f z) = (a -> b -> c -> d -> e -> z)
    Applicator (f (a, b, c, d)) (f z) = (a -> b -> c -> d -> z)
    Applicator (f (a, b, c)) (f z) = (a -> b -> c -> z)
    Applicator (f (a, b)) (f z) = (a -> b -> z)
    Applicator (f a) (f z) = (a -> z)

    Applicator x z = (x -> z)


class Apply x z where

    (*$*) :: Applicator x z -> x -> z

instance (Applicator a z ~ (a -> z)) => Apply a z where

    (*$*) = ($)

instance Apply (a, b) z where

    (*$*) = uncurry

instance Apply (a, b, c) z where

    (*$*) = uncurry3

instance Apply (a, b, c, d) z where

    (*$*) = uncurry4

instance Apply (a, b, c, d, e) z where

    (*$*) = uncurry5

instance (Functor f, Applicator (f a) (f z) ~ (a -> z))
    => Apply (f a) (f z) where

    (*$*) = fmap . ($)

instance (Functor f, Applicator (f (a, b)) (f z) ~ (a -> b -> z))
    => Apply (f (a, b)) (f z) where

    (*$*) = fmap . uncurry

instance (Functor f, Applicator (f (a, b, c)) (f z) ~ (a -> b -> c -> z))
    => Apply (f (a, b, c)) (f z) where

    (*$*) = fmap . uncurry3

instance (Functor f, Applicator (f (a, b, c, d)) (f z) ~ (a -> b -> c -> d -> z))
    => Apply (f (a, b, c, d)) (f z) where

    (*$*) = fmap . uncurry4

instance (Functor f, Applicator (f (a, b, c, d, e)) (f z) ~ (a -> b -> c -> d -> e -> z))
    => Apply (f (a, b, c, d, e)) (f z) where

    (*$*) = fmap . uncurry5


infixr 0 $$
infixr 0 $$$
infixr 0 $$$$
infixr 0 $$$$$

($$) :: (a -> b -> z) -> (a, b) -> z
($$) = uncurry

($$$), uncurry3 :: (a -> b -> c -> z) -> (a, b, c) -> z
uncurry3 f (a, b, c) = f a b c
($$$) = uncurry3

($$$$), uncurry4 :: (a -> b -> c -> d -> z) -> (a, b, c, d) -> z
uncurry4 f (a, b, c, d) = f a b c d
($$$$) = uncurry4

($$$$$), uncurry5 :: (a -> b -> c -> d -> e -> z) -> (a, b, c, d, e) -> z
uncurry5 f (a, b, c, d, e) = f a b c d e
($$$$$) = uncurry5


infixl 4 <$$>
infixl 4 <$$$>
infixl 4 <$$$$>
infixl 4 <$$$$$>

(<$$>) :: Functor f => (a -> b -> z) -> f (a, b) -> f z
(<$$>) = (<$>) . uncurry

(<$$$>) :: Functor f => (a -> b -> c -> z) -> f (a, b, c) -> f z
(<$$$>) = (<$>) . uncurry3

(<$$$$>) :: Functor f => (a -> b -> c -> d -> z) -> f (a, b, c, d) -> f z
(<$$$$>) = (<$>) . uncurry4

(<$$$$$>) :: Functor f => (a -> b -> c -> d -> e -> z) -> f (a, b, c, d, e) -> f z
(<$$$$$>) = (<$>) . uncurry5