Skip to content

Commit

Permalink
Adds additional sessionized tests
Browse files Browse the repository at this point in the history
  • Loading branch information
solomon-b authored and masaeedu committed Jan 7, 2023
1 parent 7e8616f commit 06c1e74
Show file tree
Hide file tree
Showing 2 changed files with 85 additions and 26 deletions.
76 changes: 50 additions & 26 deletions test/Scripts.hs
Original file line number Diff line number Diff line change
Expand Up @@ -2,53 +2,77 @@
{-# 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 (..))
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]

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 =
Expand All @@ -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|]
35 changes: 35 additions & 0 deletions test/Spec.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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

0 comments on commit 06c1e74

Please sign in to comment.