{-# LINE 1 "src/Data/Emacs/Module/Env/Functions.hsc" #-}
----------------------------------------------------------------------------
-- |
-- Module      :  Data.Emacs.Module.Env.Functions
-- Copyright   :  (c) Sergey Vinokurov 2018
-- License     :  BSD3-style (see LICENSE)
-- Maintainer  :  serg.foo@gmail.com
----------------------------------------------------------------------------

{-# LANGUAGE DeriveDataTypeable  #-}
{-# LANGUAGE DeriveFoldable      #-}
{-# LANGUAGE DeriveFunctor       #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE DeriveLift          #-}
{-# LANGUAGE DeriveTraversable   #-}
{-# LANGUAGE FlexibleContexts    #-}
{-# LANGUAGE LambdaCase          #-}
{-# LANGUAGE ScopedTypeVariables #-}

module Data.Emacs.Module.Env.Functions
  ( FuncallExit(..)
  , funcallExitToNum
  , funcallExitFromNum
  ) where

import Data.Data (Data)
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
import Language.Haskell.TH.Syntax (Lift)



-- | Possible Emacs function call outcomes. This is Haskell's version of
data FuncallExit a =
    -- | Function has returned normally.
    FuncallExitReturn
  | -- | Function has signaled an error using @signal@.
    FuncallExitSignal a
  | -- | Function has exit using @throw@.
    FuncallExitThrow a
  deriving (Eq, Ord, Show, Data, Generic, Lift, Typeable, Functor, Foldable, Traversable)

funcallExitToNum :: Num a => FuncallExit b -> a
funcallExitToNum = \case
  FuncallExitReturn   -> (0)
{-# LINE 45 "src/Data/Emacs/Module/Env/Functions.hsc" #-}
  FuncallExitSignal{} -> (1)
{-# LINE 46 "src/Data/Emacs/Module/Env/Functions.hsc" #-}
  FuncallExitThrow{}  -> (2)
{-# LINE 47 "src/Data/Emacs/Module/Env/Functions.hsc" #-}

funcallExitFromNum :: (Eq a, Num a) => a -> Maybe (FuncallExit ())
funcallExitFromNum = \case
  (0) -> Just FuncallExitReturn
{-# LINE 51 "src/Data/Emacs/Module/Env/Functions.hsc" #-}
  (1) -> Just $ FuncallExitSignal ()
{-# LINE 52 "src/Data/Emacs/Module/Env/Functions.hsc" #-}
  (2)  -> Just $ FuncallExitThrow ()
{-# LINE 53 "src/Data/Emacs/Module/Env/Functions.hsc" #-}
  _                                  -> Nothing