{-|
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 :: RawFilePath -> Gophermap -> GopherResponse
gophermapToDirectoryResponse RawFilePath
dir Gophermap
entries =
  [GopherMenuItem] -> GopherResponse
MenuResponse ((GophermapEntry -> GopherMenuItem) -> Gophermap -> [GopherMenuItem]
forall a b. (a -> b) -> [a] -> [b]
map (RawFilePath -> GophermapEntry -> GopherMenuItem
gophermapEntryToMenuItem RawFilePath
dir) Gophermap
entries)

gophermapEntryToMenuItem :: RawFilePath -> GophermapEntry -> GopherMenuItem
gophermapEntryToMenuItem :: RawFilePath -> GophermapEntry -> GopherMenuItem
gophermapEntryToMenuItem RawFilePath
dir (GophermapEntry GopherFileType
ft RawFilePath
desc Maybe GophermapFilePath
path Maybe RawFilePath
host Maybe Integer
port) =
  GopherFileType
-> RawFilePath
-> RawFilePath
-> Maybe RawFilePath
-> Maybe Integer
-> GopherMenuItem
Item GopherFileType
ft RawFilePath
desc (RawFilePath -> Maybe RawFilePath -> RawFilePath
forall a. a -> Maybe a -> a
fromMaybe RawFilePath
desc (GophermapFilePath -> RawFilePath
realPath (GophermapFilePath -> RawFilePath)
-> Maybe GophermapFilePath -> Maybe RawFilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe GophermapFilePath
path)) Maybe RawFilePath
host Maybe Integer
port
  where realPath :: GophermapFilePath -> RawFilePath
realPath GophermapFilePath
p =
          case GophermapFilePath
p of
            GophermapAbsolute RawFilePath
p' -> RawFilePath
p'
            GophermapRelative RawFilePath
p' -> RawFilePath
dir RawFilePath -> RawFilePath -> RawFilePath
</> RawFilePath
p'
            GophermapUrl RawFilePath
u       -> RawFilePath
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]
(Int -> GophermapFilePath -> ShowS)
-> (GophermapFilePath -> [Char])
-> ([GophermapFilePath] -> ShowS)
-> Show GophermapFilePath
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
(GophermapFilePath -> GophermapFilePath -> Bool)
-> (GophermapFilePath -> GophermapFilePath -> Bool)
-> Eq GophermapFilePath
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 :: RawFilePath -> GophermapFilePath
makeGophermapFilePath RawFilePath
b =
  GophermapFilePath -> Maybe GophermapFilePath -> GophermapFilePath
forall a. a -> Maybe a -> a
fromMaybe (RawFilePath -> GophermapFilePath
GophermapRelative (RawFilePath -> GophermapFilePath)
-> RawFilePath -> GophermapFilePath
forall a b. (a -> b) -> a -> b
$ RawFilePath -> RawFilePath
sanitizePath RawFilePath
b)
    (Maybe GophermapFilePath -> GophermapFilePath)
-> Maybe GophermapFilePath -> GophermapFilePath
forall a b. (a -> b) -> a -> b
$ Bool -> GophermapFilePath -> Maybe GophermapFilePath
forall a. Bool -> a -> Maybe a
boolToMaybe (RawFilePath
"URL:" RawFilePath -> RawFilePath -> Bool
`isPrefixOf` RawFilePath
b) (RawFilePath -> GophermapFilePath
GophermapUrl RawFilePath
b)
    Maybe GophermapFilePath
-> Maybe GophermapFilePath -> Maybe GophermapFilePath
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> GophermapFilePath -> Maybe GophermapFilePath
forall a. Bool -> a -> Maybe a
boolToMaybe (RawFilePath
"/" RawFilePath -> RawFilePath -> Bool
`isPrefixOf` RawFilePath
b) (RawFilePath -> GophermapFilePath
GophermapAbsolute (RawFilePath -> GophermapFilePath)
-> RawFilePath -> GophermapFilePath
forall a b. (a -> b) -> a -> b
$ RawFilePath -> RawFilePath
sanitizePath RawFilePath
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]
(Int -> GophermapEntry -> ShowS)
-> (GophermapEntry -> [Char])
-> (Gophermap -> ShowS)
-> Show GophermapEntry
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
(GophermapEntry -> GophermapEntry -> Bool)
-> (GophermapEntry -> GophermapEntry -> Bool) -> Eq GophermapEntry
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 = Parser RawFilePath GophermapEntry -> Parser Gophermap
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser RawFilePath GophermapEntry
parseGophermapLine Parser Gophermap -> Parser RawFilePath () -> Parser Gophermap
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser RawFilePath ()
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 RawFilePath GophermapEntry
parseGophermapLine = Parser RawFilePath GophermapEntry
emptyGophermapline
  Parser RawFilePath GophermapEntry
-> Parser RawFilePath GophermapEntry
-> Parser RawFilePath GophermapEntry
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser RawFilePath GophermapEntry
regularGophermapline
  Parser RawFilePath GophermapEntry
-> Parser RawFilePath GophermapEntry
-> Parser RawFilePath GophermapEntry
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser RawFilePath GophermapEntry
infoGophermapline

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

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

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

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

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

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

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

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