-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

-- | This module essentially replaces the default "Prelude" with "Universum".
--
-- It works because we are using the @base-noprelude@ package instead of @base@.

module Prelude
  ( module Control.Lens
  , module Universum
  , for
  , toEnumSafe
  -- * Converters from @Integral@ types
  , module FromIntegral
  -- * Overloaded boolean operators
  , module Boolean
  -- * Polymorphic length
  , module Length
  -- * Unsafe conversions
  , Unsafe.fromInteger
  -- * Safer @show@
  , module Show
  -- * Oddly sized @Word@ types
  , module Word

  -- * Re-exports
  , Unsafe.unsafe
  , Unsafe.unsafeM
  ) where

import Control.Lens
  (Lens, Lens', Traversal, Traversal', _1, _2, _3, _4, _5, over, preuse, preview, set, use, view,
  (%~), (&), (.~), (<&>), (^.), (^..), (^?))
import Data.Ix (inRange)
import Data.Traversable (for)
import Morley.Prelude.Boolean as Boolean
import Morley.Prelude.FromIntegral as FromIntegral
import Morley.Prelude.Length as Length
import Morley.Prelude.Show as Show
import Morley.Prelude.Word as Word
import Universum hiding
  (All(..), Any(..), Key, Lens, Lens', Nat, Traversal, Traversal', Val, _1, _2, _3, _4, _5, all,
  and, any, fromInteger, fromIntegral, length, not, or, over, preuse, preview, readFile, set, show,
  use, view, writeFile, (%~), (&&), (&), (.~), (<&>), (^.), (^..), (^?), (||))
import Unsafe qualified (fromInteger, unsafe, unsafeM)

-- | A safe version of 'toEnum' for 'Bounded' types.
toEnumSafe :: forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumSafe :: forall a. (Enum a, Bounded a) => Int -> Maybe a
toEnumSafe Int
i = Bool -> Maybe ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int -> Bool
inBounds Int
i) Maybe () -> a -> Maybe a
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Int -> a
forall a. Enum a => Int -> a
toEnum Int
i
  where
    inBounds :: Int -> Bool
    inBounds :: Int -> Bool
inBounds = (Int, Int) -> Int -> Bool
forall a. Ix a => (a, a) -> a -> Bool
inRange (a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a), a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound :: a))
{-# INLINE toEnumSafe #-}