-- |
-- Bidirectional version of "Data.Maybe".
{-# LANGUAGE Safe, TypeOperators, QuasiQuotes #-}
module Data.Invertible.Maybe
  ( isJust
  , isNothing
  , listToMaybe
  , maybeToList
  , fromMaybe
  , fromJust
  ) where

import qualified Data.Maybe as M

import Data.Invertible.Bijection
import Data.Invertible.TH
import Data.Invertible.Internal

-- |Convert between 'Just ()' and 'True' (see 'M.isJust').
isJust :: Maybe () <-> Bool
isJust :: Maybe () <-> Bool
isJust =
  [biCase|
    Just () <-> True
    Nothing <-> False
  |]

-- |Convert between 'Nothing' and 'True' (see 'M.isNothing'). (@'Data.Invertible.Bool.not' . 'isJust'@)
isNothing :: Maybe () <-> Bool
isNothing :: Maybe () <-> Bool
isNothing = 
  [biCase|
    Nothing <-> True
    Just () <-> False
  |]

-- |Convert between (the head of) a (singleton) list and 'Maybe' (see 'M.listToMaybe'). (@'Control.Invertible.BiArrow.invert' 'maybeToList'@)
listToMaybe :: [a] <-> Maybe a
listToMaybe :: forall a. [a] <-> Maybe a
listToMaybe = forall a. [a] -> Maybe a
M.listToMaybe forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall a. Maybe a -> [a]
M.maybeToList

-- |Convert between 'Maybe' and a (singleton) list (see 'M.maybeToList'). (@'Control.Invertible.BiArrow.invert' 'listToMaybe'@)
maybeToList :: Maybe a <-> [a]
maybeToList :: forall a. Maybe a <-> [a]
maybeToList = forall (a :: * -> * -> *) b c. Bijection a b c -> Bijection a c b
invert forall a. [a] <-> Maybe a
listToMaybe

-- |Convert between 'Nothing' and a default value, or 'Just' and its value (not a true bijection).
fromMaybe :: Eq a => a -> Maybe a <-> a
fromMaybe :: forall a. Eq a => a -> Maybe a <-> a
fromMaybe a
d = forall a. a -> Maybe a -> a
M.fromMaybe a
d forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: \a
a -> if a
a forall a. Eq a => a -> a -> Bool
== a
d then forall a. Maybe a
Nothing else forall a. a -> Maybe a
Just a
a

-- |Convert between 'Just' and its value.
fromJust :: Maybe a <-> a
fromJust :: forall a. Maybe a <-> a
fromJust = forall a. HasCallStack => Maybe a -> a
M.fromJust forall (a :: * -> * -> *) b c. a b c -> a c b -> Bijection a b c
:<->: forall a. a -> Maybe a
Just