{-# LANGUAGE OverloadedStrings #-}
module Network.IPFS.Git.RemoteHelper.Command
( Command (..)
, CommandResult (..)
, OptRes (..)
, ListRef (..)
, PushRes (..)
, parseCommand
, renderCommandResult
)
where
import Control.Applicative (liftA2, optional, (<|>))
import Data.Attoparsec.ByteString.Char8 ((<?>))
import qualified Data.Attoparsec.ByteString.Char8 as P
import Data.Char (isSpace)
import Data.Maybe (fromMaybe, isJust)
import Data.Text (Text)
import qualified Data.Text as Text
import Data.Text.Encoding (decodeUtf8)
import Data.IPLD.CID (CID)
data Command
= Capabilities
| List
| ListForPush
| Option Text Text
| Fetch Text Text
| Push Bool Text Text
deriving Show
data CommandResult
= CapabilitiesResult [Text]
| ListResult [ListRef]
| ListForPushResult [ListRef]
| OptionResult OptRes
| FetchOk
| PushResult PushRes
data OptRes
= OptionOk
| OptionUnsupported
| OptionErr Text
data ListRef = ListRef
{ listRefValue :: Maybe Text
, listRefName :: Text
, listRefAttrs :: [Text]
}
data PushRes = PushOk Text CID | PushErr Text Text
parseCommand :: P.Parser Command
parseCommand =
(capabilities <?> "capabilities")
<|> (listForPush <?> "listForPush" )
<|> (list <?> "list" )
<|> (option <?> "option" )
<|> (fetch <?> "fetch" )
<|> (push <?> "push" )
where
capabilities = Capabilities <$ P.string "capabilities" <* eof
list = List <$ P.string "list" <* eof
listForPush = ListForPush <$ P.string "list for-push" <* eof
option =
P.string "option" *> P.skipSpace
*> liftA2 Option (notSpace <* P.skipSpace) notSpace
<* eof
fetch =
P.string "fetch" *> P.skipSpace
*> liftA2 Fetch (notSpace <* P.skipSpace) notSpace
<* eof
push = do
P.string "push" *> P.skipSpace
force <- isJust <$> optional (P.char '+')
src <- decodeUtf8 <$> P.takeWhile1 (/= ':') <* P.char ':'
dst <- decodeUtf8 <$> P.takeByteString
pure $ Push force src dst
notSpace = decodeUtf8 <$> P.takeWhile1 (not . isSpace)
eof = P.endOfInput
renderCommandResult :: CommandResult -> Text
renderCommandResult = \case
CapabilitiesResult xs -> Text.unlines xs <> "\n"
ListResult xs -> Text.unlines (map renderListRef xs) <> "\n"
ListForPushResult xs -> Text.unlines (map renderListRef xs) <> "\n"
OptionResult x -> renderOptRes x <> "\n"
FetchOk -> "\n"
PushResult x -> renderPushRes x <> "\n\n"
renderListRef :: ListRef -> Text
renderListRef ListRef{..} =
fromMaybe "?" listRefValue
<> " "
<> listRefName
<> Text.intercalate " " listRefAttrs
renderOptRes :: OptRes -> Text
renderOptRes OptionOk = "ok"
renderOptRes OptionUnsupported = "unsupported"
renderOptRes (OptionErr descr) = "error " <> descr
renderPushRes :: PushRes -> Text
renderPushRes (PushOk dst _ ) = "ok " <> dst
renderPushRes (PushErr ref descr) = "error " <> ref <> " " <> descr