{-# 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 = () forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Word8 -> Parser Word8
P.word8 Word8
c

skipWsp :: Parser ()
skipWsp :: Parser ()
skipWsp = (Word8 -> Bool) -> Parser ()
P.skipWhile 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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall (f :: * -> *) a. Alternative f => [f a] -> f a
P.choice [Parser ByteString]
choices)
  where
    removeComments :: [ByteString] -> [ByteString]
removeComments = forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/=ByteString
"")
    choices :: [Parser ByteString]
choices = [Parser ByteString
specials,Parser ByteString
quotedString,Parser ByteString
domainLiteral,Parser ByteString
atom,Parser ByteString
comment]

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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