Finder.hs

module Operations.Finder (Finder(..)) where


import Parser (runParser)
import ParserCombinators (IsMatch(..), (|*), (<|>))
import Parsers.String (withinSquareBrackets)
import Parsers.Number (unsignedInt)
import Parsers.Char (dot)
import SyntaxTrees.Json(JsExpression(..))
import SyntaxTrees.Yaml (YamlExpression(..))
import SyntaxTrees.Toml (TomlExpression(..))


import qualified Data.Map as Map
import Data.Maybe (listToMaybe)
import Data.Either (fromRight)



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 path
    parsePath = is '$' *> ((index <|> key) |*)

    index = show <$> withinSquareBrackets unsignedInt
    key   = dot *> word
    word  = (noneOf ['.', '['] |*)



instance Finder JsExpression 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