{-# LINE 1 "src/Network/Telnet/LibTelnet/Iac.hsc" #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

{-|
Module      : Network.Telnet.LibTelnet.Iac
Description : Constants for interpret-as-command (IAC) codes
Copyright   : (c) 2017-2019 Jack Kelly
License     : GPL-3.0-or-later
Maintainer  : jack@jackkelly.name
Stability   : experimental
Portability : non-portable

Telnet interpret-as-command (IAC) codes. See
<http://www.faqs.org/rfcs/rfc854.html RFC 854> for the meaning of many of these.
-}

module Network.Telnet.LibTelnet.Iac
  ( Iac(..)
  , iacNull
  , iacIac
  , iacDont
  , iacDo
  , iacWont
  , iacWill
  , iacSB
  , iacGA
  , iacEL
  , iacEC
  , iacAYT
  , iacAO
  , iacIP
  , iacBreak
  , iacDM
  , iacNOP
  , iacSE
  , iacEOR
  , iacAbort
  , iacSusp
  , iacEOF
  ) where

import Foreign (Storable)
import Foreign.C (CUChar)



-- | Wrapper for telnet commands and special values.
newtype Iac = Iac { unIac :: CUChar } deriving (Eq, Show, Storable)
iacNull  :: Iac
iacNull  = Iac 0
iacIac  :: Iac
iacIac  = Iac 255
iacDont  :: Iac
iacDont  = Iac 254
iacDo  :: Iac
iacDo  = Iac 253
iacWont  :: Iac
iacWont  = Iac 252
iacWill  :: Iac
iacWill  = Iac 251
iacSB  :: Iac
iacSB  = Iac 250
iacGA  :: Iac
iacGA  = Iac 249
iacEL  :: Iac
iacEL  = Iac 248
iacEC  :: Iac
iacEC  = Iac 247
iacAYT  :: Iac
iacAYT  = Iac 246
iacAO  :: Iac
iacAO  = Iac 245
iacIP  :: Iac
iacIP  = Iac 244
iacBreak  :: Iac
iacBreak  = Iac 243
iacDM  :: Iac
iacDM  = Iac 242
iacNOP  :: Iac
iacNOP  = Iac 241
iacSE  :: Iac
iacSE  = Iac 240
iacEOR  :: Iac
iacEOR  = Iac 239
iacAbort  :: Iac
iacAbort  = Iac 238
iacSusp  :: Iac
iacSusp  = Iac 237
iacEOF  :: Iac
iacEOF  = Iac 236

{-# LINE 71 "src/Network/Telnet/LibTelnet/Iac.hsc" #-}