{-# LANGUAGE FieldSelectors #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoMonomorphismRestriction #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Prelude (
  traceString,
  traceShow,
  traceShowId,
  traceShowM,
  IsList (..),
  pattern (:=),
  forMap,
  setSingle,
  setInsert,
  setSize,
  mapSize,
  mapLookup,
  DropPrefix (..),
  ($),
  (<$>),
  ($>),
  (<&>),
  (.),
  (&),
  (&&),
  (||),
  (>>>),
  (++),
  id,
  const,
  on,
  fold,
  foldr,
  foldMap,
  foldMapM,
  Foldable,
  forM,
  forM_,
  null,
  any,
  all,
  or,
  and,
  not,
  flip,
  first,
  second,
  void,
  Bool (..),
  otherwise,
  Enum (..),
  Eq (..),
  Ord (..),
  Show (..),
  Either (..),
  either,
  Generic,
  IsString,
  fromString,
  fromRational,
  HasCallStack,
  IO,
  FilePath,
  Char,
  -- Hashable (..),
  ShortText,
  Set,
  String,
  Natural,
  Int,
  Integer,
  Map,
  Maybe (..),
  fromMaybe,
  maybe,
  maybeToList,
  isJust,
  isNothing,
  Functor (..),
  Down (..),
  Sum (..),
  Identity (..),
  Applicative (..),
  Semigroup (..),
  Monoid (..),
  Monad (..),
  unless,
  when,
  Symbol,
  KnownSymbol (..),
  KnownNat (..),
  Real (..),
  Num (..),
  natVal,
  symbolVal,
  pShow,
  pShowNoColor,
  IsLabel (..),
  Proxy (..),
  Last (..),
  -- Surgery,
  -- Surgeries,
  -- ProductSurgery,
  -- ProductSurgeries,
  -- Surgery' (..),
  -- Generically (..),
  -- GenericProduct (..),
  -- Derecordify,
  -- OnField,
  -- OnFields,
  -- CopyRep,
  -- type (%~),
  Typeable,
  fst,
  snd,
  maximum,
  minimum,
  Max (..),
  Min (..),
) where

import Control.Applicative (Applicative (..))
import Control.Arrow (first, second, (>>>))
import Control.Monad (Monad (..), forM, forM_, unless, void, when)
import Data.Bool (Bool (..), not, otherwise, (&&), (||))
import Data.Char (Char)
import Data.Either (Either (..), either)
import Data.Eq (Eq (..))
import Data.Foldable (Foldable, all, and, any, fold, foldMap, foldr, maximum, minimum, null, or)
import Data.Function (const, flip, id, on, ($), (&), (.))
import Data.Functor (Functor (..), ($>), (<$), (<$>), (<&>))
import Data.Functor.Identity (Identity (..))
import Data.List ((++))
import Data.Map.Strict (Map)
import Data.Map.Strict qualified as Map
import Data.Maybe (Maybe (..), fromMaybe, isJust, isNothing, maybe, maybeToList)
import Data.Monoid (Ap (..), Last (..), Monoid (..))
import Data.Ord (Down (..), Ord (..))
import Data.Proxy (Proxy (..))
import Data.Semigroup (Max (..), Min (..), Semigroup (..), Sum (..))
import Data.Set (Set)
import Data.Set qualified as Set
import Data.String (IsString, String, fromString)
import Data.Text qualified as Text
import Data.Text.Short (ShortText)
import Data.Text.Short qualified as ShortText
import Data.Tuple (fst, snd)
import Debug.Pretty.Simple (pTrace, pTraceShow, pTraceShowId, pTraceShowM)
import GHC.Generics (Generic)
import GHC.IsList (IsList (..), toList)
import GHC.OverloadedLabels (IsLabel (..))
import GHC.Stack (HasCallStack)
import GHC.TypeLits (KnownNat (..), KnownSymbol (..), Symbol, natVal, symbolVal)
import System.IO (FilePath, IO)

