content: {-# LANGUAGE DeriveDataTypeable #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE ConstraintKinds #-}
  -- |
  -- Module      : Gauge.Optional
  -- Copyright   : (c) 2017-2018 Vincent Hanquez
  --
  -- A sum-type free Maybe where the value Nothing is
  -- represented by a special value in the original
  -- domain supported
  --
  -- The OptionalTag class is where the special value
  -- is defined
  --
  {-# LANGUAGE DeriveGeneric #-}
  module Gauge.Optional
      ( Optional
      , toOptional
      , unOptional
      , OptionalTag(..)
      , isOmitted
      , omitted
      , toMaybe
      , fromMaybe
      , map
      , both
      ) where
  
  import Prelude hiding (map)
  import Data.Int
  import Data.Word
  import Data.Data
  import GHC.Generics
  import Basement.Compat.CallStack
  
  -- | A type representing a sum-type free Maybe a
  -- where a specific tag represent Nothing
  newtype Optional a = Optional { unOptional :: a }
      deriving (Eq, Show, Read, Typeable, Data, Generic)
  
  class OptionalTag a where
      optionalTag :: a
      isOptionalTag :: a -> Bool
  
  instance OptionalTag Int64 where
      optionalTag = minBound
      isOptionalTag = (==) optionalTag
  instance OptionalTag Word64 where
      optionalTag = maxBound
      isOptionalTag = (==) optionalTag
  instance OptionalTag Double where
      optionalTag = -1/0
      isOptionalTag d = isInfinite d || isNaN d
  
  -- | Create an optional value from a 
  toOptional :: (HasCallStack, OptionalTag a) => String -> a -> Optional a
  toOptional ty v
      | isOptionalTag v = error ("Creating an optional valid value for " ++ ty ++ " using the optional tag")
      | otherwise       = Optional v
  {-# INLINE toOptional #-}
  
  omitted :: OptionalTag a => Optional a
  omitted = Optional optionalTag
  {-# INLINE omitted #-}
  
  isOmitted :: OptionalTag a => Optional a -> Bool
  isOmitted (Optional v)
      | isOptionalTag v = True
      | otherwise       = False
      
  toMaybe :: OptionalTag a => Optional a -> Maybe a
  toMaybe (Optional v) | isOptionalTag v = Nothing
                       | otherwise       = Just v
  {-# INLINE toMaybe #-}
  
  fromMaybe :: (HasCallStack, OptionalTag a) => Maybe a -> Optional a
  fromMaybe Nothing  = Optional optionalTag
  fromMaybe (Just v)
      | isOptionalTag v = error "fromMaybe: creating an optional value using the optional tag"
      | otherwise       = Optional v
  {-# INLINE fromMaybe #-}
  
  map :: OptionalTag a => (a -> a) -> Optional a -> Optional a
  map f o@(Optional v) | isOptionalTag v = o
                       | otherwise       = Optional (f v) 
  {-# INLINE map #-}
  
  both :: (HasCallStack, OptionalTag a) => (a -> a -> a) -> Optional a -> Optional a -> Optional a
  both f o1 o2
      | isOmitted o1    = o2
      | isOmitted o2    = o1
      | isOptionalTag r = error "both: creating an optional value using the optional tag"
      | otherwise       = Optional r
    where r = f (unOptional o1) (unOptional o2)
  