-----------------------------------------------------------------------------
-- |
-- Module  :  ForSyDe.Shallow.Core.AbsentExt
-- Copyright   :  (c) ForSyDe Group, KTH 2007-2008
-- License     :  BSD-style (see the file LICENSE)
-- 
-- Maintainer  :  forsyde-dev@ict.kth.se
-- Stability   :  experimental
-- Portability :  portable
--
-- The 'AbstExt' is used to extend existing data types with the value
--  \'absent\', which models the absence of a value.
-- 
-----------------------------------------------------------------------------
module ForSyDe.Shallow.Core.AbsentExt ( 
  AbstExt (Abst, Prst), fromAbstExt, abstExt, psi, 
  isAbsent, isPresent, abstExtFunc
  ) where


-- |The data type 'AbstExt' has two constructors. The constructor 'Abst' is used to model the absence of a value, while the constructor 'Prst' is used to model present values.
data AbstExt a =  Abst   
               |  Prst a 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)



-- |The function 'fromAbstExt' converts a value from a extended value.
fromAbstExt   :: a -> AbstExt a -> a
-- |The functions 'isPresent' checks for the presence of a value.
isPresent   :: AbstExt a -> Bool
-- |The functions 'isAbsent' checks for the absence of a value.
isAbsent   :: AbstExt a -> Bool
-- |The function 'abstExtFunc' extends a function in order to process absent extended values. If the input is (\"bottom\"), the output will also be  (\"bottom\").
abstExtFunc   :: (a -> b) -> AbstExt a -> AbstExt b
-- | The function 'psi' is identical to 'abstExtFunc' and should be used in future.
psi :: (a -> b) -> AbstExt a -> AbstExt b
-- | The function 'abstExt' converts a usual value to a present value. 
abstExt :: a -> AbstExt a

-- Implementation of Library Functions

-- | The data type 'AbstExt' is defined as an instance of 'Show' and 'Read'. \'_\' represents the value 'Abst' while a present value is represented with its value, e.g.  'Prst' 1 is represented as \'1\'.
instance Show a => Show (AbstExt a) where
  showsPrec :: Int -> AbstExt a -> ShowS
showsPrec Int
_   = AbstExt a -> ShowS
forall a. Show a => AbstExt a -> ShowS
showsAbstExt

showsAbstExt :: Show a => AbstExt a -> String -> String
showsAbstExt :: AbstExt a -> ShowS
showsAbstExt AbstExt a
Abst      = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) String
"_"   
showsAbstExt (Prst a
x)  = String -> ShowS
forall a. [a] -> [a] -> [a]
(++) (a -> String
forall a. Show a => a -> String
show a
x)

instance Read a => Read (AbstExt a) where
  readsPrec :: Int -> ReadS (AbstExt a)
readsPrec Int
_ =  ReadS (AbstExt a)
forall a. Read a => ReadS (AbstExt a)
readsAbstExt 

readsAbstExt :: (Read a) => ReadS (AbstExt a)
readsAbstExt :: ReadS (AbstExt a)
readsAbstExt String
s = [(AbstExt a
forall a. AbstExt a
Abst, String
r1)    | (String
"_", 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
r2)  | (a
x, String
r2) <- ReadS a
forall a. Read a => ReadS a
reads String
s]

abstExt :: a -> AbstExt a
abstExt =  a -> AbstExt a
forall a. a -> AbstExt a
Prst

fromAbstExt :: a -> AbstExt a -> a
fromAbstExt a
x AbstExt a
Abst     =  a
x   
fromAbstExt a
_ (Prst a
y) =  a
y   

isPresent :: AbstExt a -> Bool
isPresent AbstExt a
Abst     = Bool
False
isPresent (Prst a
_) = Bool
True

isAbsent :: AbstExt a -> Bool
isAbsent =  Bool -> Bool
not (Bool -> Bool) -> (AbstExt a -> Bool) -> AbstExt a -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AbstExt a -> Bool
forall a. AbstExt a -> Bool
isPresent

abstExtFunc :: (a -> b) -> AbstExt a -> AbstExt b
abstExtFunc a -> b
f       = AbstExt a -> AbstExt b
f' 
  where f' :: AbstExt a -> AbstExt b
f' AbstExt a
Abst     = AbstExt b
forall a. AbstExt a
Abst
        f' (Prst a
x) = b -> AbstExt b
forall a. a -> AbstExt a
Prst (a -> b
f a
x)


psi :: (a -> b) -> AbstExt a -> AbstExt b
psi = (a -> b) -> AbstExt a -> AbstExt b
forall a b. (a -> b) -> AbstExt a -> AbstExt b
abstExtFunc

instance Functor AbstExt where
  fmap :: (a -> b) -> AbstExt a -> AbstExt b
fmap = (a -> b) -> AbstExt a -> AbstExt b
forall a b. (a -> b) -> AbstExt a -> AbstExt b
abstExtFunc