{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
--------------------------------------------------------------------
-- |
-- Copyright :  (c) Edward Kmett and Dan Doel 2012-2013
-- License   :  BSD2
-- Maintainer:  Edward Kmett <ekmett@gmail.com>
-- Stability :  experimental
-- Portability: non-portable
--
--------------------------------------------------------------------
module Ermine.Syntax.Literal
  ( Literal(..)
  ) where

import Control.Monad
import qualified Data.Binary as Binary
import Data.Binary (Binary)
import Data.Bytes.Get
import Data.Bytes.Put
import Data.Bytes.Serial
import qualified Data.Serialize as Serialize
import Data.Serialize (Serialize)
import Data.Data hiding (Fixity(..))
import Data.Hashable
import Data.Int
import Data.Text as SText
import GHC.Generics

-- | Primitive literal values used by patterns, terms and core.
data Literal
  = Int     !Int32
  | Long    !Int64
  | Byte    !Int8
  | Short   !Int16
  | String  SText.Text
  | Char    !Char
  | Float   !Float
  | Double  !Double
  | Integer !Integer
  deriving (Eq,Ord,Show,Read,Data,Typeable,Generic)

instance Hashable Literal

instance Serial Literal where
  serialize (Int    i) = putWord8 0 >> serialize i
  serialize (Long   i) = putWord8 1 >> serialize i
  serialize (Byte   i) = putWord8 2 >> serialize i
  serialize (Short  i) = putWord8 3 >> serialize i
  serialize (String i) = putWord8 4 >> serialize i
  serialize (Char   i) = putWord8 5 >> serialize i
  serialize (Float  i) = putWord8 6 >> serialize i
  serialize (Double i) = putWord8 7 >> serialize i
  serialize (Integer i) = putWord8 8 >> serialize i

  deserialize = getWord8 >>= \b -> case b of
    0 -> liftM Int    deserialize
    1 -> liftM Long   deserialize
    2 -> liftM Byte   deserialize
    3 -> liftM Short  deserialize
    4 -> liftM String deserialize
    5 -> liftM Char   deserialize
    6 -> liftM Float  deserialize
    7 -> liftM Double deserialize
    8 -> liftM Integer deserialize
    _ -> fail $ "deserialize Literal: unexpected constructor tag: " ++ show b

instance Binary Literal where
  put = serialize
  get = deserialize

instance Serialize Literal where
  put = serialize
  get = deserialize
