    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE Strict #-}
    {-# LANGUAGE Trustworthy #-}

    -- | The value reader can handle a delightful mix of binary and
    -- textual input.  It is the most general way of reading values, but
    -- it is less efficient than using the 'Get' instance if you know that
    -- the data will be in the binary format.
    module Futhark.Data.Reader
      ( readValues,
      )
    where

    import Control.Monad
    import Data.Binary
    import qualified Data.ByteString.Lazy.Char8 as LBS
    import Data.Char (isPrint, isSpace)
    import qualified Data.Text as T
    import Futhark.Data
    import Futhark.Data.Parser
    import qualified Text.Megaparsec as MP
    import qualified Text.Megaparsec.Char as MP

    dropRestOfLine, dropSpaces :: LBS.ByteString -> LBS.ByteString
    dropRestOfLine :: ByteString -> ByteString
    dropRestOfLine = Int64 -> ByteString -> ByteString
    LBS.drop Int64
    1 (ByteString -> ByteString)
    -> (ByteString -> ByteString) -> ByteString -> ByteString
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> ByteString -> ByteString
    LBS.dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n')
    dropSpaces :: ByteString -> ByteString
    dropSpaces ByteString
    t = case (Char -> Bool) -> ByteString -> ByteString
    LBS.dropWhile Char -> Bool
    isSpace ByteString
    t of
      ByteString
    t'
        | ByteString
    "--" ByteString -> ByteString -> Bool
    `LBS.isPrefixOf` ByteString
    t' -> ByteString -> ByteString
    dropSpaces (ByteString -> ByteString) -> ByteString -> ByteString
    forall a b. (a -> b) -> a -> b
    $ ByteString -> ByteString
    dropRestOfLine ByteString
    t'
        | Bool
    otherwise -> ByteString
    t'

    readValue :: LBS.ByteString -> Maybe (Value, LBS.ByteString)
    readValue :: ByteString -> Maybe (Value, ByteString)
    readValue ByteString
    full_t
      | Right (ByteString
    t', Int64
    _, Value
    v) <- ByteString
    -> Either (ByteString, Int64, String) (ByteString, Int64, Value)
    forall a.
    Binary a =>
    ByteString
    -> Either (ByteString, Int64, String) (ByteString, Int64, a)
    decodeOrFail ByteString
    full_t =
          (Value, ByteString) -> Maybe (Value, ByteString)
    forall a. a -> Maybe a
    Just (Value
    v, ByteString -> ByteString
    dropSpaces ByteString
    t')
      -- Some nasty hackery where we take the ASCII prefix of the
      -- bytestring, turn it into a Text, run the value parser, and
      -- prepend the remnant back.
      | Bool
    otherwise = do
          let (ByteString
    a, ByteString
    b) = (Char -> Bool) -> ByteString -> (ByteString, ByteString)
    LBS.span (\Char
    c -> Char -> Bool
    isSpace Char
    c Bool -> Bool -> Bool
    || Char -> Bool
    isPrint Char
    c) ByteString
    full_t
          case Parsec Void Text (Value, Text)
    -> String
    -> Text
    -> Either (ParseErrorBundle Text Void) (Value, Text)
    forall e s a.
    Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
    MP.parse
            ((,) (Value -> Text -> (Value, Text))
    -> ParsecT Void Text Identity Value
    -> ParsecT Void Text Identity (Text -> (Value, Text))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parsec Void Text () -> ParsecT Void Text Identity Value
    parseValue Parsec Void Text ()
    space ParsecT Void Text Identity (Text -> (Value, Text))
    -> ParsecT Void Text Identity Text
    -> Parsec Void Text (Value, Text)
    forall a b.
    ParsecT Void Text Identity (a -> b)
    -> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (State Text Void -> Text
    forall s e. State s e -> s
    MP.stateInput (State Text Void -> Text)
    -> ParsecT Void Text Identity (State Text Void)
    -> ParsecT Void Text Identity Text
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> ParsecT Void Text Identity (State Text Void)
    forall e s (m :: * -> *). MonadParsec e s m => m (State s e)
    MP.getParserState))
            String
    ""
            (String -> Text
    T.pack (ByteString -> String
    LBS.unpack ByteString
    a)) of
            Right (Value
    v, Text
    a') -> (Value, ByteString) -> Maybe (Value, ByteString)
    forall a. a -> Maybe a
    Just (Value
    v, String -> ByteString
    LBS.pack (Text -> String
    T.unpack Text
    a') ByteString -> ByteString -> ByteString
    forall a. Semigroup a => a -> a -> a
    <> ByteString
    b)
            Either (ParseErrorBundle Text Void) (Value, Text)
    _ -> Maybe (Value, ByteString)
    forall a. Maybe a
    Nothing
      where
        space :: Parsec Void Text ()
    space = Parsec Void Text ()
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m ()
    MP.space Parsec Void Text () -> Parsec Void Text () -> Parsec Void Text ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Parsec Void Text ()] -> Parsec Void Text ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    MP.choice [ParsecT Void Text Identity Text
    "--" ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity (Tokens Text)
    -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> ParsecT Void Text Identity (Tokens Text)
    restOfLine ParsecT Void Text Identity (Tokens Text)
    -> Parsec Void Text () -> Parsec Void Text ()
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parsec Void Text ()
    space, () -> Parsec Void Text ()
    forall a. a -> ParsecT Void Text Identity a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()]
        restOfLine :: ParsecT Void Text Identity (Tokens Text)
    restOfLine = 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.takeWhileP Maybe String
    forall a. Maybe a
    Nothing (Token Text -> Token Text -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    Token Text
    '\n') ParsecT Void Text Identity (Tokens Text)
    -> Parsec Void Text () -> ParsecT Void Text Identity (Tokens Text)
    forall a b.
    ParsecT Void Text Identity a
    -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* [Parsec Void Text ()] -> Parsec Void Text ()
    forall (f :: * -> *) (m :: * -> *) a.
    (Foldable f, Alternative m) =>
    f (m a) -> m a
    MP.choice [ParsecT Void Text Identity (Tokens Text) -> Parsec Void Text ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ParsecT Void Text Identity (Tokens Text)
    forall e s (m :: * -> *).
    (MonadParsec e s m, Token s ~ Char) =>
    m (Tokens s)
    MP.eol, Parsec Void Text ()
    forall e s (m :: * -> *). MonadParsec e s m => m ()
    MP.eof]

    -- | Parse Futhark values from the given bytestring.
    readValues :: LBS.ByteString -> Maybe [Value]
    readValues :: ByteString -> Maybe [Value]
    readValues = ByteString -> Maybe [Value]
    readValues' (ByteString -> Maybe [Value])
    -> (ByteString -> ByteString) -> ByteString -> Maybe [Value]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ByteString -> ByteString
    dropSpaces
      where
        readValues' :: ByteString -> Maybe [Value]
    readValues' ByteString
    t
          | ByteString -> Bool
    LBS.null ByteString
    t = [Value] -> Maybe [Value]
    forall a. a -> Maybe a
    Just []
          | Bool
    otherwise = do
              (a, t') <- ByteString -> Maybe (Value, ByteString)
    readValue ByteString
    t
              (a :) <$> readValues' t'