packages feed

bookhound-format-0.1.2.0: src/Bookhound/Format/SyntaxTrees/Xml.hs

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

import Bookhound.Utils.Foldable (stringify)

import Data.Maybe (listToMaybe)

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


data XmlExpression
  = XmlExpression
      { tagName     :: String
      , fields      :: Map String String
      , expressions :: [XmlExpression]
      }
  deriving (Eq, Ord)


instance Show XmlExpression where

  show XmlExpression { tagName = tag, .. }
    | tag == "literal" = head . elems $ fields
    | otherwise        = "<" <> tag <> flds <> innerExprs
    where
      innerExprs = if | null expressions -> "/>"
                      | otherwise        -> ">"  <> ending

      (sep, n) = if | ((tagName) . head) expressions == "literal" -> ("", 0)
                    | otherwise                                   -> ("\n", 2)

      ending = stringify sep sep sep n (show <$> expressions) <> "</" <> tag <> ">"

      flds | null fields = ""
           | otherwise = " " <> fieldsString
        where
          fieldsString = stringify " " "" "" 0 $ showFn <$> tuples
          showFn (x, y) = x <> "=" <> show y
          tuples = zip (keys fields) (elems fields)



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


flatten :: XmlExpression -> [XmlExpression]
flatten expr = expr : expressions expr >>= flatten


findAll :: (XmlExpression -> Bool) -> XmlExpression -> [XmlExpression]
findAll f = filter f . flatten


find :: (XmlExpression -> Bool) -> XmlExpression -> Maybe XmlExpression
find f = listToMaybe . findAll f