Finder.hs

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