module Network.Gopher.Types
  ( GopherFileType (..)
  , GopherResponse (..)
  , GopherMenuItem (..)
  , fileTypeToChar
  , charToFileType
  , isFile
  )
  where

import Prelude hiding (lookup)

import Network.Gopher.Util

import Data.ByteString (ByteString ())
import Data.Word (Word8 ())

-- | entry in a gopher menu
data GopherMenuItem
  = Item GopherFileType ByteString ByteString (Maybe ByteString) (Maybe Integer)
  -- ^ file type, menu text, selector, server name (optional), port (optional).
  --   None of the given 'ByteString's may contain tab characters.
  deriving (Int -> GopherMenuItem -> ShowS
[GopherMenuItem] -> ShowS
GopherMenuItem -> String
(Int -> GopherMenuItem -> ShowS)
-> (GopherMenuItem -> String)
-> ([GopherMenuItem] -> ShowS)
-> Show GopherMenuItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GopherMenuItem] -> ShowS
$cshowList :: [GopherMenuItem] -> ShowS
show :: GopherMenuItem -> String
$cshow :: GopherMenuItem -> String
showsPrec :: Int -> GopherMenuItem -> ShowS
$cshowsPrec :: Int -> GopherMenuItem -> ShowS
Show, GopherMenuItem -> GopherMenuItem -> Bool
(GopherMenuItem -> GopherMenuItem -> Bool)
-> (GopherMenuItem -> GopherMenuItem -> Bool) -> Eq GopherMenuItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GopherMenuItem -> GopherMenuItem -> Bool
$c/= :: GopherMenuItem -> GopherMenuItem -> Bool
== :: GopherMenuItem -> GopherMenuItem -> Bool
$c== :: GopherMenuItem -> GopherMenuItem -> Bool
Eq)

data GopherResponse
  = MenuResponse [GopherMenuItem] -- ^ gopher menu, wrapper around a list of 'GopherMenuItem's
  | FileResponse ByteString       -- ^ return the given 'ByteString' as a file
  | ErrorResponse ByteString      -- ^ gopher menu containing a single error with the given 'ByteString' as text
  deriving (Int -> GopherResponse -> ShowS
[GopherResponse] -> ShowS
GopherResponse -> String
(Int -> GopherResponse -> ShowS)
-> (GopherResponse -> String)
-> ([GopherResponse] -> ShowS)
-> Show GopherResponse
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GopherResponse] -> ShowS
$cshowList :: [GopherResponse] -> ShowS
show :: GopherResponse -> String
$cshow :: GopherResponse -> String
showsPrec :: Int -> GopherResponse -> ShowS
$cshowsPrec :: Int -> GopherResponse -> ShowS
Show, GopherResponse -> GopherResponse -> Bool
(GopherResponse -> GopherResponse -> Bool)
-> (GopherResponse -> GopherResponse -> Bool) -> Eq GopherResponse
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GopherResponse -> GopherResponse -> Bool
$c/= :: GopherResponse -> GopherResponse -> Bool
== :: GopherResponse -> GopherResponse -> Bool
$c== :: GopherResponse -> GopherResponse -> Bool
Eq)

-- | rfc-defined gopher file types plus info line and HTML
data GopherFileType
  = File                 -- ^ text file, default type
  | Directory            -- ^ a gopher menu
  | PhoneBookServer
  | Error                -- ^ error entry in menu
  | BinHexMacintoshFile
  | DOSArchive
  | UnixUuencodedFile
  | IndexSearchServer
  | TelnetSession
  | BinaryFile           -- ^ binary file
  | RedundantServer
  | Tn3270Session
  | GifFile              -- ^ gif
  | ImageFile            -- ^ image of any format
  | InfoLine             -- ^ menu entry without associated file
  | Html                 -- ^ Special type for HTML, most commonly used for <https://en.wikipedia.org/wiki/Gopher_%28protocol%29#URL_links links to other protocols>
  deriving (Int -> GopherFileType -> ShowS
[GopherFileType] -> ShowS
GopherFileType -> String
(Int -> GopherFileType -> ShowS)
-> (GopherFileType -> String)
-> ([GopherFileType] -> ShowS)
-> Show GopherFileType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GopherFileType] -> ShowS
$cshowList :: [GopherFileType] -> ShowS
show :: GopherFileType -> String
$cshow :: GopherFileType -> String
showsPrec :: Int -> GopherFileType -> ShowS
$cshowsPrec :: Int -> GopherFileType -> ShowS
Show, GopherFileType -> GopherFileType -> Bool
(GopherFileType -> GopherFileType -> Bool)
-> (GopherFileType -> GopherFileType -> Bool) -> Eq GopherFileType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GopherFileType -> GopherFileType -> Bool
$c/= :: GopherFileType -> GopherFileType -> Bool
== :: GopherFileType -> GopherFileType -> Bool
$c== :: GopherFileType -> GopherFileType -> Bool
Eq, Eq GopherFileType
Eq GopherFileType
-> (GopherFileType -> GopherFileType -> Ordering)
-> (GopherFileType -> GopherFileType -> Bool)
-> (GopherFileType -> GopherFileType -> Bool)
-> (GopherFileType -> GopherFileType -> Bool)
-> (GopherFileType -> GopherFileType -> Bool)
-> (GopherFileType -> GopherFileType -> GopherFileType)
-> (GopherFileType -> GopherFileType -> GopherFileType)
-> Ord GopherFileType
GopherFileType -> GopherFileType -> Bool
GopherFileType -> GopherFileType -> Ordering
GopherFileType -> GopherFileType -> GopherFileType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: GopherFileType -> GopherFileType -> GopherFileType
$cmin :: GopherFileType -> GopherFileType -> GopherFileType
max :: GopherFileType -> GopherFileType -> GopherFileType
$cmax :: GopherFileType -> GopherFileType -> GopherFileType
>= :: GopherFileType -> GopherFileType -> Bool
$c>= :: GopherFileType -> GopherFileType -> Bool
> :: GopherFileType -> GopherFileType -> Bool
$c> :: GopherFileType -> GopherFileType -> Bool
<= :: GopherFileType -> GopherFileType -> Bool
$c<= :: GopherFileType -> GopherFileType -> Bool
< :: GopherFileType -> GopherFileType -> Bool
$c< :: GopherFileType -> GopherFileType -> Bool
compare :: GopherFileType -> GopherFileType -> Ordering
$ccompare :: GopherFileType -> GopherFileType -> Ordering
$cp1Ord :: Eq GopherFileType
Ord, Int -> GopherFileType
GopherFileType -> Int
GopherFileType -> [GopherFileType]
GopherFileType -> GopherFileType
GopherFileType -> GopherFileType -> [GopherFileType]
GopherFileType
-> GopherFileType -> GopherFileType -> [GopherFileType]
(GopherFileType -> GopherFileType)
-> (GopherFileType -> GopherFileType)
-> (Int -> GopherFileType)
-> (GopherFileType -> Int)
-> (GopherFileType -> [GopherFileType])
-> (GopherFileType -> GopherFileType -> [GopherFileType])
-> (GopherFileType -> GopherFileType -> [GopherFileType])
-> (GopherFileType
    -> GopherFileType -> GopherFileType -> [GopherFileType])
