{-# 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, (</>))
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
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"
data GophermapFilePath
= GophermapAbsolute RawFilePath
| GophermapRelative RawFilePath
| GophermapUrl RawFilePath
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)
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)
data GophermapEntry = GophermapEntry
GopherFileType ByteString
(Maybe GophermapFilePath) (Maybe ByteString) (Maybe Integer)
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]
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'