-- import Generic.Data.Microsurgery (
--   CopyRep,
--   Derecordify,
--   GenericProduct (..),
--   Generically (..),
--   OnField,
--   OnFields,
--   ProductSurgeries,
--   ProductSurgery,
--   Surgeries,
--   Surgery,
--   Surgery' (..),
--   type (%~),
--  )
import Numeric.Natural (Natural)

-- import Optics.Core
import Text.Pretty.Simple (pShow, pShowNoColor)
import Text.Show (Show (..))
import Type.Reflection (Typeable)
import "base" Prelude (Enum (..), Int, Integer, Num (..), Real (..), fromRational)

traceString = pTrace
traceShow = pTraceShow
traceShowId = pTraceShowId
traceShowM = pTraceShowM

pattern (:=) :: a -> b -> (a, b)
pattern (:=) x y = (x, y)
infixr 0 :=

class Assoc a b c where
  (~>) :: a -> b -> c
instance Assoc a b (a, b) where
  (~>) = (,)

(<&) :: Functor f => a -> f b -> f a
(&>) :: Functor f => f b -> a -> f a
(<&) = flip ($>)
(&>) = flip (<$)
infixl 4 <&
infixl 4 &>

-- l <>~ n = over l (<> n)
-- {-# INLINE (<>~) #-}

instance IsList a => IsList (Last a) where
  type Item (Last a) = Item a
  fromList [] = Last Nothing
  fromList xs = Last (Just (fromList xs))
  toList (Last Nothing) = []
  toList (Last (Just x)) = toList x

-- | Like `Last` but `mempty` is `[]` instead not `Nothing`.
-- Useful for deriving:
--
-- @
-- deriving Semigroup via (ProductSurgery (OnFields Lasts) Foo)
-- @
newtype Lasts a = Lasts a
  deriving (Eq, Ord, Show, Generic)

instance Semigroup (Lasts [a]) where
  Lasts [] <> x = x
  x <> Lasts [] = x
  _x <> y = y
instance (Monoid a, Semigroup (Lasts a)) => Monoid (Lasts a) where
  mempty = Lasts mempty

newtype Newest a = Newest {unNewest :: a}
  deriving (Eq, Ord, Generic)
  deriving newtype (Show)
instance Semigroup (Newest a) where
  _x <> y = y

newtype MapUnion k a = MapUnion {unMapUnion :: Map.Map k a}
  deriving (Eq, Ord, Generic, Functor)
  deriving newtype (Show)

-- CorrectionWarning: `Monoid` is not derived correctly via `Generically`,
-- it does not reuses `(<>)`.
-- See https://github.com/haskell/core-libraries-committee/issues/324
-- deriving (Monoid) via (Generically (MapUnion k a))
instance (Ord k, Semigroup a) => Semigroup (MapUnion k a) where
  MapUnion x <> MapUnion y = MapUnion (Map.unionWith (<>) x y)
instance (Ord k, Semigroup a) => Monoid (MapUnion k a) where
  mempty = MapUnion mempty

forMap :: (Foldable t, Monoid m) => t a -> (a -> m) -> m
forMap = flip foldMap

class DropPrefix a where
  dropPrefix :: a -> a -> a
instance DropPrefix Text.Text where
  dropPrefix p t = t & Text.stripPrefix p & fromMaybe t
instance DropPrefix ShortText where
  dropPrefix p t = t & ShortText.stripPrefix p & fromMaybe t

setSingle = Set.singleton
{-# INLINE setSingle #-}
setInsert = Set.insert
{-# INLINE setInsert #-}
setSize = Set.size
{-# INLINE setSize #-}
mapSize = Map.size
{-# INLINE mapSize #-}
mapLookup = Map.lookup
{-# INLINE mapLookup #-}

foldMapM :: (Applicative m, Foldable t, Monoid b) => (a -> m b) -> t a -> m b
foldMapM f = getAp <$> foldMap (Ap . f)