-- | Provides parsing utilities.
--
-- @since 0.1
module Data.Bytes.Class.Parser
  ( Parser (..),
    parseDigits,
    parse,
  )
where

import Data.Char qualified as Ch
import Data.Text (Text)
import Data.Text qualified as T
import Data.Void (Void)
import Text.Megaparsec (Parsec)
import Text.Megaparsec qualified as MP
import Text.Megaparsec.Char qualified as MPC
import Text.Read qualified as TR

-- | Represents a megaparsec parser. Used for parsing byte types from
-- 'Text'.
--
-- @since 0.1
class Parser a where
  -- | Megaparsec parser for the given type.
  --
  -- @since 0.1
  parser :: Parsec Void Text a

-- | Parser combinator for digits with a 'Read' instance.
--
-- @since 0.1
parseDigits :: (Read n) => Parsec Void Text n
parseDigits :: forall n. Read n => Parsec Void Text n
parseDigits = do
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  Text
b <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
MP.takeWhile1P Maybe String
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
Ch.isDigit Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.')
  ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
MPC.space
  case String -> Maybe n
forall a. Read a => String -> Maybe a
TR.readMaybe (Text -> String
T.unpack Text
b) of
    Maybe n
Nothing -> String -> Parsec Void Text n
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parsec Void Text n) -> String -> Parsec Void Text n
forall a b. (a -> b) -> a -> b
$ String
"Could not read digits: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
b
    Just n
b' -> n -> Parsec Void Text n
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure n
b'
{-# INLINEABLE parseDigits #-}

-- | Parses various byte types from 'Text'. Parsing is
-- lenient in general. We support:
--
-- * Case-insensitivity.
-- * Optional leading\/internal\/trailing whitespace.
-- * Flexible names.
--
-- ==== __Bytes Examples__
--
-- >>> import Data.Bytes (Bytes, Size (..), SomeSize)
-- >>> parse @(Bytes M Int) "70"
-- Right (MkBytes 70)
--
-- >>> parse @(SomeSize Float) "100.45 kilobytes"
-- Right (MkSomeSize SK (MkBytes 100.45))
--
-- >>> parse @(SomeSize Word) "2300G"
-- Right (MkSomeSize SG (MkBytes 2300))
--
-- >>> parse @(SomeSize Float) "5.5 tb"
-- Right (MkSomeSize ST (MkBytes 5.5))
--
-- ==== __Network Examples__
--
-- >>> import Data.Bytes.Network (Direction (..), NetBytes, SomeNet, SomeNetDir, SomeNetSize)
-- >>> parse @(NetBytes Up M Int) "70"
-- Right (MkNetBytes (MkBytes 70))
--
-- >>> parse @(SomeNetSize Down Float) "100.45 kilobytes"
-- Right (MkSomeNetSize SK (MkNetBytes (MkBytes 100.45)))
--
-- >>> parse @(SomeNetSize Up Word) "2300G"
-- Right (MkSomeNetSize SG (MkNetBytes (MkBytes 2300)))
--
-- >>> parse @(SomeNetDir T Word) "2300 up"
-- Right (MkSomeNetDir SUp (MkNetBytes (MkBytes 2300)))
--
-- >>> parse @(SomeNetDir M Word) "2300D"
-- Right (MkSomeNetDir SDown (MkNetBytes (MkBytes 2300)))
--
-- >>> parse @(SomeNet Float) "5.5 tb Up"
-- Right (MkSomeNet SUp ST (MkNetBytes (MkBytes 5.5)))
--
-- >>> parse @(SomeNet Float) "5.5 megabytes DOWN"
-- Right (MkSomeNet SDown SM (MkNetBytes (MkBytes 5.5)))
--
-- @since 0.1
parse :: (Parser a) => Text -> Either Text a
parse :: forall a. Parser a => Text -> Either Text a
parse Text
t = case Parsec Void Text a
-> String -> Text -> Either (ParseErrorBundle Text Void) a
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
MP.runParser Parsec Void Text a
forall a. Parser a => Parsec Void Text a
parser String
"Data.Bytes.Class.Parser.parse" Text
t of
  Left ParseErrorBundle Text Void
err -> Text -> Either Text a
forall a b. a -> Either a b
Left (Text -> Either Text a)
-> (ParseErrorBundle Text Void -> Text)
-> ParseErrorBundle Text Void
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
MP.errorBundlePretty (ParseErrorBundle Text Void -> Either Text a)
-> ParseErrorBundle Text Void -> Either Text a
forall a b. (a -> b) -> a -> b
$ ParseErrorBundle Text Void
err
  Right a
v -> a -> Either Text a
forall a b. b -> Either a b
Right a
v
{-# INLINEABLE parse #-}