-- Copyright 2013 Evan Laforge
-- This program is distributed under the terms of the GNU General Public
-- License 3.0, see COPYING or http://www.gnu.org/licenses/gpl-3.0.txt

{- | Support for testing the GUI.

    There is a function 'Ui.BlockC.dump', which emits a sexpr-like set of
    key-value pairs representing its current state.  Tests can then check this
    dump for certain expected values.

    Example input: @key1 val1 key2 (subkey1 subval1)@

    Flattened output: @[("key1", "val1"), ("key2.subkey1", "subval1")]@
-}
module Ui.Dump where
import qualified Control.Applicative as Applicative
import qualified Data.Attoparsec.Text as A
import qualified Data.Text as Text

import qualified Util.Lists as Lists
import qualified Util.ParseText as ParseText

import           Global


type Dump = [(String, String)]

newtype Tree = Tree [(String, Val)] deriving (Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> String
$cshow :: Tree -> String
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show)
data Val = Val String | Sub Tree deriving (Int -> Val -> ShowS
[Val] -> ShowS
Val -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Val] -> ShowS
$cshowList :: [Val] -> ShowS
show :: Val -> String
$cshow :: Val -> String
showsPrec :: Int -> Val -> ShowS
$cshowsPrec :: Int -> Val -> ShowS
Show)

parse :: String -> Either Text Dump
parse :: String -> Either Text Dump
parse = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Tree -> Dump
flatten forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Parser a -> Text -> Either Text a
ParseText.parse1 Parser Tree
p_tree forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

flatten :: Tree -> Dump
flatten :: Tree -> Dump
flatten (Tree [(String, Val)]
pairs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> (String, Val) -> Dump
go []) [(String, Val)]
pairs
    where
    go :: [String] -> (String, Val) -> Dump
go [String]
prefix (String
key, Val String
val) = [([String] -> String
flatten_key (String
keyforall a. a -> [a] -> [a]
:[String]
prefix), String
val)]
    go [String]
prefix (String
key, Sub (Tree [(String, Val)]
subs)) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([String] -> (String, Val) -> Dump
go (String
keyforall a. a -> [a] -> [a]
:[String]
prefix)) [(String, Val)]
subs
    flatten_key :: [String] -> String
flatten_key = forall a. Monoid a => a -> [a] -> a
Lists.join String
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

p_tree :: A.Parser Tree
p_tree :: Parser Tree
p_tree = [(String, Val)] -> Tree
Tree forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.many Parser (String, Val)
p_pair

p_pair :: A.Parser (String, Val)
p_pair :: Parser (String, Val)
p_pair = (,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Parser a
ParseText.lexeme Parser String
p_word forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Parser a -> Parser a
ParseText.lexeme (Parser Text Val
p_sub forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text Val
p_val)

p_sub :: A.Parser Val
p_sub :: Parser Text Val
p_sub = Tree -> Val
Sub forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x y a. Parser x -> Parser y -> Parser a -> Parser a
ParseText.between (Char -> Parser Char
A.char Char
'(') (Char -> Parser Char
A.char Char
')') Parser Tree
p_tree

p_val :: A.Parser Val
p_val :: Parser Text Val
p_val = String -> Val
Val forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser String
p_word

p_word :: A.Parser String
p_word :: Parser String
p_word = Text -> String
Text.unpack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Parser Text Text
p_str forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Char -> Bool) -> Parser Text Text
A.takeWhile1 (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` (String
" ()" :: [Char])))

p_str :: A.Parser Text
p_str :: Parser Text Text
p_str = forall x y a. Parser x -> Parser y -> Parser a -> Parser a
ParseText.between (Char -> Parser Char
A.char Char
'"') (Char -> Parser Char
A.char Char
'"')
        (forall a. Monoid a => [a] -> a
mconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f [a]
Applicative.many Parser Text Text
str)
    where
    str :: Parser Text Text
str = do
        Text
chunk <- (Char -> Bool) -> Parser Text Text
A.takeWhile (\Char
c -> Char
c forall a. Eq a => a -> a -> Bool
/= Char
'"' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\\')
        Text
quoted <- forall (f :: * -> *) a. Alternative f => a -> f a -> f a
A.option Text
"" (Text -> Parser Text Text
A.string Text
"\\\"" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Text -> Parser Text Text
A.string Text
"\\\\")
        let res :: Text
res = Text
chunk forall a. Semigroup a => a -> a -> a
<> Int -> Text -> Text
Text.drop Int
1 Text
quoted
        if Text -> Bool
Text.null Text
res then forall (f :: * -> *) a. Alternative f => f a
Applicative.empty else forall (m :: * -> *) a. Monad m => a -> m a
return Text
res