module Text.ValveVKV(parseValveVKV, parseToVKV, fromValveVKV, (.:), (^:), ValveVKV,
    ValveKeyValueEntry(KVObject, KVInt, KVString), Pair (Pair), unpair, Context, vkvParser) where
-- Library for processing Valve's value keyvalue format. The main function you will wish to use is parseValveVKV. To convert it into your own type, you

-- will need to write a 'ValveVKV' instance for it.


import Text.Parsec
import Text.ValveVKV.Internal
import Text.ValveVKV.Class
import Data.Maybe (mapMaybe)

-- | The main function you will be using. Turns the ValveVKV string into a type that has the 'ValveVKV' typeclass.

parseValveVKV :: ValveVKV a => String -> Either String a
parseValveVKV :: String -> Either String a
parseValveVKV String
input =
    let parseRes :: Either ParseError [ValveKeyValueEntry]
parseRes = Parsec String () [ValveKeyValueEntry]
-> String -> String -> Either ParseError [ValveKeyValueEntry]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [ValveKeyValueEntry]
vkvParser String
"" String
input in
    case Either ParseError [ValveKeyValueEntry]
parseRes of
        Left ParseError
s -> String -> Either String a
forall a b. a -> Either a b
Left (ParseError -> String
forall a. Show a => a -> String
show ParseError
s)
        Right [ValveKeyValueEntry]
a ->
            let topObj :: ValveKeyValueEntry
topObj = Pair [ValveKeyValueEntry] -> ValveKeyValueEntry
KVObject (String -> [ValveKeyValueEntry] -> Pair [ValveKeyValueEntry]
forall a. String -> a -> Pair a
Pair String
"top" [ValveKeyValueEntry]
a) in
            ValveKeyValueEntry -> ValveKeyValueEntry -> Either String a
forall a.
ValveVKV a =>
ValveKeyValueEntry -> ValveKeyValueEntry -> Either String a
fromValveVKV ValveKeyValueEntry
topObj ValveKeyValueEntry
topObj

-- | Parses it directly to a list of entries. Most of the times, 'parseValveVKV' will be better to directly turn it into a Haskell type of your choice

--

-- @since 1.0.1.0

parseToVKV :: String -> Either ParseError [ValveKeyValueEntry]
parseToVKV :: String -> Either ParseError [ValveKeyValueEntry]
parseToVKV = Parsec String () [ValveKeyValueEntry]
-> String -> String -> Either ParseError [ValveKeyValueEntry]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () [ValveKeyValueEntry]
vkvParser String
""