ValveValueKeyvalue-1.1.0.0: app/Text/ValveVKV/Class.hs

module Text.ValveVKV.Class where

import Text.ValveVKV.Internal
import Control.Monad (forM)
import Data.Maybe (mapMaybe)
import GHC.Base (NonEmpty)
import Data.List.NonEmpty (NonEmpty, nonEmpty)

findFromName :: ValveKeyValueEntry -> String -> [ValveKeyValueEntry]
findFromName (KVObject (Pair _ stuff)) name =
    mapMaybe finder stuff
    where
        finder :: ValveKeyValueEntry -> Maybe ValveKeyValueEntry
        finder this@(KVObject (Pair thisname s)) = if thisname == name then Just this else Nothing
        finder this@(KVString (Pair thisname s)) = if thisname == name then Just this else Nothing
        finder this@(KVInt (Pair thisname s)) = if thisname == name then Just this else Nothing
findFromName _ _ = []

-- | This operator receives an entry on the left side and a string on the right side. It tries to find the subentry named the string inside the entry you gave in on the left.
(.:) :: ValveVKV a => ValveKeyValueEntry -> String -> Either String a 
context .: name =
    let results = findFromName context name in
    case results of
        [] -> Left $ "No items with name " ++ " " ++ name
        x:_ -> fromValveVKV x context
infixl 5 .:

-- | This operator receives an entry on the left side and a string on the right side. It tries to find the string subentry named the string inside the entry you gave in on the left.
(^:) :: ValveKeyValueEntry -> String -> Maybe String
context ^: name =
    let results = findFromName context name in
    case results of
        (KVString (Pair _ s)):_ -> Just s
        _ -> Nothing
infixl 5 ^:

-- | A type synonim for ValveKeyValueEntry
type Context = ValveKeyValueEntry


-- | The class that lets a value to be made from a Valve value-keyvalue format.
-- For example, if you have
-- @
-- data My = My {name :: String, count :: Int}
-- @
-- You write your instance as
-- @
-- instance ValveVKV My where
--     fromValveVKV this _ =
--         My \<$\> this ^: "name" \<*\> this .: "count"
-- @
class ValveVKV a where
    -- | The first argument is the entry that should be turned into the type. The second argument is the entry just above that.
    fromValveVKV :: ValveKeyValueEntry -> Context -> Either String a

instance ValveVKV Int where
    fromValveVKV (KVInt (Pair _ num)) _ = Right num
    fromValveVKV (KVString (Pair name x)) _ = Left $ "No int called " ++ name ++ " found. We did find a string with value " ++ x
    fromValveVKV (KVObject (Pair name _)) _ = Left $ "No int called " ++ name ++ " found. We did find an object named " ++ name

instance ValveVKV a => ValveVKV (Maybe a) where
    fromValveVKV entry con = fromValveVKV entry con

instance ValveVKV Bool where
    fromValveVKV (KVInt (Pair _ 0)) _ = Right False
    fromValveVKV (KVInt (Pair _ 1)) _ = Right True
    fromValveVKV (KVInt (Pair _ x)) _ = Left $ "Could not parse int " ++ show x ++ " as a boolean"
    fromValveVKV _ _ = Left "Could not parse as a boolean"

instance ValveVKV a => ValveVKV [a] where
    fromValveVKV (KVString (Pair name _)) context =
        --Right $ map (`fromValveVKV` context) (findFromName context name)
        traverse (`fromValveVKV` context) (findFromName context name)
    fromValveVKV (KVObject (Pair name _)) context =
        traverse (`fromValveVKV` context) (findFromName context name)
    fromValveVKV (KVInt (Pair name _)) context =
        traverse (`fromValveVKV` context) (findFromName context name)

instance ValveVKV a => ValveVKV (NonEmpty a) where
    fromValveVKV entry context =
        --list >>= nonEmpty
        list >>= \xs ->
            case nonEmpty xs of
                Just x -> Right x
                Nothing -> Left "List was empty"
        where
            list :: ValveVKV a => Either String [a]
            list = fromValveVKV entry context