{-# LANGUAGE BangPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# LANGUAGE Safe                #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_GHC -fno-warn-unused-imports #-}

-- |
-- Copyright: © Herbert Valerio Riedel 2015-2018
-- SPDX-License-Identifier: GPL-2.0-or-later
--
module Util
    ( liftEither'
    , readMaybe
    , readEither
    , fromIntegerMaybe
    , (<>)

    , mapFromListNoDupes
    , mapInsertNoDupe

    , bsToStrict

    , module X
    ) where

import           Control.Applicative          as X
import           Control.DeepSeq              as X (NFData (rnf))
import           Control.Monad                as X
import           Data.Functor                 as X
import           Data.Int                     as X
import           Data.Word                    as X
import           GHC.Generics                 as X (Generic)
import           Numeric.Natural              as X (Natural)

import           Control.Monad.Fix            as X (MonadFix)
import           Control.Monad.Except         as X (MonadError (..))
import           Control.Monad.Identity       as X
import           Control.Monad.Trans.Except   as X (ExceptT (..), runExceptT)

import           Data.Char                    as X (chr, ord)
import           Data.Map                     as X (Map)
import qualified Data.Map                     as Map
import           Data.Monoid                  as X (Monoid (mappend, mempty))
#if MIN_VERSION_base(4,9,0)
import           Data.Semigroup               ((<>))
#else
import           Data.Monoid                  ((<>))
#endif
import qualified Data.ByteString              as BS
import qualified Data.ByteString.Lazy         as BS.L
import           Data.Set                     as X (Set)
import           Data.Text                    as X (Text)

import           Text.ParserCombinators.ReadP as P
import           Text.Read

-- GHC 8.4.1 shipped with a phony `mtl-2.2.2` and so we have no
-- bulletproof way to know when `Control.Monad.Except` exports liftEither
-- or not; after NixOS managed to break an otherwise effective workaround
-- I'll just throwing my hands up in the air and will consider
-- `Control.Monad.Except.liftEither` scorched earth for now.
liftEither' :: MonadError e m => Either e a -> m a
liftEither' :: forall e (m :: * -> *) a. MonadError e m => Either e a -> m a
liftEither' = (e -> m a) -> (a -> m a) -> Either e a -> m a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either e -> m a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return


#if !MIN_VERSION_base(4,6,0)

-- | Parse a string using the 'Read' instance. Succeeds if there is
-- exactly one valid result.
readMaybe :: Read a => String -> Maybe a
readMaybe = either (const Nothing) id . readEither

-- | Parse a string using the 'Read' instance. Succeeds if there is
-- exactly one valid result. A 'Left' value indicates a parse error.
readEither :: Read a => String -> Either String a
readEither s = case [ x | (x,"") <- readPrec_to_S read' minPrec s ] of
                 [x] -> Right x
                 []  -> Left "Prelude.read: no parse"
                 _   -> Left "Prelude.read: ambiguous parse"
 where
  read' = do x <- readPrec
             Text.Read.lift P.skipSpaces
             return x
#endif

-- | Succeeds if the 'Integral' value is in the bounds of the given Data type.
-- 'Nothing' indicates that the value is outside the bounds.
fromIntegerMaybe :: forall n . (Integral n, Bounded n) => Integer -> Maybe n
fromIntegerMaybe :: forall n. (Integral n, Bounded n) => Integer -> Maybe n
fromIntegerMaybe Integer
j
  | Integer
l Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
j, Integer
j Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
<= Integer
u  = n -> Maybe n
forall a. a -> Maybe a
Just (Integer -> n
forall a. Num a => Integer -> a
fromInteger Integer
j)
  | Bool
otherwise       = Maybe n
forall a. Maybe a
Nothing
  where
    u :: Integer
u = n -> Integer
forall a. Integral a => a -> Integer
toInteger (n
forall a. Bounded a => a
maxBound :: n)
    l :: Integer
l = n -> Integer
forall a. Integral a => a -> Integer
toInteger (n
forall a. Bounded a => a
minBound :: n)


-- | A convience wrapper over 'mapInsertNoDupe'
mapFromListNoDupes :: Ord k => [(k,a)] -> Either (k,a) (Map k a)
mapFromListNoDupes :: forall k a. Ord k => [(k, a)] -> Either (k, a) (Map k a)
mapFromListNoDupes = Map k a -> [(k, a)] -> Either (k, a) (Map k a)
forall {a} {b}.
Ord a =>
Map a b -> [(a, b)] -> Either (a, b) (Map a b)
go Map k a
forall a. Monoid a => a
mempty
  where
    go :: Map a b -> [(a, b)] -> Either (a, b) (Map a b)
go !Map a b
m [] = Map a b -> Either (a, b) (Map a b)
forall a b. b -> Either a b
Right Map a b
m
    go !Map a b
m ((a
k,!b
v):[(a, b)]
rest) = case a -> b -> Map a b -> Maybe (Map a b)
forall k a. Ord k => k -> a -> Map k a -> Maybe (Map k a)
mapInsertNoDupe a
k b
v Map a b
m of
                            Maybe (Map a b)
Nothing -> (a, b) -> Either (a, b) (Map a b)
forall a b. a -> Either a b
Left (a
k,b
v)
                            Just Map a b
m' -> Map a b -> [(a, b)] -> Either (a, b) (Map a b)
go Map a b
m' [(a, b)]
rest

-- | A convience wrapper over 'Data.Map.insertLookupWithKey'
mapInsertNoDupe :: Ord k => k -> a -> Map k a -> Maybe (Map k a)
mapInsertNoDupe :: forall k a. Ord k => k -> a -> Map k a -> Maybe (Map k a)
mapInsertNoDupe k
kx a
x Map k a
t = case (k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
forall k a.
Ord k =>
(k -> a -> a -> a) -> k -> a -> Map k a -> (Maybe a, Map k a)
Map.insertLookupWithKey (\k
_ a
a a
_ -> a
a) k
kx a
x Map k a
t of
                           (Maybe a
Nothing, Map k a
m) -> Map k a -> Maybe (Map k a)
forall a. a -> Maybe a
Just Map k a
m
                           (Just a
_, Map k a
_)  -> Maybe (Map k a)
forall a. Maybe a
Nothing


-- | Equivalent to the function 'Data.ByteString.toStrict'.
-- O(n) Convert a lazy 'BS.L.ByteString' into a strict 'BS.ByteString'.
{-# INLINE bsToStrict #-}
bsToStrict :: BS.L.ByteString -> BS.ByteString
#if MIN_VERSION_bytestring(0,10,0)
bsToStrict :: ByteString -> ByteString
bsToStrict = ByteString -> ByteString
BS.L.toStrict
#else
bsToStrict = BS.concat . BS.L.toChunks
#endif