{-# OPTIONS_HADDOCK prune #-}
----------------------------------------------------------------------
-- |
-- Module      :  ForSyDe.Atom.ExB.Absent
-- Copyright   :  (c) George Ungureanu, 2015-2016
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  ugeorge@kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- This module implements the constructors and assocuated utilities of
-- a type which extends the behavior of a function to express "absent
-- events" (see <ForSyDe-Atom.html#halbwachs91 [Halbwachs91]>).
--
-- The 'AbstExt' type can be used directly with the atom patterns
-- defined in "ForSyDe.Atom.ExB", and no helpers or utilities are
-- needed. Example usage:
--
-- >>> res21 (+) (Prst 1) (Prst 2) 
-- 3
-- >>> res21 (+) Abst     Abst 
-- ⟂
-- >>> filter Abst         (Prst 1)
-- ⟂
-- >>> filter (Prst False) (Prst 1)
-- ⟂
-- >>> filter (Prst True)  (Prst 1)
-- 1
-- >>> filter' False 1 :: AbstExt Int
-- ⟂
-- >>> filter' True  1 :: AbstExt Int
-- 1
-- >>> degen 0 (Prst 1)
-- 1
-- >>> degen 0 Abst
-- 0
-- >>> ignore11 (+) 1 (Prst 1)
-- 2
-- >>> ignore11 (+) 1 Abst
-- 1
--
-- Incorrect usage (not covered by @doctest@):
--
-- > λ> res21 (+) (Prst 1) Abst 
-- > *** Exception: [ExB.Absent] Illegal occurrence of an absent and present event
----------------------------------------------------------------------

module ForSyDe.Atom.ExB.Absent (
  AbstExt(..),

  -- | Module "ForSyDe.Atom.ExB" is re-exported for convenience, to
  -- access the atom patterns more easily.

  module ForSyDe.Atom.ExB
  ) where

import ForSyDe.Atom.ExB
import Prelude hiding (filter)

-- | The 'AbstExt' type extends the base type with the \'\(\bot\)\'
-- symbol denoting the absence of a value/event (see
-- <ForSyDe-Atom.html#halbwachs91 [Halbwachs91]>).
data AbstExt a = Abst   -- ^ \(\bot\) denotes the absence of a value
               | Prst a -- ^ \(\top\) a present event with a value
               deriving (AbstExt a -> AbstExt a -> Bool
(AbstExt a -> AbstExt a -> Bool)
-> (AbstExt a -> AbstExt a -> Bool) -> Eq (AbstExt a)
forall a. Eq a => AbstExt a -> AbstExt a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AbstExt a -> AbstExt a -> Bool
$c/= :: forall a. Eq a => AbstExt a -> AbstExt a -> Bool
== :: AbstExt a -> AbstExt a -> Bool
$c== :: forall a. Eq a => AbstExt a -> AbstExt a -> Bool
Eq)

-- | Implements the absent semantics of the extended behavior atoms.
instance ExB AbstExt where
  ------------------------
  extend :: a -> AbstExt a
extend = a -> AbstExt a
forall a. a -> AbstExt a
Prst
  ------------------------
  /.\ :: (a -> a') -> AbstExt a -> AbstExt a'
(/.\) = (a -> a') -> AbstExt a -> AbstExt a'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
  ------------------------
  /*\ :: AbstExt (a -> a') -> AbstExt a -> AbstExt a'
(/*\) = AbstExt (a -> a') -> AbstExt a -> AbstExt a'
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
(<*>)
  ------------------------
  (Prst True) /&\ :: AbstExt Bool -> AbstExt a -> AbstExt a
/&\ a :: AbstExt a
a = AbstExt a
a
  _           /&\ _ = AbstExt a
forall a. AbstExt a
Abst
  ------------------------
  _ /!\ :: a -> AbstExt a -> a
/!\ Prst a :: a
a = a
a
  a :: a
a /!\ _      = a
a 
  ------------------------

-- | Shows 'Abst' as \(\bot\), while a present event is represented
-- with its value.
instance Show a => Show (AbstExt a) where
 showsPrec :: Int -> AbstExt a -> ShowS
showsPrec _ x :: AbstExt a
x = AbstExt a -> ShowS
forall a. Show a => AbstExt a -> ShowS
showsPrst AbstExt a
x
   where showsPrst :: AbstExt a -> ShowS
showsPrst Abst     = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) "\10178"       
         showsPrst (Prst x :: a
x) = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (a -> String
forall a. Show a => a -> String
show a
x)

-- | Reads the \'_\' character to an 'Abst' and a normal value to
-- 'Prst'-wrapped one.
instance Read a => Read (AbstExt a) where
  readsPrec :: Int -> ReadS (AbstExt a)
readsPrec _ x :: String
x       = ReadS (AbstExt a)
forall a. Read a => String -> [(AbstExt a, String)]
readsAbstExt String
x 
   where
     readsAbstExt :: String -> [(AbstExt a, String)]
readsAbstExt s :: String
s =
       [(AbstExt a
forall a. AbstExt a
Abst, String
r1)   | ("_", r1 :: String
r1) <- ReadS String
lex String
s] [(AbstExt a, String)]
-> [(AbstExt a, String)] -> [(AbstExt a, String)]
forall a. [a] -> [a] -> [a]
++
       [(a -> AbstExt a
forall a. a -> AbstExt a
Prst a
x, String
r3) | (x :: a
x, r3 :: String
r3) <- ReadS a
forall a. Read a => ReadS a
reads String
s]

-- | 'Functor' instance. Bypasses the special values and maps a
-- function to the wrapped value. 
instance Functor AbstExt where
  fmap :: (a -> b) -> AbstExt a -> AbstExt b
fmap _ Abst      = AbstExt b
forall a. AbstExt a
Abst
  fmap f :: a -> b
f (Prst x :: a
x)  = b -> AbstExt b
forall a. a -> AbstExt a
Prst (a -> b
f a
x)

-- | 'Applicative' instance, defines a resolution. Check source code
-- for the lifting rules.
instance Applicative AbstExt where
  pure :: a -> AbstExt a
pure = a -> AbstExt a
forall a. a -> AbstExt a
Prst 
  (Prst x :: a -> b
x) <*> :: AbstExt (a -> b) -> AbstExt a -> AbstExt b
<*> (Prst y :: a
y) = b -> AbstExt b
forall a. a -> AbstExt a
Prst (a -> b
x a
y)
  Abst <*> Abst = AbstExt b
forall a. AbstExt a
Abst
  _ <*> _ = String -> AbstExt b
forall a. HasCallStack => String -> a
error "[ExB.Absent] Illegal occurrence of an absent and present event"