From 06c1e7458346ac54408bbe57629b9906dc58c803 Mon Sep 17 00:00:00 2001
From: solomon <ssbothwell@gmail.com>
Date: Sun, 27 Nov 2022 14:35:27 -0800
Subject: [PATCH] Adds additional sessionized tests

---
 test/Scripts.hs | 76 ++++++++++++++++++++++++++++++++-----------------
 test/Spec.hs    | 35 +++++++++++++++++++++++
 2 files changed, 85 insertions(+), 26 deletions(-)

diff --git a/test/Scripts.hs b/test/Scripts.hs
index 178b850..76e8dba 100644
--- a/test/Scripts.hs
+++ b/test/Scripts.hs
@@ -2,27 +2,17 @@
 {-# LANGUAGE QuasiQuotes #-}
 {-# LANGUAGE TemplateHaskellQuotes #-}
 
-module Scripts
-  ( Script (..),
-    mkScript,
-  )
-where
+module Scripts where
+
+-- ( Script (..),
+--   mkScript,
+-- )
 
 --------------------------------------------------------------------------------
 
 import Control.Applicative (asum)
 import Control.Monad (void)
 import Data.Attoparsec.Text
-  ( Parser,
-    endOfInput,
-    isEndOfLine,
-    many',
-    many1,
-    parseOnly,
-    satisfy,
-    skipSpace,
-    takeWhile1,
-  )
 import Data.Text (Text)
 import Data.Text qualified as Text
 import Language.Haskell.TH.Quote (QuasiQuoter (..))
@@ -30,9 +20,8 @@ import Language.Haskell.TH.Syntax (Lift)
 
 --------------------------------------------------------------------------------
 
-newtype Script = Script [(Text, [Text])]
-  deriving stock (Lift)
-  deriving newtype (Show, Read, Eq, Ord)
+data LineType = StartInput Text | StartOutput Text | Continue Text
+  deriving (Show)
 
 end :: Parser ()
 end = asum [void (satisfy isEndOfLine), endOfInput]
@@ -40,15 +29,50 @@ end = asum [void (satisfy isEndOfLine), endOfInput]
 line :: Parser Text
 line = takeWhile1 (not . isEndOfLine) <* end
 
-inputOutputs :: Parser (Text, [Text])
-inputOutputs = do
-  skipSpace
-  input <- ">>>" *> line
-  outputs <- many' (skipSpace *> "<<<" *> line)
-  pure (input, outputs)
+parseLineType :: Parser [LineType]
+parseLineType = do
+  many1 $
+    asum
+      [ fmap StartInput (skipSpace *> void ">>>" *> line),
+        fmap StartOutput (skipSpace *> void "<<<" *> line),
+        fmap Continue (skipSpace *> line)
+      ]
+
+data History = Input Text | Output Text
+  deriving (Show)
+
+following :: [LineType] -> (Text, [LineType])
+following [] = ("", [])
+following (Continue l : ls) =
+  let (a, b) = following ls
+   in ("\n" <> l <> a, b)
+following ls = ("", ls)
+
+aggregateLines :: [LineType] -> [History]
+aggregateLines [] = []
+aggregateLines (StartInput l0 : ls) =
+  let (a, b) = following ls
+   in Input (l0 <> a) : aggregateLines b
+aggregateLines (StartOutput l0 : ls) =
+  let (a, b) = following ls
+   in Output (l0 <> a) : aggregateLines b
+-- ignore lines before the first >>> or <<<
+aggregateLines (Continue _ : ls) = aggregateLines ls
+
+aggregateScript :: [History] -> Script
+aggregateScript history = Script $ reverse $ go history []
+  where
+    go [] res = res
+    go (Input x : xs) res = go xs ((x, []) : res)
+    go (Output _ : _) [] = error "Recieved an output without an input"
+    go (Output o : xs) ((i, os) : res) = go xs ((i, o : os) : res)
+
+newtype Script = Script [(Text, [Text])]
+  deriving stock (Lift)
+  deriving newtype (Show, Read, Eq, Ord)
 
 parseScript :: Parser Script
-parseScript = Script <$> many1 inputOutputs
+parseScript = fmap (aggregateScript . aggregateLines) parseLineType
 
 mkScript :: QuasiQuoter
 mkScript =
@@ -58,5 +82,5 @@ mkScript =
     quoteType _ = error "'script' does not support quoting types"
     quoteDec _ = error "'script' does not support quoting declarations"
     quoteExp str = case parseOnly parseScript (Text.pack str) of
-      Left _err -> error $ str <> " is not a valid script"
+      Left err -> error err
       Right result -> [|result|]
diff --git a/test/Spec.hs b/test/Spec.hs
index 469da2f..35da4bc 100644
--- a/test/Spec.hs
+++ b/test/Spec.hs
@@ -98,3 +98,38 @@ sessionizedBotSpec =
             |]
       result <- runTestScript scenario $ fixBot bot mempty
       result `shouldBe` scenario
+
+    it "preserves bot behavior" $ do
+      let scenario =
+            [mkScript|
+            >>>new
+            <<<Session Started: '0'.
+            >>>use 0: (1 + 2)  
+            <<<Session '0' Output:
+            1 + 2 = 3
+            |]
+      result <- runTestScript scenario $ fixBot bot mempty
+      result `shouldBe` scenario
+
+    it "tracks multiple sessions" $ do
+      let scenario =
+            [mkScript|
+            >>>new
+            <<<Session Started: '0'.
+            >>>new
+            <<<Session Started: '1'.
+            >>>use 0: x := (1 + 2)  
+            <<<Session '0' Output:
+            *variable saved*
+            >>>use 1: x := 42
+            <<<Session '1' Output:
+            *variable saved*
+            >>>use 0: x
+            <<<Session '0' Output:
+            "x" = 3
+            >>>use 1: x
+            <<<Session '1' Output:
+            "x" = 42
+            |]
+      result <- runTestScript scenario $ fixBot bot mempty
+      result `shouldBe` scenario