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  (JsExpression (..))
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 (String, a) -> Bool
f = ((String, a) -> a) -> [(String, a)] -> [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String, a) -> a
forall a b. (a, b) -> b
snd ([(String, a)] -> [a]) -> (a -> [(String, a)]) -> a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> Bool) -> [(String, a)] -> [(String, a)]
forall a. (a -> Bool) -> [a] -> [a]
filter (String, a) -> Bool
f ([(String, a)] -> [(String, a)])
-> (a -> [(String, a)]) -> a -> [(String, a)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> [(String, a)]
forall a. Finder a => a -> [(String, a)]
toList
  find (String, a) -> Bool
f = [a] -> Maybe a
forall a. [a] -> Maybe a
listToMaybe ([a] -> Maybe a) -> (a -> [a]) -> a -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((String, a) -> Bool) -> a -> [a]
forall a. Finder a => ((String, a) -> Bool) -> a -> [a]
findAll (String, a) -> Bool
f

  findByKeys []       a
expr = a -> Maybe a
forall a. a -> Maybe a
Just a
expr
  findByKeys (String
x : [String]
xs) a
expr = String -> a -> Maybe a
forall a. Finder a => String -> a -> Maybe a
findByKey String
x a
expr Maybe a -> (a -> Maybe a) -> Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> a -> Maybe a
forall a. Finder a => [String] -> a -> Maybe a
findByKeys [String]
xs  where

    findByKey :: String -> a -> Maybe a
findByKey String
key = ((String, a) -> Bool) -> a -> Maybe a
forall a. Finder a => ((String, a) -> Bool) -> a -> Maybe a
find (\(String
str, a
_) -> String
str String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
key)

  findByPath String
path = [String] -> a -> Maybe a
forall a. Finder a => [String] -> a -> Maybe a
findByKeys [String]
pathSeq where

    pathSeq :: [String]
pathSeq = [String] -> Either ParseError [String] -> [String]
forall b a. b -> Either a b -> b
fromRight [] (Either ParseError [String] -> [String])
-> Either ParseError [String] -> [String]
forall a b. (a -> b) -> a -> b
$ Parser [String] -> Input -> Either ParseError [String]
forall a. Parser a -> Input -> Either ParseError a
runParser Parser [String]
parsePath (Input -> Either ParseError [String])
-> Input -> Either ParseError [String]
forall a b. (a -> b) -> a -> b
$ String -> Input
pack String
path
    parsePath :: Parser [String]
parsePath = Char -> Parser Char
forall a. IsMatch a => a -> Parser a
is Char
'$' Parser Char -> Parser [String] -> Parser [String]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((Parser String
index Parser String -> Parser String -> Parser String
forall a. Parser a -> Parser a -> Parser a
<|> Parser String
key) Parser String -> Parser [String]
forall a. Parser a -> Parser [a]
|*)

    index :: Parser String
index = Integer -> String
forall a. Show a => a -> String
show (Integer -> String) -> Parser Integer -> Parser String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Integer -> Parser Integer
forall b. Parser b -> Parser b
withinSquareBrackets Parser Integer
unsignedInt
    key :: Parser String
key   = Parser Char
dot Parser Char -> Parser String -> Parser String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser String
word
    word :: Parser String
word  = (String -> Parser Char
forall a. IsMatch a => [a] -> Parser a
noneOf [Char
'.', Char
'['] Parser Char -> Parser String
forall a. Parser a -> Parser [a]
|*)



instance Finder JsExpression where
  toList :: JsExpression -> [(String, JsExpression)]
toList = \case
    nil :: JsExpression
nil@JsExpression
JsNull       -> [(String
"", JsExpression
nil)]
    n :: JsExpression
n@(JsNumber Double
_)   -> [(String
"", JsExpression
n)]
    bool :: JsExpression
bool@(JsBool Bool
_)  -> [(String
"", JsExpression
bool)]
    str :: JsExpression
str@(JsString String
_) -> [(String
"", JsExpression
str)]
    JsArray [JsExpression]
arr      -> [String] -> [JsExpression] -> [(String, JsExpression)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. [JsExpression] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [JsExpression]
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) [JsExpression]
arr
    JsObject Map String JsExpression
obj     -> Map String JsExpression -> [(String, JsExpression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String JsExpression
obj


instance Finder YamlExpression where
  toList :: YamlExpression -> [(String, YamlExpression)]
toList = \case
    nil :: YamlExpression
nil@YamlExpression
YamlNull              -> [(String
"", YamlExpression
nil)]
    n :: YamlExpression
n@(YamlInteger Integer
_)         -> [(String
"", YamlExpression
n)]
    n :: YamlExpression
n@(YamlFloat Double
_)           -> [(String
"", YamlExpression
n)]
    bool :: YamlExpression
bool@(YamlBool Bool
_)         -> [(String
"", YamlExpression
bool)]
    str :: YamlExpression
str@(YamlString String
_)        -> [(String
"", YamlExpression
str)]
    date :: YamlExpression
date@(YamlDate Day
_)         -> [(String
"", YamlExpression
date)]
    time :: YamlExpression
time@(YamlTime TimeOfDay
_)         -> [(String
"", YamlExpression
time)]
    dateTime :: YamlExpression
dateTime@(YamlDateTime ZonedTime
_) -> [(String
"", YamlExpression
dateTime)]
    YamlList CollectionType
_ [YamlExpression]
arr            -> [String] -> [YamlExpression] -> [(String, YamlExpression)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. [YamlExpression] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [YamlExpression]
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) [YamlExpression]
arr
    YamlMap CollectionType
_ Map String YamlExpression
obj             -> Map String YamlExpression -> [(String, YamlExpression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String YamlExpression
obj


instance Finder TomlExpression where
  toList :: TomlExpression -> [(String, TomlExpression)]
toList = \case
    nil :: TomlExpression
nil@TomlExpression
TomlNull              -> [(String
"", TomlExpression
nil)]
    n :: TomlExpression
n@(TomlInteger Integer
_)         -> [(String
"", TomlExpression
n)]
    n :: TomlExpression
n@(TomlFloat Double
_)           -> [(String
"", TomlExpression
n)]
    bool :: TomlExpression
bool@(TomlBool Bool
_)         -> [(String
"", TomlExpression
bool)]
    str :: TomlExpression
str@(TomlString String
_)        -> [(String
"", TomlExpression
str)]
    date :: TomlExpression
date@(TomlDate Day
_)         -> [(String
"", TomlExpression
date)]
    time :: TomlExpression
time@(TomlTime TimeOfDay
_)         -> [(String
"", TomlExpression
time)]
    dateTime :: TomlExpression
dateTime@(TomlDateTime ZonedTime
_) -> [(String
"", TomlExpression
dateTime)]
    TomlArray [TomlExpression]
arr             -> [String] -> [TomlExpression] -> [(String, TomlExpression)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Int -> String
forall a. Show a => a -> String
show (Int -> String) -> [Int] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Int
0 .. [TomlExpression] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [TomlExpression]
arr Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1]) [TomlExpression]
arr
    TomlTable TableType
_ Map String TomlExpression
obj           -> Map String TomlExpression -> [(String, TomlExpression)]
forall k a. Map k a -> [(k, a)]
Map.toList Map String TomlExpression
obj