module Bookhound.Format.Operations.Finder (Finder(..)) where import Bookhound.Parser (runParser) import Bookhound.ParserCombinators (IsMatch (..), (<|>), (|*)) import Bookhound.Parsers.Char (dot) import Bookhound.Parsers.Number (unsignedInt) import Bookhound.Parsers.String (withinSquareBrackets) import Bookhound.Format.SyntaxTrees.Json (JsonExpression (..)) import Bookhound.Format.SyntaxTrees.Toml (TomlExpression (..)) import Bookhound.Format.SyntaxTrees.Yaml (YamlExpression (..)) import Data.Either (fromRight) import Data.Maybe (listToMaybe) import qualified Data.Map as Map import Data.Text (pack) class Finder a where toList :: a -> [(String, a)] findAll :: ((String, a) -> Bool) -> a -> [a] find :: ((String, a) -> Bool) -> a -> Maybe a findByKeys :: [String] -> a -> Maybe a findByPath :: String -> a -> Maybe a findAll f = fmap snd . filter f . toList find f = listToMaybe . findAll f findByKeys [] expr = Just expr findByKeys (x : xs) expr = findByKey x expr >>= findByKeys xs where findByKey key = find (\(str, _) -> str == key) findByPath path = findByKeys pathSeq where pathSeq = fromRight [] $ runParser parsePath $ pack path parsePath = is '$' *> ((index <|> key) |*) index = show <$> withinSquareBrackets unsignedInt key = dot *> word word = (noneOf ['.', '['] |*) instance Finder JsonExpression where toList = \case nil@JsNull -> [("", nil)] n@(JsNumber _) -> [("", n)] bool@(JsBool _) -> [("", bool)] str@(JsString _) -> [("", str)] JsArray arr -> zip (show <$> [0 .. length arr - 1]) arr JsObject obj -> Map.toList obj instance Finder YamlExpression where toList = \case nil@YamlNull -> [("", nil)] n@(YamlInteger _) -> [("", n)] n@(YamlFloat _) -> [("", n)] bool@(YamlBool _) -> [("", bool)] str@(YamlString _) -> [("", str)] date@(YamlDate _) -> [("", date)] time@(YamlTime _) -> [("", time)] dateTime@(YamlDateTime _) -> [("", dateTime)] YamlList _ arr -> zip (show <$> [0 .. length arr - 1]) arr YamlMap _ obj -> Map.toList obj instance Finder TomlExpression where toList = \case nil@TomlNull -> [("", nil)] n@(TomlInteger _) -> [("", n)] n@(TomlFloat _) -> [("", n)] bool@(TomlBool _) -> [("", bool)] str@(TomlString _) -> [("", str)] date@(TomlDate _) -> [("", date)] time@(TomlTime _) -> [("", time)] dateTime@(TomlDateTime _) -> [("", dateTime)] TomlArray arr -> zip (show <$> [0 .. length arr - 1]) arr TomlTable _ obj -> Map.toList obj