{-# LANGUAGE OverloadedStrings #-}

module Network.DomainAuth.PRD.Lexer (
    structured,
) where

import Control.Applicative
import Data.Attoparsec.ByteString (Parser)
import qualified Data.Attoparsec.ByteString as P
import Data.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.ByteString.Char8 ()
import Data.Word8

----------------------------------------------------------------

concatSpace :: [ByteString] -> ByteString
concatSpace :: [ByteString] -> ByteString
concatSpace = ByteString -> [ByteString] -> ByteString
BS.intercalate ByteString
" "

----------------------------------------------------------------

skipChar :: Word8 -> Parser ()
skipChar :: Word8 -> Parser ()
skipChar Word8
c = () () -> Parser ByteString Word8 -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser ByteString Word8
P.word8 Word8
c

skipWsp :: Parser ()
skipWsp :: Parser ()
skipWsp = (Word8 -> Bool) -> Parser ()
P.skipWhile ((Word8 -> Bool) -> Parser ()) -> (Word8 -> Bool) -> Parser ()
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Bool
P.inClass String
" \t\n"

----------------------------------------------------------------

-- |
--
-- >>> P.parseOnly structured "From: Kazu Yamamoto (=?iso-2022-jp?B?GyRCOzNLXE9CSScbKEI=?=)\n <kazu@example.net>"
-- Right ["From",":","Kazu","Yamamoto","<","kazu","@","example",".","net",">"]
-- >>> P.parseOnly structured "To:A Group(Some people)\n      :Chris Jones <c@(Chris's host.)public.example>,\n          joe@example.org,\n   John <jdoe@one.test> (my dear friend); (the end of the group)\n"
-- Right ["To",":","A","Group",":","Chris","Jones","<","c","@","public",".","example",">",",","joe","@","example",".","org",",","John","<","jdoe","@","one",".","test",">",";"]
-- >>> P.parseOnly structured "Date: Thu,\n      13\n        Feb\n          1969\n      23:32\n               -0330 (Newfoundland Time)\n"
-- Right ["Date",":","Thu",",","13","Feb","1969","23",":","32","-0330"]
-- >>> P.parseOnly structured "From: Pete(A nice \\) chap) <pete(his account)@silly.test(his host)>\n"
-- Right ["From",":","Pete","<","pete","@","silly",".","test",">"]
structured :: Parser [ByteString]
structured :: Parser [ByteString]
structured = [ByteString] -> [ByteString]
removeComments ([ByteString] -> [ByteString])
-> Parser [ByteString] -> Parser [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString -> Parser [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ([Parser ByteString ByteString] -> Parser ByteString ByteString
forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice [Parser ByteString ByteString]
choices)
  where
    removeComments :: [ByteString] -> [ByteString]
removeComments = (ByteString -> Bool) -> [ByteString] -> [ByteString]
forall a. (a -> Bool) -> [a] -> [a]
filter (ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
/= ByteString
"")
    choices :: [Parser ByteString ByteString]
choices = [Parser ByteString ByteString
specials, Parser ByteString ByteString
quotedString, Parser ByteString ByteString
domainLiteral, Parser ByteString ByteString
atom, Parser ByteString ByteString
comment]

specials :: Parser ByteString
specials :: Parser ByteString ByteString
specials = Parser ByteString ByteString
specialChar Parser ByteString ByteString
-> Parser () -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipWsp
  where
    -- removing "()[]\\\""
    specialChar :: Parser ByteString ByteString
specialChar = Word8 -> ByteString
BS.singleton (Word8 -> ByteString)
-> Parser ByteString Word8 -> Parser ByteString ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Parser ByteString Word8
word8in String
"<>:;@=,."

----------------------------------------------------------------

atom :: Parser ByteString
atom :: Parser ByteString ByteString
atom = Parser ByteString ByteString
atext Parser ByteString ByteString
-> Parser () -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipWsp
  where
    atext :: Parser ByteString ByteString
atext = (Word8 -> Bool) -> Parser ByteString ByteString
P.takeWhile1 ((Word8 -> Bool) -> Parser ByteString ByteString)
-> (Word8 -> Bool) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Bool
P.inClass String
"0-9a-zA-Z!#$%&'*+/=?^_`{|}~-"

----------------------------------------------------------------

domainLiteral :: Parser ByteString
domainLiteral :: Parser ByteString ByteString
domainLiteral = do
    Word8 -> Parser ()
skipChar Word8
_bracketleft
    [ByteString]
ds <- Parser ByteString ByteString -> Parser [ByteString]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString ByteString
dtext Parser ByteString ByteString
-> Parser () -> Parser ByteString ByteString
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipWsp)
    Word8 -> Parser ()
skipChar Word8
_bracketright
    Parser ()
skipWsp
    ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
concatSpace [ByteString]
ds
  where
    dtext :: Parser ByteString ByteString
dtext = (Word8 -> Bool) -> Parser ByteString ByteString
P.takeWhile1 ((Word8 -> Bool) -> Parser ByteString ByteString)
-> (Word8 -> Bool) -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ String -> Word8 -> Bool
P.inClass String
"!-Z^-~"

----------------------------------------------------------------

word8in :: String -> Parser Word8
word8in :: String -> Parser ByteString Word8
word8in = (Word8 -> Bool) -> Parser ByteString Word8
P.satisfy ((Word8 -> Bool) -> Parser ByteString Word8)
-> (String -> Word8 -> Bool) -> String -> Parser ByteString Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Word8 -> Bool
P.inClass

qtext :: Parser Word8
qtext :: Parser ByteString Word8
qtext = String -> Parser ByteString Word8
word8in String
"!#-[]-~"

qcontent :: Parser Word8
qcontent :: Parser ByteString Word8
qcontent = Parser ByteString Word8
qtext Parser ByteString Word8
-> Parser ByteString Word8 -> Parser ByteString Word8
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Word8
quoted_pair

quotedString :: Parser ByteString
quotedString :: Parser ByteString ByteString
quotedString = do
    Word8 -> Parser ()
skipChar Word8
_quotedbl
    Parser ()
skipWsp
    [ByteString]
qs <- ([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> ByteString
BS.pack ([[Word8]] -> [ByteString])
-> Parser ByteString [[Word8]] -> Parser [ByteString]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString [Word8] -> Parser ByteString [[Word8]]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ByteString Word8 -> Parser ByteString [Word8]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some Parser ByteString Word8
qcontent Parser ByteString [Word8] -> Parser () -> Parser ByteString [Word8]
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipWsp)
    Word8 -> Parser ()
skipChar Word8
_quotedbl
    Parser ()
skipWsp
    ByteString -> Parser ByteString ByteString
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Parser ByteString ByteString)
-> ByteString -> Parser ByteString ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
concatSpace [ByteString]
qs

----------------------------------------------------------------

quoted_pair :: Parser Word8
quoted_pair :: Parser ByteString Word8
quoted_pair = Word8 -> Parser ()
skipChar Word8
_backslash Parser () -> Parser ByteString Word8 -> Parser ByteString Word8
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> Parser ByteString Word8
word8in String
"!-~ \t\n" -- vchar ++ wsp

----------------------------------------------------------------

ctext :: Parser Word8
ctext :: Parser ByteString Word8
ctext = String -> Parser ByteString Word8
word8in String
"!-'*-[]-~"

ccontent :: Parser ()
ccontent :: Parser ()
ccontent = () () -> Parser ByteString [Word8] -> Parser ()
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ByteString Word8 -> Parser ByteString [Word8]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (Parser ByteString Word8
ctext Parser ByteString Word8
-> Parser ByteString Word8 -> Parser ByteString Word8
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ByteString Word8
quoted_pair)

comment' :: Parser ()
comment' :: Parser ()
comment' = do
    Word8 -> Parser ()
skipChar Word8
_parenleft
    Parser ()
skipWsp
    [()]
_ <- Parser () -> Parser ByteString [()]
forall a. Parser ByteString a -> Parser ByteString [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many ((Parser ()
ccontent Parser () -> Parser () -> Parser ()
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser ()
comment') Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skipWsp)
    Word8 -> Parser ()
skipChar Word8
_parenright
    Parser ()
skipWsp
    () -> Parser ()
forall a. a -> Parser ByteString a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

comment :: Parser ByteString
comment :: Parser ByteString ByteString
comment = ByteString
"" ByteString -> Parser () -> Parser ByteString ByteString
forall a b. a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Parser ()
comment'