{-|
Module      : Network.Gopher.Util.Gophermap
Stability   : experimental
Portability : POSIX

This module implements a parser for gophermap files.

Example usage:

@
import Network.Gopher.Util.Gophermap
import qualified Data.ByteString as B
import Data.Attoparsec.ByteString

main = do
  file <- B.readFile "gophermap"
  print $ parseOnly parseGophermap file
@


-}

{-# LANGUAGE OverloadedStrings #-}
module Network.Gopher.Util.Gophermap (
    parseGophermap
  , GophermapEntry (..)
  , GophermapFilePath (..)
  , Gophermap
  , gophermapToDirectoryResponse
  ) where

import Prelude hiding (take, takeWhile)

import Network.Gopher.Types
import Network.Gopher.Util

import Control.Applicative ((<|>))
import Data.Attoparsec.ByteString
import Data.ByteString (ByteString (), pack, unpack, isPrefixOf)
import Data.Maybe (fromMaybe)
import qualified Data.String.UTF8 as U
import Data.Word (Word8 ())
import System.FilePath.Posix.ByteString (RawFilePath, (</>))

-- | Given a directory and a Gophermap contained within it,
--   return the corresponding gopher menu response.
gophermapToDirectoryResponse :: RawFilePath -> Gophermap -> GopherResponse
gophermapToDirectoryResponse :: ByteString -> Gophermap -> GopherResponse
gophermapToDirectoryResponse ByteString
dir Gophermap
entries =
  [GopherMenuItem] -> GopherResponse
MenuResponse (forall a b. (a -> b) -> [a] -> [b]
map (ByteString -> GophermapEntry -> GopherMenuItem
gophermapEntryToMenuItem ByteString
dir) Gophermap
entries)

gophermapEntryToMenuItem :: RawFilePath -> GophermapEntry -> GopherMenuItem
gophermapEntryToMenuItem :: ByteString -> GophermapEntry -> GopherMenuItem
gophermapEntryToMenuItem ByteString
dir (GophermapEntry GopherFileType
ft ByteString
desc Maybe GophermapFilePath
path Maybe ByteString
host Maybe Integer
port) =
  GopherFileType
-> ByteString
-> ByteString
-> Maybe ByteString
-> Maybe Integer
-> GopherMenuItem
Item GopherFileType
ft ByteString
desc (forall a. a -> Maybe a -> a
fromMaybe ByteString
desc (GophermapFilePath -> ByteString
realPath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GophermapFilePath
path)) Maybe ByteString
host Maybe Integer
port
  where realPath :: GophermapFilePath -> ByteString
realPath GophermapFilePath
p =
          case GophermapFilePath
p of
            GophermapAbsolute ByteString
p' -> ByteString
p'
            GophermapRelative ByteString
p' -> ByteString
dir ByteString -> ByteString -> ByteString
</> ByteString
p'
            GophermapUrl ByteString
u       -> ByteString
u

fileTypeChars :: [Char]
fileTypeChars :: [Char]
fileTypeChars = [Char]
"0123456789+TgIih"

-- | Wrapper around 'RawFilePath' to indicate whether it is
--   relative or absolute.
data GophermapFilePath
  = GophermapAbsolute RawFilePath -- ^ Absolute path starting with @/@
  | GophermapRelative RawFilePath -- ^ Relative path
  | GophermapUrl RawFilePath      -- ^ URL to another protocol starting with @URL:@
  deriving (Int -> GophermapFilePath -> ShowS
[GophermapFilePath] -> ShowS
GophermapFilePath -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [GophermapFilePath] -> ShowS
$cshowList :: [GophermapFilePath] -> ShowS
show :: GophermapFilePath -> [Char]
$cshow :: GophermapFilePath -> [Char]
showsPrec :: Int -> GophermapFilePath -> ShowS
$cshowsPrec :: Int -> GophermapFilePath -> ShowS
Show, GophermapFilePath -> GophermapFilePath -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GophermapFilePath -> GophermapFilePath -> Bool
$c/= :: GophermapFilePath -> GophermapFilePath -> Bool
== :: GophermapFilePath -> GophermapFilePath -> Bool
$c== :: GophermapFilePath -> GophermapFilePath -> Bool
Eq)

-- | Take 'ByteString' from gophermap, decode it,
--   sanitize and determine path type.
--
--   * Gophermap paths that start with a slash are
--     considered to be absolute.
--   * Gophermap paths that start with "URL:" are
--     considered as an external URL and left as-is.
--   * everything else is considered a relative path
makeGophermapFilePath :: ByteString -> GophermapFilePath
makeGophermapFilePath :: ByteString -> GophermapFilePath
makeGophermapFilePath ByteString
b =
  forall a. a -> Maybe a -> a
fromMaybe (ByteString -> GophermapFilePath
GophermapRelative forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sanitizePath ByteString
b)
    forall a b. (a -> b) -> a -> b
$ forall a. Bool -> a -> Maybe a
boolToMaybe (ByteString
"URL:" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
b) (ByteString -> GophermapFilePath
GophermapUrl ByteString
b)
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Bool -> a -> Maybe a
boolToMaybe (ByteString
"/" ByteString -> ByteString -> Bool
`isPrefixOf` ByteString
b) (ByteString -> GophermapFilePath
GophermapAbsolute forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
sanitizePath ByteString
b)

-- | A gophermap entry makes all values of a gopher menu item optional except for file type and description. When converting to a 'GopherMenuItem', appropriate default values are used.
data GophermapEntry = GophermapEntry
  GopherFileType ByteString
  (Maybe GophermapFilePath) (Maybe ByteString) (Maybe Integer) -- ^ file type, description, path, server name, port number
  deriving (Int -> GophermapEntry -> ShowS
Gophermap -> ShowS
GophermapEntry -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: Gophermap -> ShowS
$cshowList :: Gophermap -> ShowS
show :: GophermapEntry -> [Char]
$cshow :: GophermapEntry -> [Char]
showsPrec :: Int -> GophermapEntry -> ShowS
$cshowsPrec :: Int -> GophermapEntry -> ShowS
Show, GophermapEntry -> GophermapEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GophermapEntry -> GophermapEntry -> Bool
$c/= :: GophermapEntry -> GophermapEntry -> Bool
== :: GophermapEntry -> GophermapEntry -> Bool
$c== :: GophermapEntry -> GophermapEntry -> Bool
Eq)

type Gophermap = [GophermapEntry]

-- | Attoparsec 'Parser' for the gophermap file format
parseGophermap :: Parser Gophermap
parseGophermap :: Parser Gophermap
parseGophermap = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser GophermapEntry
parseGophermapLine forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall t. Chunk t => Parser t ()
endOfInput

gopherFileTypeChar :: Parser Word8
gopherFileTypeChar :: Parser Word8
gopherFileTypeChar = (Word8 -> Bool) -> Parser Word8
satisfy ([Char] -> Word8 -> Bool
inClass [Char]
fileTypeChars)

parseGophermapLine :: Parser GophermapEntry
parseGophermapLine :: Parser GophermapEntry
parseGophermapLine = Parser GophermapEntry
emptyGophermapline
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser GophermapEntry
regularGophermapline
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser GophermapEntry
infoGophermapline

infoGophermapline :: Parser GophermapEntry
infoGophermapline :: Parser GophermapEntry
infoGophermapline = do
  ByteString
text <- (Word8 -> Bool) -> Parser ByteString
takeWhile1 ([Char] -> Word8 -> Bool
notInClass [Char]
"\t\r\n")
  Parser ()
endOfLineOrInput
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GopherFileType
-> ByteString
-> Maybe GophermapFilePath
-> Maybe ByteString
-> Maybe Integer
-> GophermapEntry
GophermapEntry GopherFileType
InfoLine
    ByteString
text
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing
    forall a. Maybe a
Nothing

regularGophermapline :: Parser GophermapEntry
regularGophermapline :: Parser GophermapEntry
regularGophermapline = do
  Word8
fileTypeChar <- Parser Word8
gopherFileTypeChar
  ByteString
text <- Parser ByteString
itemValue
  Word8
_ <- (Word8 -> Bool) -> Parser Word8
satisfy ([Char] -> Word8 -> Bool
inClass [Char]
"\t")
  Maybe ByteString
pathString <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
itemValue
  Maybe ByteString
host <- Parser ByteString (Maybe ByteString)
optionalValue
  Maybe ByteString
portString <- Parser ByteString (Maybe ByteString)
optionalValue
  Parser ()
endOfLineOrInput
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ GopherFileType
-> ByteString
-> Maybe GophermapFilePath
-> Maybe ByteString
-> Maybe Integer
-> GophermapEntry
GophermapEntry (Word8 -> GopherFileType
charToFileType Word8
fileTypeChar)
    ByteString
text
    (ByteString -> GophermapFilePath
makeGophermapFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
pathString)
    Maybe ByteString
host
    (ByteString -> Integer
byteStringToPort forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ByteString
portString)

emptyGophermapline :: Parser GophermapEntry
emptyGophermapline :: Parser GophermapEntry
emptyGophermapline = do
  Parser ()
endOfLine'
  forall (m :: * -> *) a. Monad m => a -> m a
return GophermapEntry
emptyInfoLine
    where emptyInfoLine :: GophermapEntry
emptyInfoLine = GopherFileType
-> ByteString
-> Maybe GophermapFilePath
-> Maybe ByteString
-> Maybe Integer
-> GophermapEntry
GophermapEntry GopherFileType
InfoLine ([Word8] -> ByteString
pack []) forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

byteStringToPort :: ByteString -> Integer
byteStringToPort :: ByteString -> Integer
byteStringToPort ByteString
s = forall a. Read a => [Char] -> a
read forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ([Char], [(Error, Int)])
U.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> [Word8]
unpack forall a b. (a -> b) -> a -> b
$ ByteString
s

optionalValue :: Parser (Maybe ByteString)
optionalValue :: Parser ByteString (Maybe ByteString)
optionalValue = forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
  Word8
_ <- (Word8 -> Bool) -> Parser Word8
satisfy ([Char] -> Word8 -> Bool
inClass [Char]
"\t")
  forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString
itemValue

itemValue :: Parser ByteString
itemValue :: Parser ByteString
itemValue = (Word8 -> Bool) -> Parser ByteString
takeWhile1 ([Char] -> Word8 -> Bool
notInClass [Char]
"\t\r\n")

endOfLine' :: Parser ()
endOfLine' :: Parser ()
endOfLine' = (Word8 -> Parser Word8
word8 Word8
10 forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ()) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString
string ByteString
"\r\n" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return ())

endOfLineOrInput :: Parser ()
endOfLineOrInput :: Parser ()
endOfLineOrInput = forall t. Chunk t => Parser t ()
endOfInput forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
endOfLine'