module SyntaxTrees.Xml (XmlExpression(..), literalExpression, flatten, findAll, find) where

import Utils.Foldable (stringify)

import Data.Map (Map, keys, elems)
import qualified Data.Map as Map
import Data.Maybe (listToMaybe)


data XmlExpression = XmlExpression {
    XmlExpression -> String
tagName     :: String
  , XmlExpression -> Map String String
fields      :: Map String String
  , XmlExpression -> [XmlExpression]
expressions :: [XmlExpression]
  } deriving (XmlExpression -> XmlExpression -> Bool
(XmlExpression -> XmlExpression -> Bool)
-> (XmlExpression -> XmlExpression -> Bool) -> Eq XmlExpression
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: XmlExpression -> XmlExpression -> Bool
$c/= :: XmlExpression -> XmlExpression -> Bool
== :: XmlExpression -> XmlExpression -> Bool
$c== :: XmlExpression -> XmlExpression -> Bool
Eq, Eq XmlExpression
Eq XmlExpression
-> (XmlExpression -> XmlExpression -> Ordering)
-> (XmlExpression -> XmlExpression -> Bool)
-> (XmlExpression -> XmlExpression -> Bool)
-> (XmlExpression -> XmlExpression -> Bool)
-> (XmlExpression -> XmlExpression -> Bool)
-> (XmlExpression -> XmlExpression -> XmlExpression)
-> (XmlExpression -> XmlExpression -> XmlExpression)
-> Ord XmlExpression
XmlExpression -> XmlExpression -> Bool
XmlExpression -> XmlExpression -> Ordering
XmlExpression -> XmlExpression -> XmlExpression
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: XmlExpression -> XmlExpression -> XmlExpression
$cmin :: XmlExpression -> XmlExpression -> XmlExpression
max :: XmlExpression -> XmlExpression -> XmlExpression
$cmax :: XmlExpression -> XmlExpression -> XmlExpression
>= :: XmlExpression -> XmlExpression -> Bool
$c>= :: XmlExpression -> XmlExpression -> Bool
> :: XmlExpression -> XmlExpression -> Bool
$c> :: XmlExpression -> XmlExpression -> Bool
<= :: XmlExpression -> XmlExpression -> Bool
$c<= :: XmlExpression -> XmlExpression -> Bool
< :: XmlExpression -> XmlExpression -> Bool
$c< :: XmlExpression -> XmlExpression -> Bool
compare :: XmlExpression -> XmlExpression -> Ordering
$ccompare :: XmlExpression -> XmlExpression -> Ordering
$cp1Ord :: Eq XmlExpression
Ord)


instance Show XmlExpression where

  show :: XmlExpression -> String
show XmlExpression { tagName :: XmlExpression -> String
tagName = String
tag, Map String String
fields :: Map String String
fields :: XmlExpression -> Map String String
fields, [XmlExpression]
expressions :: [XmlExpression]
expressions :: XmlExpression -> [XmlExpression]
expressions }
    | String
tag String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"literal"  = [String] -> String
forall a. [a] -> a
head ([String] -> String)
-> (Map String String -> [String]) -> Map String String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map String String -> [String]
forall k a. Map k a -> [a]
elems (Map String String -> String) -> Map String String -> String
forall a b. (a -> b) -> a -> b
$ Map String String
fields
    | Bool
otherwise         = String
"<" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tag String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
flds String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
innerExprs   where

        innerExprs :: String
innerExprs = if [XmlExpression] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [XmlExpression]
expressions then String
"/>"
                     else                     String
">"  String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ending

        (String
sep, Int
n) = if (XmlExpression -> String
tagName (XmlExpression -> String)
-> ([XmlExpression] -> XmlExpression) -> [XmlExpression] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [XmlExpression] -> XmlExpression
forall a. [a] -> a
head) [XmlExpression]
expressions String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"literal" then (String
"", Int
0)
                   else                                              (String
"\n", Int
2)

        ending :: String
ending = String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
sep String
sep String
sep Int
n (XmlExpression -> String
forall a. Show a => a -> String
show (XmlExpression -> String) -> [XmlExpression] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [XmlExpression]
expressions) String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"</" String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
tag String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
">"

        flds :: String
flds | Map String String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map String String
fields = String
""
             | Bool
otherwise = String
" " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
fieldsString where

            fieldsString :: String
fieldsString = String -> String -> String -> Int -> [String] -> String
forall (m :: * -> *).
Foldable m =>
String -> String -> String -> Int -> m String -> String
stringify String
" " String
"" String
"" Int
0 ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (String, String) -> String
forall a. Show a => (String, a) -> String
showFn ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(String, String)]
tuples
            showFn :: (String, a) -> String
showFn (String
x, a
y) = String
x String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"=" String -> ShowS
forall a. [a] -> [a] -> [a]
++ a -> String
forall a. Show a => a -> String
show a
y
            tuples :: [(String, String)]
tuples = [String] -> [String] -> [(String, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Map String String -> [String]
forall k a. Map k a -> [k]
keys Map String String
fields) (Map String String -> [String]
forall k a. Map k a -> [a]
elems Map String String
fields)



literalExpression :: String -> XmlExpression
literalExpression :: String -> XmlExpression
literalExpression String
val = XmlExpression :: String -> Map String String -> [XmlExpression] -> XmlExpression
XmlExpression { tagName :: String
tagName = String
"literal",
                                        fields :: Map String String
fields = [(String, String)] -> Map String String
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(String
"value", String
val)],
                                        expressions :: [XmlExpression]
expressions = [] }


flatten :: XmlExpression -> [XmlExpression]
flatten :: XmlExpression -> [XmlExpression]
flatten XmlExpression
expr = XmlExpression
expr XmlExpression -> [XmlExpression] -> [XmlExpression]
forall a. a -> [a] -> [a]
: XmlExpression -> [XmlExpression]
expressions XmlExpression
expr [XmlExpression]
-> (XmlExpression -> [XmlExpression]) -> [XmlExpression]
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= XmlExpression -> [XmlExpression]
flatten


findAll :: (XmlExpression -> Bool) -> XmlExpression -> [XmlExpression]
findAll :: (XmlExpression -> Bool) -> XmlExpression -> [XmlExpression]
findAll XmlExpression -> Bool
f = (XmlExpression -> Bool) -> [XmlExpression] -> [XmlExpression]
forall a. (a -> Bool) -> [a] -> [a]
filter XmlExpression -> Bool
f ([XmlExpression] -> [XmlExpression])
-> (XmlExpression -> [XmlExpression])
-> XmlExpression
-> [XmlExpression]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. XmlExpression -> [XmlExpression]
flatten


find :: (XmlExpression -> Bool) -> XmlExpression -> Maybe XmlExpression
find :: (XmlExpression -> Bool) -> XmlExpression -> Maybe XmlExpression
find XmlExpression -> Bool
f = [XmlExpression] -> Maybe XmlExpression
forall a. [a] -> Maybe a
listToMaybe ([XmlExpression] -> Maybe XmlExpression)
-> (XmlExpression -> [XmlExpression])
-> XmlExpression
-> Maybe XmlExpression
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (XmlExpression -> Bool) -> XmlExpression -> [XmlExpression]
findAll XmlExpression -> Bool
f