module Data.Enumerate.Extra where
import Control.Monad.Catch (MonadThrow(..), SomeException(..))
import Control.DeepSeq (NFData(..), deepseq)
import Control.Arrow ((&&&), (>>>))
import System.IO.Unsafe (unsafePerformIO)
import Control.Exception (catches, throwIO, Handler(..), AsyncException, ArithException, ArrayException, ErrorCall, PatternMatchFail)
import Data.Foldable (traverse_)
import Numeric.Natural
import qualified Data.Set as Set
import Data.Set (Set)
import qualified Data.List as List
import qualified Data.Ord as Ord
failed :: (MonadThrow m) => String -> m a
failed = throwM . userError
maybe2throw :: (a -> Maybe b) -> (forall m. MonadThrow m => a -> m b)
maybe2throw f = f >>> \case
Nothing -> failed "Nothing"
Just x -> return x
list2throw :: (a -> [b]) -> (forall m. MonadThrow m => a -> m b)
list2throw f = f >>> \case
[] -> failed "[]"
(x:_) -> return x
either2throw :: (a -> Either SomeException b) -> (forall m. MonadThrow m => a -> m b)
either2throw f = f >>> \case
Left e -> throwM e
Right x -> return x
throw2maybe :: (forall m. MonadThrow m => a -> m b) -> (a -> Maybe b)
throw2maybe = id
throw2either :: (forall m. MonadThrow m => a -> m b) -> (a -> Either SomeException b)
throw2either = id
throw2list :: (forall m. MonadThrow m => a -> m b) -> (a -> [b])
throw2list = id
totalizeFunction :: (NFData b, MonadThrow m) => (a -> b) -> (a -> m b)
totalizeFunction f = g
where g x = spoonWith defaultPartialityHandlers (f x)
defaultPartialityHandlers :: (MonadThrow m) => [Handler (m a)]
defaultPartialityHandlers =
[ Handler $ \(e :: AsyncException) -> throwIO e
, Handler $ \(e :: ArithException) -> return (throwM e)
, Handler $ \(e :: ArrayException) -> return (throwM e)
, Handler $ \(e :: ErrorCall) -> return (throwM e)
, Handler $ \(e :: PatternMatchFail) -> return (throwM e)
, Handler $ \(e :: SomeException) -> return (throwM e)
]
spoonWith :: (NFData a, MonadThrow m) => [Handler (m a)] -> a -> m a
spoonWith handlers a = unsafePerformIO $ do
deepseq a (return `fmap` return a) `catches` handlers
showsPrecWith :: (Show a, Show b) => String -> (a -> b) -> Int -> a -> ShowS
showsPrecWith stringFrom functionInto p x = showParen (p > 10) $
showString stringFrom . showString " " . shows (functionInto x)
int2natural :: Int -> Natural
int2natural = fromInteger . toInteger
powerSet :: (Ord a) => Set a -> Set (Set a)
powerSet values = Set.singleton values `Set.union` _Set_bind powerSet (dropEach values)
where
_Set_bind :: (Ord a, Ord b) => (a -> Set b) -> Set a -> Set b
_Set_bind f = _Set_join . Set.map f
_Set_join :: (Ord a) => Set (Set a) -> Set a
_Set_join = Set.unions . Set.toList
dropEach :: (Ord a) => Set a -> Set (Set a)
dropEach values = Set.map dropOne values
where
dropOne value = Set.delete value values
powerset2matrix :: Set (Set a) -> [[a]]
powerset2matrix = (List.sortBy (Ord.comparing length) . fmap Set.toList . Set.toList)