{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
module Network.ZRE.Parse (parseApi, parseAttoApi) where

import Control.Applicative

import Data.ByteString (ByteString)
import Data.UUID
import Data.Attoparsec.ByteString.Char8 as A

import Data.ZRE (mkGroup)
import Network.ZRE.Types

parseAttoApi :: ByteString -> Either String API
parseAttoApi :: ByteString -> Either String API
parseAttoApi = forall a. Parser a -> ByteString -> Either String a
A.parseOnly Parser API
parseApi

parseApi :: Parser API
parseApi :: Parser API
parseApi = do
  Parser API
parseControl

parseControl :: Parser API
parseControl :: Parser API
parseControl = Char -> Parser Char
char Char
'/' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser API
parseCmd

parseCmd :: Parser API
parseCmd :: Parser API
parseCmd =
      Group -> API
DoJoin forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Group
mkGroup  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString ByteString
string ByteString
"join" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
lskip forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
word)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Group -> API
DoLeave forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Group
mkGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString ByteString
string ByteString
"leave" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
lskip forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
word)
  -- TODO quoted shouts
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Group -> ByteString -> API
DoShout forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString ByteString
string ByteString
"shout" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ()
lskip forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> Group
mkGroup forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
word)) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Parser ByteString ()
lskip forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
word)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> UUID -> ByteString -> API
DoWhisper forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString ByteString
string ByteString
"whisper" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString UUID
uuid) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser ByteString ByteString
lw
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> API
DoDebug forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString ByteString
string ByteString
"debug" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> API
DoDebug forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ByteString -> Parser ByteString ByteString
string ByteString
"nodebug" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
  forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (ByteString -> Parser ByteString ByteString
string ByteString
"quit" forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (f :: * -> *) a. Applicative f => a -> f a
pure API
DoQuit)

lw :: Parser ByteString
lw :: Parser ByteString ByteString
lw = Parser ByteString ()
lskip forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString ByteString
word

lskip :: Parser ()
lskip :: Parser ByteString ()
lskip = (Char -> Bool) -> Parser ByteString ()
skipWhile (forall a. Eq a => a -> a -> Bool
==Char
' ')

word :: Parser ByteString
word :: Parser ByteString ByteString
word = (Char -> Bool) -> Parser ByteString ByteString
A.takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
' ')

--uEOL :: Parser ByteString
--uEOL = A.takeTill (pure False)

uuid :: Parser UUID
uuid :: Parser ByteString UUID
uuid = do
  Maybe UUID
mx <- ByteString -> Maybe UUID
fromASCIIBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString ByteString
lw
  case Maybe UUID
mx of
        Maybe UUID
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"no uuid"
        Just UUID
x -> forall (m :: * -> *) a. Monad m => a -> m a
return UUID
x