content: module OutputParser (parseOutput, tests) where
  -- | Parses the output of the test programs generated by bnfc.
  
  import Control.Arrow ((***))
  import Data.List
  
  -- text
  import qualified Data.Text as T
  import Data.Text (Text)
  
  import Test.Framework.Pretty (Pretty(..), ($$))
  import TestUtils
  
  parseOutput :: Text -> (Text, Text)
  parseOutput =
      (clean *** clean)                         -- remove headers and spaces
      . break linearizedTreeHeader              -- split at [linearized tree]
      . dropWhile (not . abstractSyntaxHeader)  -- drop before [abstract syntax]
      . T.lines                                 -- Break input into lines
    where clean = T.unlines . map T.strip . dropAround (== "") . drop 1
          dropAround p = dropWhile p . dropWhileEnd p
  
  abstractSyntaxHeader :: Text -> Bool
  abstractSyntaxHeader = (== "[abstract syntax]") . T.toLower
  
  linearizedTreeHeader :: Text -> Bool
  linearizedTreeHeader = (== "[linearized tree]") . T.toLower
  
  tests = makeTestSuite "OutputParser"
      [ makeTestSuite "parseOutput"
          [ makeUnitTest "parses a simple output" $
              let output = "[Abstract Syntax]\n(Foo Bar)\n[Linearized tree]\nfoo bar\n"
                  expected = ("(Foo Bar)\n", "foo bar\n")
                  actual = parseOutput output
              in assertEqual expected actual
          , makeUnitTest "parses an example output" $
              let output = "Parse Successful!\n\n[Abstract Syntax]\n\nSExp (EInt 42)\n\n[Linearized tree]\n\nexp 42"
                  expected = ("SExp (EInt 42)\n", "exp 42\n")
                  actual = parseOutput output
              in assertEqual expected actual
          , makeUnitTest "strips spaces arounds lines" $
              let output = "Parse Successful!\n\n[Abstract Syntax]\n\nSExp (EInt 42) \n\n[Linearized tree]\n\nexp 42  "
                  expected = ("SExp (EInt 42)\n", "exp 42\n")
                  actual = parseOutput output
              in assertEqual expected actual
          ]
      , makeTestSuite "abstractSyntaxHeader"
          [ makeUnitTest "returns true on valid header" $
              assertEqual True $ abstractSyntaxHeader "[Abstract Syntax]"
          ]
      , makeTestSuite "linearizedTreeHeader"
          [ makeUnitTest "returns true on valid header" $
              assertEqual True $ linearizedTreeHeader "[Linearized tree]"
          ]
  
      ]
  
  instance (Pretty a, Pretty b) => Pretty (a, b) where
    pretty (t1,t2) = pretty t1 $$ "-----------" $$ pretty t2
  