module Sound.Audacity.XML where

import qualified Text.HTML.Tagchup.Tag as Tag
import qualified Text.XML.Basic.Attribute as Attr
import qualified Text.XML.Basic.Name.MixedCase as Name

import qualified Data.List as List

import Prelude hiding (unlines)


tag ::
   String -> a ->
   [Attr.T Name.T (a -> String)] ->
   [[Tag.T Name.T String]] ->
   [[Tag.T Name.T String]]
tag :: forall a.
String
-> a -> [T T (a -> String)] -> [[T T String]] -> [[T T String]]
tag String
name a
x [T T (a -> String)]
attrs [[T T String]]
enclosed =
   let tagName :: Name T
tagName = T -> Name T
forall ident. ident -> Name ident
Tag.Name (T -> Name T) -> T -> Name T
forall a b. (a -> b) -> a -> b
$ String -> T
Name.Cons String
name
   in  [Name T -> [T T String] -> T T String
forall name string. Name name -> [T name string] -> T name string
Tag.open Name T
tagName ([T T String] -> T T String) -> [T T String] -> T T String
forall a b. (a -> b) -> a -> b
$ ((a -> String) -> String) -> [T T (a -> String)] -> [T T String]
forall str0 str1 name.
(str0 -> str1) -> [T name str0] -> [T name str1]
Attr.mapValues ((a -> String) -> a -> String
forall a b. (a -> b) -> a -> b
$ a
x) [T T (a -> String)]
attrs] [T T String] -> [[T T String]] -> [[T T String]]
forall a. a -> [a] -> [a]
:
       [[T T String]]
enclosed [[T T String]] -> [[T T String]] -> [[T T String]]
forall a. [a] -> [a] -> [a]
++
       [Name T -> T T String
forall name string. Name name -> T name string
Tag.close Name T
tagName] [T T String] -> [[T T String]] -> [[T T String]]
forall a. a -> [a] -> [a]
:
       []

attr :: String -> a -> Attr.T Name.T a
attr :: forall a. String -> a -> T T a
attr String
name a
value  =  Name T -> a -> T T a
forall name string.
Attribute name =>
Name name -> string -> T name string
Attr.cons (T -> Name T
forall ident. ident -> Name ident
Attr.Name (T -> Name T) -> T -> Name T
forall a b. (a -> b) -> a -> b
$ String -> T
Name.Cons String
name) a
value

unlines :: [[Tag.T Name.T String]] -> [Tag.T Name.T String]
unlines :: [[T T String]] -> [T T String]
unlines =
   [[T T String]] -> [T T String]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[T T String]] -> [T T String])
-> ([[T T String]] -> [[T T String]])
-> [[T T String]]
-> [T T String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int, [[T T String]]) -> [[T T String]]
forall a b. (a, b) -> b
snd ((Int, [[T T String]]) -> [[T T String]])
-> ([[T T String]] -> (Int, [[T T String]]))
-> [[T T String]]
-> [[T T String]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
   (Int -> [T T String] -> (Int, [T T String]))
-> Int -> [[T T String]] -> (Int, [[T T String]])
forall (t :: * -> *) s a b.
Traversable t =>
(s -> a -> (s, b)) -> s -> t a -> (s, t b)
List.mapAccumL
      (\Int
oldIndent [T T String]
tags ->
         let newIndent :: Int
newIndent = Int
oldIndent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ((T T String -> Int) -> [T T String] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map T T String -> Int
tagIndent [T T String]
tags)
         in  (Int
newIndent,
              String -> T T String
forall string name. string -> T name string
Tag.text (Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
oldIndent Int
newIndent) Char
'\t') T T String -> [T T String] -> [T T String]
forall a. a -> [a] -> [a]
:
              [T T String]
tags [T T String] -> [T T String] -> [T T String]
forall a. [a] -> [a] -> [a]
++
              String -> T T String
forall string name. string -> T name string
Tag.text String
"\n" T T String -> [T T String] -> [T T String]
forall a. a -> [a] -> [a]
:
              []))
      Int
0

tagIndent :: Tag.T Name.T String -> Int
tagIndent :: T T String -> Int
tagIndent T T String
t =
   case T T String
t of
      Tag.Open Name T
_ [T T String]
_ -> Int
1
      Tag.Close Name T
_ -> -Int
1
      T T String
_ -> Int
0