-> Enum GopherFileType
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: GopherFileType
-> GopherFileType -> GopherFileType -> [GopherFileType]
$cenumFromThenTo :: GopherFileType
-> GopherFileType -> GopherFileType -> [GopherFileType]
enumFromTo :: GopherFileType -> GopherFileType -> [GopherFileType]
$cenumFromTo :: GopherFileType -> GopherFileType -> [GopherFileType]
enumFromThen :: GopherFileType -> GopherFileType -> [GopherFileType]
$cenumFromThen :: GopherFileType -> GopherFileType -> [GopherFileType]
enumFrom :: GopherFileType -> [GopherFileType]
$cenumFrom :: GopherFileType -> [GopherFileType]
fromEnum :: GopherFileType -> Int
$cfromEnum :: GopherFileType -> Int
toEnum :: Int -> GopherFileType
$ctoEnum :: Int -> GopherFileType
pred :: GopherFileType -> GopherFileType
$cpred :: GopherFileType -> GopherFileType
succ :: GopherFileType -> GopherFileType
$csucc :: GopherFileType -> GopherFileType
Enum)

fileTypeToChar :: GopherFileType -> Word8
fileTypeToChar :: GopherFileType -> Word8
fileTypeToChar GopherFileType
t = Char -> Word8
asciiOrd (Char -> Word8) -> Char -> Word8
forall a b. (a -> b) -> a -> b
$
  case GopherFileType
t of
    GopherFileType
File -> Char
'0'
    GopherFileType
Directory -> Char
'1'
    GopherFileType
PhoneBookServer -> Char
'2'
    GopherFileType
Error -> Char
'3'
    GopherFileType
BinHexMacintoshFile -> Char
'4'
    GopherFileType
DOSArchive -> Char
'5'
    GopherFileType
UnixUuencodedFile -> Char
'6'
    GopherFileType
IndexSearchServer -> Char
'7'
    GopherFileType
TelnetSession -> Char
'8'
    GopherFileType
BinaryFile -> Char
'9'
    GopherFileType
RedundantServer -> Char
'+'
    GopherFileType
Tn3270Session -> Char
'T'
    GopherFileType
GifFile -> Char
'g'
    GopherFileType
ImageFile -> Char
'I'
    GopherFileType
InfoLine -> Char
'i'
    GopherFileType
Html -> Char
'h'

charToFileType :: Word8 -> GopherFileType
charToFileType :: Word8 -> GopherFileType
charToFileType Word8
c =
  case Word8 -> Char
asciiChr Word8
c of
     Char
'0' -> GopherFileType
File
     Char
'1' -> GopherFileType
Directory
     Char
'2' -> GopherFileType
PhoneBookServer
     Char
'3' -> GopherFileType
Error
     Char
'4' -> GopherFileType
BinHexMacintoshFile
     Char
'5' -> GopherFileType
DOSArchive
     Char
'6' -> GopherFileType
UnixUuencodedFile
     Char
'7' -> GopherFileType
IndexSearchServer
     Char
'8' -> GopherFileType
TelnetSession
     Char
'9' -> GopherFileType
BinaryFile
     Char
'+' -> GopherFileType
RedundantServer
     Char
'T' -> GopherFileType
Tn3270Session
     Char
'g' -> GopherFileType
GifFile
     Char
'I' -> GopherFileType
ImageFile
     Char
'i' -> GopherFileType
InfoLine
     Char
'h' -> GopherFileType
Html
     Char
_   -> GopherFileType
InfoLine -- default value

isFile :: GopherFileType -> Bool
isFile :: GopherFileType -> Bool
isFile GopherFileType
File = Bool
True
isFile GopherFileType
BinHexMacintoshFile = Bool
True
isFile GopherFileType
DOSArchive = Bool
True
isFile GopherFileType
UnixUuencodedFile = Bool
True
isFile GopherFileType
GifFile = Bool
True
isFile GopherFileType
ImageFile = Bool
True
isFile GopherFileType
_ = Bool
False