{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}
-- | Custom Prelude, compatible across many GHC versions.
module Game.LambdaHack.Core.Prelude
  ( module Prelude.Compat

  , module Control.Monad.Compat
  , module Data.List.Compat
  , module Data.Maybe
  , module Data.Semigroup.Compat

  , module Control.Exception.Assert.Sugar

  , Text, (<+>), tshow, divUp, sum, (<$$>), partitionM, length, null, comparing
  , into, fromIntegralWrap, toIntegralCrash, intToDouble, int64ToDouble
  , mapM_, forM_

  , (***), (&&&), first, second
  ) where

import Prelude ()

import Prelude.Compat hiding
  ( appendFile
  , foldl
  , foldl1
  , fromIntegral
  , length
  , mapM_
  , null
  , readFile
  , sum
  , writeFile
  , (<>)
  )

import           Control.Applicative
import           Control.Arrow (first, second, (&&&), (***))
import           Control.DeepSeq
import           Control.Exception.Assert.Sugar
  (allB, assert, blame, showFailure, swith)
import           Control.Monad.Compat hiding (forM_, mapM_)
import qualified Control.Monad.Compat
import           Data.Binary
import qualified Data.Bits as Bits
import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Fixed as Fixed
import           Data.Hashable
import qualified Data.HashMap.Strict as HM
import           Data.Int (Int64)
import           Data.Key
import           Data.List.Compat hiding (foldl, foldl1, length, null, sum)
import qualified Data.List.Compat as List
import           Data.Maybe
import           Data.Ord (comparing)
import           Data.Semigroup.Compat (Semigroup ((<>)))
import           Data.Text (Text)
import qualified Data.Text as T (pack)
import qualified Data.Time as Time
import           NLP.Miniutter.English ((<+>))
import qualified NLP.Miniutter.English as MU
import qualified Prelude.Compat
import           Witch (into)

-- | Show and pack the result.
tshow :: Show a => a -> Text
tshow :: a -> Text
tshow a
x = String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ a -> String
forall a. Show a => a -> String
show a
x

