-- |
-- Module      : Foundation.Partial
-- License     : BSD-style
-- Maintainer  : Vincent Hanquez <vincent@snarc.org>
-- Stability   : experimental
-- Portability : portable
--
-- Partial give a way to annotate your partial function with
-- a simple wrapper, which can only evaluated using 'fromPartial'
--
-- > fromPartial ( head [] )
--
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Foundation.Partial
    ( Partial
    , PartialError
    , partialError
    , partial
    , fromPartial
    , head
    , fromJust
    , fromLeft
    , fromRight
    ) where

import Basement.Compat.Base
import Basement.Compat.Identity

-- | Partialiality wrapper.
newtype Partial a = Partial (Identity a)
    deriving (a -> Partial b -> Partial a
(a -> b) -> Partial a -> Partial b
(forall a b. (a -> b) -> Partial a -> Partial b)
-> (forall a b. a -> Partial b -> Partial a) -> Functor Partial
forall a b. a -> Partial b -> Partial a
forall a b. (a -> b) -> Partial a -> Partial b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> Partial b -> Partial a
$c<$ :: forall a b. a -> Partial b -> Partial a
fmap :: (a -> b) -> Partial a -> Partial b
$cfmap :: forall a b. (a -> b) -> Partial a -> Partial b
Functor, Functor Partial
a -> Partial a
Functor Partial
-> (forall a. a -> Partial a)
-> (forall a b. Partial (a -> b) -> Partial a -> Partial b)
-> (forall a b c.
    (a -> b -> c) -> Partial a -> Partial b -> Partial c)
-> (forall a b. Partial a -> Partial b -> Partial b)
-> (forall a b. Partial a -> Partial b -> Partial a)
-> Applicative Partial
Partial a -> Partial b -> Partial b
Partial a -> Partial b -> Partial a
Partial (a -> b) -> Partial a -> Partial b
(a -> b -> c) -> Partial a -> Partial b -> Partial c
forall a. a -> Partial a
forall a b. Partial a -> Partial b -> Partial a
forall a b. Partial a -> Partial b -> Partial b
forall a b. Partial (a -> b) -> Partial a -> Partial b
forall a b c. (a -> b -> c) -> Partial a -> Partial b -> Partial c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: Partial a -> Partial b -> Partial a
$c<* :: forall a b. Partial a -> Partial b -> Partial a
*> :: Partial a -> Partial b -> Partial b
$c*> :: forall a b. Partial a -> Partial b -> Partial b
liftA2 :: (a -> b -> c) -> Partial a -> Partial b -> Partial c
$cliftA2 :: forall a b c. (a -> b -> c) -> Partial a -> Partial b -> Partial c
<*> :: Partial (a -> b) -> Partial a -> Partial b
$c<*> :: forall a b. Partial (a -> b) -> Partial a -> Partial b
pure :: a -> Partial a
$cpure :: forall a. a -> Partial a
$cp1Applicative :: Functor Partial
Applicative, Applicative Partial
a -> Partial a
Applicative Partial
-> (forall a b. Partial a -> (a -> Partial b) -> Partial b)
-> (forall a b. Partial a -> Partial b -> Partial b)
-> (forall a. a -> Partial a)
-> Monad Partial
Partial a -> (a -> Partial b) -> Partial b
Partial a -> Partial b -> Partial b
forall a. a -> Partial a
forall a b. Partial a -> Partial b -> Partial b
forall a b. Partial a -> (a -> Partial b) -> Partial b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> Partial a
$creturn :: forall a. a -> Partial a
>> :: Partial a -> Partial b -> Partial b
$c>> :: forall a b. Partial a -> Partial b -> Partial b
>>= :: Partial a -> (a -> Partial b) -> Partial b
$c>>= :: forall a b. Partial a -> (a -> Partial b) -> Partial b
$cp1Monad :: Applicative Partial
Monad)

-- | An error related to the evaluation of a Partial value that failed.
--
-- it contains the name of the function and the reason for failure
data PartialError = PartialError [Char] [Char]
    deriving (Int -> PartialError -> ShowS
[PartialError] -> ShowS
PartialError -> String
(Int -> PartialError -> ShowS)
-> (PartialError -> String)
-> ([PartialError] -> ShowS)
-> Show PartialError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PartialError] -> ShowS
$cshowList :: [PartialError] -> ShowS
show :: PartialError -> String
$cshow :: PartialError -> String
showsPrec :: Int -> PartialError -> ShowS
$cshowsPrec :: Int -> PartialError -> ShowS
Show,PartialError -> PartialError -> Bool
(PartialError -> PartialError -> Bool)
-> (PartialError -> PartialError -> Bool) -> Eq PartialError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PartialError -> PartialError -> Bool
$c/= :: PartialError -> PartialError -> Bool
== :: PartialError -> PartialError -> Bool
$c== :: PartialError -> PartialError -> Bool
Eq,Typeable)

instance Exception PartialError

-- | Throw an asynchronous PartialError
partialError :: [Char] -> [Char] -> a
partialError :: String -> String -> a
partialError String
lbl String
exp = PartialError -> a
forall a e. Exception e => e -> a
throw (String -> String -> PartialError
PartialError String
lbl String
exp)

-- | Create a value that is partial. this can only be
-- unwrap using the 'fromPartial' function
partial :: a -> Partial a
partial :: a -> Partial a
partial = a -> Partial a
forall (f :: * -> *) a. Applicative f => a -> f a
pure

-- | Dewrap a possible partial value
fromPartial :: Partial a -> a
fromPartial :: Partial a -> a
fromPartial (Partial Identity a
ida) = Identity a -> a
forall a. Identity a -> a
runIdentity Identity a
ida

-- | Partial function to get the head of a list
head :: [a] -> Partial a
head :: [a] -> Partial a
head [a]
l = a -> Partial a
forall a. a -> Partial a
partial (a -> Partial a) -> a -> Partial a
forall a b. (a -> b) -> a -> b
$
    case [a]
l of
        []  -> String -> String -> a
forall a. String -> String -> a
partialError String
"head" String
"empty list"
        a
x:[a]
_ -> a
x

-- | Partial function to grab the value inside a Maybe
fromJust :: Maybe a -> Partial a
fromJust :: Maybe a -> Partial a
fromJust Maybe a
x = a -> Partial a
forall a. a -> Partial a
partial (a -> Partial a) -> a -> Partial a
forall a b. (a -> b) -> a -> b
$
    case Maybe a
x of
        Maybe a
Nothing -> String -> String -> a
forall a. String -> String -> a
partialError String
"fromJust" String
"Nothing"
        Just a
y  -> a
y

-- Grab the Right value of an Either
fromRight :: Either a b -> Partial b
fromRight :: Either a b -> Partial b
fromRight Either a b
x = b -> Partial b
forall a. a -> Partial a
partial (b -> Partial b) -> b -> Partial b
forall a b. (a -> b) -> a -> b
$
    case Either a b
x of
        Left a
_ -> String -> String -> b
forall a. String -> String -> a
partialError String
"fromRight" String
"Left"
        Right b
a -> b
a

-- Grab the Left value of an Either
fromLeft :: Either a b -> Partial a
fromLeft :: Either a b -> Partial a
fromLeft Either a b
x = a -> Partial a
forall a. a -> Partial a
partial (a -> Partial a) -> a -> Partial a
forall a b. (a -> b) -> a -> b
$
    case Either a b
x of
        Right b
_ -> String -> String -> a
forall a. String -> String -> a
partialError String
"fromLeft" String
"Right"
        Left a
a -> a
a