Maybe.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE FlexibleContexts #-}
--
-- Maybe.hs --- Optional Ivory values.
--
-- Copyright (C) 2013, Galois, Inc.
-- All Rights Reserved.
--
-- This software is released under the "BSD3" license.  Read the file
-- "LICENSE" for more information.
--

-- | This module provides an interface for a nullable Ivory type.
--
-- To define a type like Haskell's @Maybe Float@, define an
-- Ivory structure type, and make the structure an instance
-- of 'MaybeType'.
--
-- > [ivory|
-- > struct maybe_float
-- >   { mf_valid :: Stored IBool
-- >   ; mf_value :: Stored IFloat
-- >   }
-- > |]
-- >
-- > instance MaybeType "maybe_float" IFloat where
-- >   maybeValidLabel = mf_valid
-- >   maybeValueLabel = mf_value
--
-- With this definition in place, any of the functions in this
-- module will accept a @Struct \"maybe_float\"@.
--
-- These structure types must be defined in an Ivory module as
-- usual, and it is recommended to make them private unless they
-- are necessary as part of the module's public interface.
module Ivory.Stdlib.Maybe
  (
  -- * Interface
  MaybeType(..)

  -- * Initialization
  , initJust, initNothing

  -- * Getting
  , getMaybe

  -- * Setting
  , setJust, setNothing
  , setDefault, setDefault_

  -- * Modifying
  , mapMaybe
  , mapMaybeM, mapMaybeM_
  , forMaybeM, forMaybeM_
  ) where

import GHC.TypeLits

import Ivory.Language

class (IvoryStruct sym, IvoryExpr t, IvoryStore t, IvoryInit t) =>
      MaybeType (sym :: Symbol) t | sym -> t where
  -- | Return a boolean field indicating whether the value is valid.
  maybeValidLabel :: Label sym (Stored IBool)
  -- | Return the field containing a value, if it is valid.
  maybeValueLabel :: Label sym (Stored t)

-- | Return an initializer for a maybe type with a valid value.
initJust :: MaybeType sym a => a -> Init (Struct sym)
initJust x =
  istruct
    [ maybeValidLabel .= ival true
    , maybeValueLabel .= ival x
    ]

-- | Return an initializer for a maybe type with no value.
initNothing :: MaybeType sym a => Init (Struct sym)
initNothing =
  istruct
    [ maybeValidLabel .= ival false
    ]

-- | Retrieve a maybe's value given a default if it is nothing.
getMaybe :: MaybeType sym a
         => ConstRef s1 (Struct sym)
         -> a
         -> Ivory eff a
getMaybe ref def = do
  valid <- deref (ref ~> maybeValidLabel)
  value <- deref (ref ~> maybeValueLabel)
  assign (valid ? (value, def))

-- | Set a maybe's value to a default if it is nothing, returning
-- the current value.
setDefault :: MaybeType sym a
           => Ref s1 (Struct sym)
           -> a
           -> Ivory eff a
setDefault ref def = do
  setDefault_ ref def
  deref (ref ~> maybeValueLabel)

-- | Set a maybe's value to a default value if it is nothing.
setDefault_ :: MaybeType sym a
            => Ref s1 (Struct sym)
            -> a
            -> Ivory eff ()
setDefault_ ref def = do
  valid <- deref (ref ~> maybeValidLabel)
  ifte_ (iNot valid)
    (do store (ref ~> maybeValidLabel) true
        store (ref ~> maybeValueLabel) def)
    (return ())

-- | Modify a maybe value by an expression if it is not nothing.
mapMaybe :: MaybeType sym a
         => (a -> a)
         -> Ref s1 (Struct sym)
         -> Ivory eff ()
mapMaybe f ref = mapMaybeM (return . f) ref

-- | Modify a maybe value by an action if it is not nothing.
mapMaybeM :: MaybeType sym a
          => (a -> Ivory eff a)
          -> Ref s1 (Struct sym)
          -> Ivory eff ()
mapMaybeM f ref = do
  valid <- deref (ref ~> maybeValidLabel)
  ifte_ valid
    (do value  <- deref (ref ~> maybeValueLabel)
        value' <- f value
        store (ref ~> maybeValueLabel) value')
    (return ())

-- | Flipped version of 'mapMaybeM'.
forMaybeM :: MaybeType sym a
          => Ref s1 (Struct sym)
          -> (a -> Ivory eff a)
          -> Ivory eff ()
forMaybeM = flip mapMaybeM

-- | Call an action with a maybe value if it is not nothing.
mapMaybeM_ :: MaybeType sym a
           => (a -> Ivory eff ())
           -> Ref s1 (Struct sym)
           -> Ivory eff ()
mapMaybeM_ f ref = do
  valid <- deref (ref ~> maybeValidLabel)
  ifte_ valid
    (do value <- deref (ref ~> maybeValueLabel)
        f value)
    (return ())

-- | Flipped version of 'mapMaybeM_'.
forMaybeM_ :: MaybeType sym a
           => Ref s1 (Struct sym)
           -> (a -> Ivory eff ())
           -> Ivory eff ()
forMaybeM_ = flip mapMaybeM_

-- | Set a maybe value to a valid value.
setJust :: MaybeType sym a
        => Ref s1 (Struct sym)
        -> a
        -> Ivory eff ()
setJust ref x = do
  store (ref ~> maybeValidLabel) true
  store (ref ~> maybeValueLabel) x

-- | Set a maybe value to an invalid value.
setNothing :: MaybeType sym a
           => Ref s1 (Struct sym)
           -> Ivory eff ()
setNothing ref = store (ref ~> maybeValidLabel) false