infixl 7 `divUp`
-- | Integer division, rounding up.
divUp :: Integral a => a -> a -> a
{-# INLINE divUp #-}
divUp :: a -> a -> a
divUp a
n a
k = (a
n a -> a -> a
forall a. Num a => a -> a -> a
+ a
k a -> a -> a
forall a. Num a => a -> a -> a
- a
1) a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
k

sum :: Num a => [a] -> a
sum :: [a] -> a
sum = (a -> a -> a) -> a -> [a] -> a
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' a -> a -> a
forall a. Num a => a -> a -> a
(+) a
0

infixl 4 <$$>
(<$$>) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
a -> b
h <$$> :: (a -> b) -> f (g a) -> f (g b)
<$$> f (g a)
m = (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
h (g a -> g b) -> f (g a) -> f (g b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (g a)
m

partitionM :: Applicative m => (a -> m Bool) -> [a] -> m ([a], [a])
{-# INLINE partitionM #-}
partitionM :: (a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
p = (a -> m ([a], [a]) -> m ([a], [a]))
-> m ([a], [a]) -> [a] -> m ([a], [a])
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
a ->
  (Bool -> ([a], [a]) -> ([a], [a]))
-> m Bool -> m ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\Bool
b -> (if Bool
b then ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first else ([a] -> [a]) -> ([a], [a]) -> ([a], [a])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second) (a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (a -> m Bool
p a
a)) (([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], []))

-- | A version specialized to lists to avoid errors such as taking length
-- of @Maybe [a]@ instead of @[a]@.
-- Such errors are hard to detect, because the type of elements of the list
-- is not constrained.
length :: [a] -> Int
length :: [a] -> Int
length = [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
List.length

-- | A version specialized to lists to avoid errors such as taking null
-- of @Maybe [a]@ instead of @[a]@.
-- Such errors are hard to detect, because the type of elements of the list
-- is not constrained.
null :: [a] -> Bool
null :: [a] -> Bool
null = [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
List.null

-- Data.Binary orphan instances

instance (Enum k, Binary k, Binary e) => Binary (EM.EnumMap k e) where
  put :: EnumMap k e -> Put
put EnumMap k e
m = Int -> Put
forall t. Binary t => t -> Put
put (EnumMap k e -> Int
forall k a. EnumMap k a -> Int
EM.size EnumMap k e
m) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> ((k, e) -> Put) -> [(k, e)] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ (k, e) -> Put
forall t. Binary t => t -> Put
put (EnumMap k e -> [(k, e)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.toAscList EnumMap k e
m)
  get :: Get (EnumMap k e)
get = [(k, e)] -> EnumMap k e
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList ([(k, e)] -> EnumMap k e) -> Get [(k, e)] -> Get (EnumMap k e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [(k, e)]
forall t. Binary t => Get t
get

instance (Enum k, Binary k) => Binary (ES.EnumSet k) where
  put :: EnumSet k -> Put
put EnumSet k
m = Int -> Put
forall t. Binary t => t -> Put
put (EnumSet k -> Int
forall k. EnumSet k -> Int
ES.size EnumSet k
m) Put -> Put -> Put
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> (k -> Put) -> [k] -> Put
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ k -> Put
forall t. Binary t => t -> Put
put (EnumSet k -> [k]
forall k. Enum k => EnumSet k -> [k]
ES.toAscList EnumSet k
m)
  get :: Get (EnumSet k)
get = [k] -> EnumSet k
forall k. Enum k => [k] -> EnumSet k
ES.fromDistinctAscList ([k] -> EnumSet k) -> Get [k] -> Get (EnumSet k)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [k]
forall t. Binary t => Get t
get

instance Binary Time.NominalDiffTime where
  get :: Get NominalDiffTime
get = (Pico -> NominalDiffTime) -> Get Pico -> Get NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Pico -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Get Pico
forall t. Binary t => Get t
get :: Get Fixed.Pico)
  put :: NominalDiffTime -> Put
put = (Pico -> Put
forall t. Binary t => t -> Put
put :: Fixed.Pico -> Put) (Pico -> Put)
-> (NominalDiffTime -> Pico) -> NominalDiffTime -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NominalDiffTime -> Pico
forall a b. (Real a, Fractional b) => a -> b
realToFrac

instance (Hashable k, Eq k, Binary k, Binary v) => Binary (HM.HashMap k v) where
  get :: Get (HashMap k v)
get = ([(k, v)] -> HashMap k v) -> Get [(k, v)] -> Get (HashMap k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> HashMap k v
forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
HM.fromList Get [(k, v)]
forall t. Binary t => Get t
get
  put :: HashMap k v -> Put
put = [(k, v)] -> Put
forall t. Binary t => t -> Put
put ([(k, v)] -> Put)
-> (HashMap k v -> [(k, v)]) -> HashMap k v -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashMap k v -> [(k, v)]
forall k v. HashMap k v -> [(k, v)]
HM.toList

-- Data.Key orphan instances

type instance Key (EM.EnumMap k) = k

instance Zip (EM.EnumMap k) where
  {-# INLINE zipWith #-}
  zipWith :: (a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c
zipWith = (a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c
forall a b c k.
(a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c
EM.intersectionWith

instance Enum k => ZipWithKey (EM.EnumMap k) where
  {-# INLINE zipWithKey #-}
  zipWithKey :: (Key (EnumMap k) -> a -> b -> c)
-> EnumMap k a -> EnumMap k b -> EnumMap k c
zipWithKey = (Key (EnumMap k) -> a -> b -> c)
-> EnumMap k a -> EnumMap k b -> EnumMap k c
forall k a b c.
Enum k =>
(k -> a -> b -> c) -> EnumMap k a -> EnumMap k b -> EnumMap k c
EM.intersectionWithKey

instance Enum k => Keyed (EM.EnumMap k) where
  {-# INLINE mapWithKey #-}
  mapWithKey :: (Key (EnumMap k) -> a -> b) -> EnumMap k a -> EnumMap k b
mapWithKey = (Key (EnumMap k) -> a -> b) -> EnumMap k a -> EnumMap k b
forall k a b. Enum k => (k -> a -> b) -> EnumMap k a -> EnumMap k b
EM.mapWithKey

instance Enum k => FoldableWithKey (EM.EnumMap k) where
  {-# INLINE foldrWithKey #-}
  foldrWithKey :: (Key (EnumMap k) -> a -> b -> b) -> b -> EnumMap k a -> b
foldrWithKey = (Key (EnumMap k) -> a -> b -> b) -> b -> EnumMap k a -> b
forall k a b. Enum k => (k -> a -> b -> b) -> b -> EnumMap k a -> b
EM.foldrWithKey

instance Enum k => TraversableWithKey (EM.EnumMap k) where
  traverseWithKey :: (Key (EnumMap k) -> a -> f b) -> EnumMap k a -> f (EnumMap k b)
traverseWithKey Key (EnumMap k) -> a -> f b
f = ([(k, b)] -> EnumMap k b) -> f [(k, b)] -> f (EnumMap k b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, b)] -> EnumMap k b
forall k a. Enum k => [(k, a)] -> EnumMap k a
EM.fromDistinctAscList
                      (f [(k, b)] -> f (EnumMap k b))
-> (EnumMap k a -> f [(k, b)]) -> EnumMap k a -> f (EnumMap k b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, a) -> f (k, b)) -> [(k, a)] -> f [(k, b)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (\(k
k, a
v) -> (,) k
k (b -> (k, b)) -> f b -> f (k, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Key (EnumMap k) -> a -> f b
f k
Key (EnumMap k)
k a
v) ([(k, a)] -> f [(k, b)])
-> (EnumMap k a -> [(k, a)]) -> EnumMap k a -> f [(k, b)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EnumMap k a -> [(k, a)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.toAscList

instance Enum k => Indexable (EM.EnumMap k) where
  {-# INLINE index #-}
  index :: EnumMap k a -> Key (EnumMap k) -> a
index = EnumMap k a -> Key (EnumMap k) -> a
forall k a. Enum k => EnumMap k a -> k -> a
(EM.!)

instance Enum k => Lookup (EM.EnumMap k) where
  {-# INLINE lookup #-}
  lookup :: Key (EnumMap k) -> EnumMap k a -> Maybe a
lookup = Key (EnumMap k) -> EnumMap k a -> Maybe a
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup

instance Enum k => Adjustable (EM.EnumMap k) where
  {-# INLINE adjust #-}
  adjust :: (a -> a) -> Key (EnumMap k) -> EnumMap k a -> EnumMap k a
adjust = (a -> a) -> Key (EnumMap k) -> EnumMap k a -> EnumMap k a
forall k a. Enum k => (a -> a) -> k -> EnumMap k a -> EnumMap k a
EM.adjust

-- Data.Hashable orphan instances

instance (Enum k, Hashable k, Hashable e) => Hashable (EM.EnumMap k e) where
  hashWithSalt :: Int -> EnumMap k e -> Int
hashWithSalt Int
s EnumMap k e
x = Int -> [(k, e)] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (EnumMap k e -> [(k, e)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.toAscList EnumMap k e
x)

instance (Enum k, Hashable k) => Hashable (ES.EnumSet k) where
  hashWithSalt :: Int -> EnumSet k -> Int
hashWithSalt Int
s EnumSet k
x = Int -> [k] -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
s (EnumSet k -> [k]
forall k. Enum k => EnumSet k -> [k]
ES.toAscList EnumSet k
x)

-- Control.DeepSeq orphan instances

instance NFData MU.Part

instance NFData MU.Person

instance NFData MU.Polarity

-- | Re-exported 'Prelude.fromIntegral', but please give it explicit type
-- to make it obvious if wrapping, etc., may occur. Use `toIntegralCrash`
-- instead, if possible, because it fails instead of wrapping, etc.
-- In general, it may wrap or otherwise lose information.
fromIntegralWrap :: (Integral a, Num b) => a -> b
fromIntegralWrap :: a -> b
fromIntegralWrap = a -> b
forall a b. (Integral a, Num b) => a -> b
Prelude.Compat.fromIntegral

-- | Re-exported 'Data.Bits.toIntegralSized', but please give it explicit type
-- to make it obvious if wrapping, etc., may occur and to trigger optimization.
-- In general, it may crash.
toIntegralCrash :: (Integral a, Integral b, Bits.Bits a, Bits.Bits b)
                => a -> b
{-# INLINE toIntegralCrash #-}
toIntegralCrash :: a -> b
toIntegralCrash = b -> Maybe b -> b
forall a. a -> Maybe a -> a
fromMaybe (String -> b
forall a. HasCallStack => String -> a
error String
"toIntegralCrash") (Maybe b -> b) -> (a -> Maybe b) -> a -> b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Maybe b
forall a b.
(Integral a, Integral b, Bits a, Bits b) =>
a -> Maybe b
Bits.toIntegralSized

intToDouble :: Int -> Double
intToDouble :: Int -> Double
intToDouble = Int -> Double
forall a b. (Integral a, Num b) => a -> b
Prelude.Compat.fromIntegral

int64ToDouble :: Int64 -> Double
int64ToDouble :: Int64 -> Double
int64ToDouble = Int64 -> Double
forall a b. (Integral a, Num b) => a -> b
Prelude.Compat.fromIntegral

-- | This has a more specific type (unit result) than normally, to catch errors.
mapM_ :: (Foldable t, Monad m) => (a -> m ()) -> t a -> m ()
mapM_ :: (a -> m ()) -> t a -> m ()
mapM_ = (a -> m ()) -> t a -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
Control.Monad.Compat.mapM_

-- | This has a more specific type (unit result) than normally, to catch errors.
forM_ :: (Foldable t, Monad m) => t a -> (a -> m ()) -> m ()
forM_ :: t a -> (a -> m ()) -> m ()
forM_ = t a -> (a -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
Control.Monad.Compat.forM_