{-# OPTIONS -fno-warn-orphans #-}
module NLP.GenI.BtypesBinary where

import Data.Binary
import NLP.GenI.Btypes

-- auto-generated by the Data.Binary BinaryDerive tool
instance Binary NLP.GenI.Btypes.Ptype where
  put Initial = putWord8 0
  put Auxiliar = putWord8 1
  put Unspecified = putWord8 2
  get = do
    tag_ <- getWord8
    case tag_ of
      0 -> return Initial
      1 -> return Auxiliar
      2 -> return Unspecified
      _ -> fail "no parse"
instance Binary NLP.GenI.Btypes.GeniVal where
  put (GConst a) = putWord8 0 >> put a
  put (GVar a) = putWord8 1 >> put a
  put GAnon = putWord8 2
  get = do
    tag_ <- getWord8
    case tag_ of
      0 -> get >>= \a -> return (GConst a)
      1 -> get >>= \a -> return (GVar a)
      2 -> return GAnon
      _ -> fail "no parse"
instance Binary NLP.GenI.Btypes.GNode where
  put (GN a b c d e f g h) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h
  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \f -> get >>= \g -> get >>= \h -> return (GN a b c d e f g h)

instance Binary NLP.GenI.Btypes.GType where
  put Subs = putWord8 0
  put Foot = putWord8 1
  put Lex = putWord8 2
  put Other = putWord8 3
  get = do
    tag_ <- getWord8
    case tag_ of
      0 -> return Subs
      1 -> return Foot
      2 -> return Lex
      3 -> return Other
      _ -> fail "no parse"
instance (Binary a) => Binary (NLP.GenI.Btypes.Ttree a) where
  put (TT a b c d e f g h) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h
  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \f -> get >>= \g -> get >>= \h -> return (TT a b c d e f g h)

instance Binary NLP.GenI.Btypes.ILexEntry where
  put (ILE a b c d e f g h i) = put a >> put b >> put c >> put d >> put e >> put f >> put g >> put h >> put i
  get = get >>= \a -> get >>= \b -> get >>= \c -> get >>= \d -> get >>= \e -> get >>= \f -> get >>= \g -> get >>= \h -> get >>= \i -> return (ILE a b c d e f g h i)