diff --git a/src/Haskell/Verified/Examples.hs b/src/Haskell/Verified/Examples.hs index 8daeece..a5353c5 100644 --- a/src/Haskell/Verified/Examples.hs +++ b/src/Haskell/Verified/Examples.hs @@ -18,6 +18,8 @@ where import qualified Control.Concurrent.Async as Async import qualified Data.Foldable as Foldable +import qualified Data.List +import qualified Data.Text.IO import qualified HIE.Bios.Cradle import qualified HIE.Bios.Environment import qualified HIE.Bios.Flags @@ -39,29 +41,27 @@ import qualified System.IO import qualified Text.Read import qualified Prelude --- TODO imports need to support qualified and stuff. This is just a hack to see how things work so far. --- We can use setImportsQ. --- And obviously need to parse it. --- verify :: Module -> Prelude.IO (List ExampleResult) -verify mod = - mod - |> comments - |> examples - |> Prelude.traverse (verifyExample (moduleInfo mod)) - -verifyExample :: ModuleInfo -> Example -> Prelude.IO ExampleResult -verifyExample modInfo example = +verify Module {comments, moduleInfo} = + withContext moduleInfo comments <| \maybeContext -> + comments + |> examples + |> Async.mapConcurrently (verifyExample moduleInfo maybeContext) + +verifyExample :: ModuleInfo -> Maybe Context -> Example -> Prelude.IO ExampleResult +verifyExample modInfo maybeContext example = case example of - VerifiedExample (_, code) -> do - result <- eval modInfo code + VerifiedExample _ code -> do + result <- + Prelude.unlines code + |> eval modInfo maybeContext case result of Prelude.Left err -> Prelude.pure (ExampleVerifyFailed example err) Prelude.Right execResult -> ExampleVerifySuccess example execResult |> Prelude.pure - UnverifiedExample (_, code) -> + UnverifiedExample _ code -> NoExampleResult |> ExampleVerifySuccess example |> Prelude.pure @@ -121,8 +121,12 @@ makeImport importDecl = importToString (LHE.Syntax.IThingAll _ n) = getName n ++ "(..)" importToString (LHE.Syntax.IThingWith _ n ns) = getName n ++ "(" ++ (List.concat <| List.intersperse "," (List.map getCName ns)) ++ ")" -eval :: ModuleInfo -> Text -> Prelude.IO (Prelude.Either Hint.InterpreterError Verified) -eval moduleInfo s = do +eval :: + ModuleInfo -> + Maybe Context -> + Prelude.String -> + Prelude.IO (Prelude.Either Hint.InterpreterError Verified) +eval moduleInfo maybeContext s = do let modulePath = moduleFilePath moduleInfo let interpreter = case packageDbs moduleInfo of [] -> Hint.runInterpreter @@ -136,25 +140,31 @@ eval moduleInfo s = do let searchPaths = List.map Text.toList <| importPaths moduleInfo Hint.set [Hint.languageExtensions Hint.:= langs, Hint.searchPath Hint.:= searchPaths] - Hint.loadModules - ( if modulePath == "" - then preload - else modulePath : preload - ) + [ if modulePath == "" + then [] + else [modulePath], + case maybeContext of + Nothing -> [] + Just Context {contextModulePath} -> [contextModulePath], + preload + ] + |> List.concat + |> Hint.loadModules case moduleName moduleInfo of Just name -> Hint.setTopLevelModules [Text.toList name] Nothing -> Prelude.return () let exampleImports = - List.map - makeSimpleImport - [ "Haskell.Verified.Examples.RunTime", - "Haskell.Verified.Examples.Verified" - ] + [ Just "Haskell.Verified.Examples.RunTime", + Just "Haskell.Verified.Examples.Verified", + Maybe.map contextModuleName maybeContext + ] + |> List.filterMap identity + |> List.map makeSimpleImport Hint.setImportsF (exampleImports ++ imports moduleInfo) - Hint.interpret (Text.toList s) (Hint.as :: Verified) + Hint.interpret s (Hint.as :: Verified) trimPrefix :: Text -> Text -> Maybe Text trimPrefix prefix text @@ -170,9 +180,9 @@ getDefaultLanguageExtensions = List.filterMap <| trimPrefix "-X" getPackageDbs :: List Text -> List Text getPackageDbs options = List.concat [[l, r] | (l, r) <- Prelude.zip options (List.drop 1 options), l == "-package-db"] -exampleFromText :: Text -> Example +exampleFromText :: Prelude.String -> Example exampleFromText val = - toExample LHE.SrcLoc.noSrcSpan val + toExample emptySrcSpan (Prelude.lines val) parse :: Prelude.FilePath -> Prelude.IO Module parse path = do @@ -214,10 +224,60 @@ examples = List.filterMap ( \c -> case c of - PlainTextComment _ -> Nothing + ContextBlockComment _ _ -> Nothing CodeBlockComment example -> Just example ) +contextBlocks :: List Comment -> List Prelude.String +contextBlocks = + List.concatMap + ( \c -> + case c of + ContextBlockComment _ context -> context + CodeBlockComment _ -> [] + ) + +data Context = Context + { contextModulePath :: Prelude.FilePath, + contextModuleName :: Text + } + +withContext :: ModuleInfo -> List Comment -> (Maybe Context -> Prelude.IO a) -> Prelude.IO a +withContext modInfo comments go = do + let contextModuleName = "HaskellVerifiedExamplesContext" + case contextBlocks comments of + [] -> go Nothing + xs -> + withTempFile + ( \path handle -> do + _ <- System.IO.hPutStrLn handle ("module " ++ Text.toList contextModuleName ++ " where") + _ <- + modInfo + |> imports + |> List.map renderImport + |> Prelude.traverse (System.IO.hPutStrLn handle) + xs + |> Prelude.unlines + |> System.IO.hPutStr handle + Prelude.pure () + ) + (\contextModulePath -> go (Just Context {contextModulePath, contextModuleName})) + +renderImport :: Hint.ModuleImport -> Prelude.String +renderImport m = + Prelude.concat + [ "import ", + case Hint.modQual m of + Hint.NotQualified -> Hint.modName m + Hint.ImportAs q -> Hint.modName m ++ " as " ++ q + Hint.QualifiedAs Nothing -> "qualified " ++ Hint.modName m + Hint.QualifiedAs (Just q) -> "qualified " ++ Hint.modName m ++ " as " ++ q, + case Hint.modImp m of + Hint.NoImportList -> "" + Hint.ImportList l -> " (" ++ Data.List.intercalate "," l ++ ")" + Hint.HidingList l -> " hiding (" ++ Data.List.intercalate "," l ++ ")" + ] + toModule :: ( LHE.Syntax.Module LHE.SrcLoc.SrcSpanInfo, List LHE.Comments.Comment @@ -248,64 +308,87 @@ toModule parsed = toComments :: List LHE.Comments.Comment -> List Comment toComments cs = cs - |> mergeComments [] - |> List.map - ( \(ct, LHE.Comments.Comment _ srcSpan val) -> + |> mergeComments [] False + |> List.filterMap + ( \(ct, comments) -> case ct of + PlainText -> Nothing CodeBlock -> - toExample - (LHE.SrcLoc.noInfoSpan srcSpan) - (Text.fromList val) + comments + |> List.map (commentValue >> Prelude.dropWhile (/= '>') >> Prelude.drop 2) + |> toExample (commentsSrcSpan comments) |> CodeBlockComment - PlainText -> PlainTextComment (LHE.SrcLoc.noInfoSpan srcSpan, Text.fromList val) + |> Just + ContextBlock -> + comments + |> List.map commentValue + |> Data.List.tail + |> Data.List.init + |> List.map (Prelude.drop 1) + |> ContextBlockComment (commentsSrcSpan comments) + |> Just ) -data CommentType = CodeBlock | PlainText - deriving (Show) - -mergeComments :: List (CommentType, LHE.Comments.Comment) -> List LHE.Comments.Comment -> List (CommentType, LHE.Comments.Comment) -mergeComments acc [] = List.reverse acc -mergeComments [] (next : rest) = - mergeComments - [ case commentType next of - CodeBlock -> (CodeBlock, cleanCodeBlock next) - PlainText -> (PlainText, next) - ] - rest -mergeComments (prev@(prevCT, prevComment) : acc) (next : rest) = - mergeComments - ( case (prevCT, commentType next) of - (CodeBlock, CodeBlock) -> (CodeBlock, concatComment prevComment (cleanCodeBlock next)) : acc - (PlainText, PlainText) -> (PlainText, concatComment prevComment next) : acc - (PlainText, CodeBlock) -> (CodeBlock, cleanCodeBlock next) : prev : acc - (CodeBlock, PlainText) -> (PlainText, next) : prev : acc - ) - rest - -cleanCodeBlock :: LHE.Comments.Comment -> LHE.Comments.Comment -cleanCodeBlock (LHE.Comments.Comment t s text) = - text - |> Prelude.drop 3 - |> LHE.Comments.Comment t s +data CommentType = CodeBlock | PlainText | ContextBlock + deriving (Show, Eq) + +mergeComments :: + List (CommentType, List LHE.Comments.Comment) -> + Bool -> + List LHE.Comments.Comment -> + List (CommentType, List LHE.Comments.Comment) +mergeComments acc _ [] = List.reverse acc +mergeComments acc isInContext (next : restNext) = + let nextCt = commentType next + stillInContext = if isInContext then nextCt /= ContextBlock else nextCt == ContextBlock + newAcc = case acc of + [] -> [(nextCt, [next])] + (prevCt, prev) : restPrev -> + if isInContext || prevCt == nextCt + then (prevCt, prev ++ [next]) : restPrev + else (nextCt, [next]) : acc + in mergeComments newAcc stillInContext restNext commentType :: LHE.Comments.Comment -> CommentType commentType (LHE.Comments.Comment _ _ text) = - if Text.startsWith " > " (Text.fromList text) - || Text.trim (Text.fromList text) == ">" + if hasArrow text then CodeBlock - else PlainText + else + if hasAt text + then ContextBlock + else PlainText + +hasAt text = Text.trim (Text.fromList text) == "@" + +hasArrow text = + Text.startsWith " > " (Text.fromList text) + || Text.trim (Text.fromList text) == ">" concatComment :: LHE.Comments.Comment -> LHE.Comments.Comment -> LHE.Comments.Comment -concatComment (LHE.Comments.Comment _ srcSpanA a) (LHE.Comments.Comment _ srcSpanB b) = +concatComment commentA@(LHE.Comments.Comment _ srcSpanA a) commentB@(LHE.Comments.Comment _ srcSpanB b) = LHE.Comments.Comment True (LHE.SrcLoc.mergeSrcSpan srcSpanA srcSpanB) (a ++ "\n" ++ b) -toExample :: LHE.SrcLoc.SrcSpanInfo -> Text -> Example -toExample srcLocInfo source = - case LHE.Lexer.lexTokenStream (Text.toList source) of +commentValue :: LHE.Comments.Comment -> Prelude.String +commentValue (LHE.Comments.Comment _ _ a) = a + +commentsSrcSpan :: List LHE.Comments.Comment -> LHE.SrcLoc.SrcSpan +commentsSrcSpan [] = emptySrcSpan +commentsSrcSpan (LHE.Comments.Comment _ first _ : rest) = + List.foldl + (\(LHE.Comments.Comment _ srcSpan _) acc -> LHE.SrcLoc.mergeSrcSpan acc srcSpan) + first + rest + +emptySrcSpan :: LHE.SrcLoc.SrcSpan +emptySrcSpan = LHE.SrcLoc.mkSrcSpan LHE.SrcLoc.noLoc LHE.SrcLoc.noLoc + +toExample :: LHE.SrcLoc.SrcSpan -> List Prelude.String -> Example +toExample srcSpan source = + case LHE.Lexer.lexTokenStream (Prelude.unlines source) of LHE.Parser.ParseOk tokens -> if Foldable.any ((== LHE.Lexer.VarSym "==>") << LHE.Lexer.unLoc) tokens - then VerifiedExample (srcLocInfo, source) - else UnverifiedExample (srcLocInfo, source) + then VerifiedExample srcSpan source + else UnverifiedExample srcSpan source LHE.Parser.ParseFailed _ msg -> let _ = Debug.log "msg" msg in Debug.todo "TODO" @@ -336,3 +419,14 @@ report reporters results = ] |> List.filterMap identity |> Async.mapConcurrently_ identity + +withTempFile :: + (System.IO.FilePath -> System.IO.Handle -> Prelude.IO ()) -> + (Prelude.FilePath -> Prelude.IO a) -> + Prelude.IO a +withTempFile before go = do + (path, handle) <- + System.IO.openTempFile "/tmp" "HaskellVerifiedExamples.hs" + _ <- before path handle + System.IO.hClose handle + go path diff --git a/src/Haskell/Verified/Examples/Internal.hs b/src/Haskell/Verified/Examples/Internal.hs index a65294d..9927cfa 100644 --- a/src/Haskell/Verified/Examples/Internal.hs +++ b/src/Haskell/Verified/Examples/Internal.hs @@ -38,18 +38,18 @@ data ModuleInfo = ModuleInfo deriving (Show) data Comment - = PlainTextComment (LHE.SrcLoc.SrcSpanInfo, Text) - | CodeBlockComment Example + = CodeBlockComment Example + | ContextBlockComment LHE.SrcLoc.SrcSpan (List Prelude.String) deriving (Show, Eq) data Example - = VerifiedExample (LHE.SrcLoc.SrcSpanInfo, Text) - | UnverifiedExample (LHE.SrcLoc.SrcSpanInfo, Text) + = VerifiedExample LHE.SrcLoc.SrcSpan (List Prelude.String) + | UnverifiedExample LHE.SrcLoc.SrcSpan (List Prelude.String) deriving (Show, Eq) exampleSrcSpan :: Example -> LHE.SrcLoc.SrcSpan -exampleSrcSpan (VerifiedExample (info, _)) = LHE.SrcLoc.srcInfoSpan info -exampleSrcSpan (UnverifiedExample (info, _)) = LHE.SrcLoc.srcInfoSpan info +exampleSrcSpan (VerifiedExample span _) = span +exampleSrcSpan (UnverifiedExample span _) = span data ExampleResult = ExampleVerifySuccess Example Verified diff --git a/test/Main.hs b/test/Main.hs index 4bb04d1..421c540 100644 --- a/test/Main.hs +++ b/test/Main.hs @@ -1,5 +1,6 @@ module Main (main) where +import qualified Control.Concurrent.Async as Async import qualified Data.Text.IO import qualified Expect import qualified Haskell.Verified.Examples as HVE @@ -33,7 +34,14 @@ tests = |> Expect.fromIO result |> Debug.toString - |> Expect.equalToContentsOf "test/golden-results/parse-unverified-examples.hs" + |> Expect.equalToContentsOf "test/golden-results/parse-unverified-examples.hs", + test "parses context code" <| \() -> do + result <- + HVE.parse "test/assets/WithContext.hs" + |> Expect.fromIO + result + |> Debug.toString + |> Expect.equalToContentsOf "test/golden-results/parse-with-context.hs" ], describe "verifyExample" @@ -43,6 +51,7 @@ tests = example |> HVE.verifyExample (HVE.shimModuleWithImports ["NriPrelude"]) + Nothing |> Expect.fromIO result |> Debug.toString @@ -53,6 +62,7 @@ tests = example |> HVE.verifyExample (HVE.shimModuleWithImports ["NriPrelude"]) + Nothing |> Expect.fromIO result |> Debug.toString @@ -71,12 +81,13 @@ tests = ", 4", "]" ] - |> Text.join "\n" + |> Prelude.unlines |> HVE.exampleFromText result <- example |> HVE.verifyExample (HVE.shimModuleWithImports ["List", "NriPrelude"]) + Nothing |> Expect.fromIO result |> Debug.toString @@ -94,12 +105,13 @@ tests = ", 5", "]" ] - |> Text.join "\n" + |> Prelude.unlines |> HVE.exampleFromText result <- example |> HVE.verifyExample (HVE.shimModuleWithImports ["List", "NriPrelude"]) + Nothing |> Expect.fromIO result |> Debug.toString @@ -114,17 +126,13 @@ tests = results <- assets |> List.map ("test/assets/" ++) - |> Prelude.traverse + |> Async.mapConcurrently ( \modulePath -> do - parsed <- - HVE.parse modulePath - |> Expect.fromIO - result <- - parsed - |> HVE.verify - |> Expect.fromIO - Expect.fromResult (Ok (HVE.moduleInfo parsed, result)) + parsed <- HVE.parse modulePath + result <- HVE.verify parsed + Prelude.pure (HVE.moduleInfo parsed, result) ) + |> Expect.fromIO contents <- withTempFile (\handle -> Reporter.Stdout.report handle results) contents diff --git a/test/assets/WithContext.hs b/test/assets/WithContext.hs new file mode 100644 index 0000000..6f93ae1 --- /dev/null +++ b/test/assets/WithContext.hs @@ -0,0 +1,23 @@ +{-# LANGUAGE TypeApplications #-} +{-# LANGUAGE NoImplicitPrelude #-} + +module WithContext where + +import NriPrelude + +-- | TypeApplications +-- +-- Setup for examples below: +-- +-- @ +-- result :: Maybe [Char] +-- result = Just "a" +-- @ +-- +-- Examples: +-- +-- > identity @(Maybe [Char]) test ==> result +-- +-- > Just "b" ==> result +test :: Maybe [Char] +test = Just "a" diff --git a/test/golden-results/integration-simple.hs b/test/golden-results/integration-simple.hs index 8377a3e..44c9442 100644 --- a/test/golden-results/integration-simple.hs +++ b/test/golden-results/integration-simple.hs @@ -91,6 +91,27 @@ test/assets/UnverifiedExamples.hs:29 In an equation for ‘e_112341’: e_112341 = [1, 2, 3, ....] |> map (+ 1) ==> True +Examples of module WithContext unverified. + +test/assets/WithContext.hs:21 + 16: -- + 17: -- Examples: + 18: -- + 19: -- > identity @(Maybe [Char]) test ==> result + 20: -- +✗ 21: -- > Just "b" ==> result + 22: test :: Maybe [Char] + 23: test = Just "a" + 24: +The example was incorrect and couldn't be verified. + ▼ +"Just \"b\"" +╷ +│ ==> +╵ +"Just \"a\"" + ▲ + Examples unverified. test/assets/Headless.hs:3 @@ -109,11 +130,12 @@ test/assets/Headless.hs:3 ▲ Not all examples verified! -Verified: 14 -Unverified: 3 +Verified: 15 +Unverified: 4 In these files: * test/assets/Headless.hs * test/assets/UnverifiedExamples.hs + * test/assets/WithContext.hs No examples: 2 In these files: * test/assets/Simple.hs diff --git a/test/golden-results/parse-simple.hs b/test/golden-results/parse-simple.hs index 3b89dc5..82b2962 100644 --- a/test/golden-results/parse-simple.hs +++ b/test/golden-results/parse-simple.hs @@ -27,50 +27,15 @@ Module , packageDbs = [] } , comments = - [ PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/Simple.hs" 7 1 8 3 - , srcInfoPoints = [] - } - , " hello world\n" - ) - , CodeBlockComment + [ CodeBlockComment (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/Simple.hs" 9 1 10 11 - , srcInfoPoints = [] - } - , "test\n==> 1" - )) - , PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/Simple.hs" 11 1 11 3 - , srcInfoPoints = [] - } - , "" - ) + (SrcSpan "test/assets/Simple.hs" 9 1 10 11) [ "test" , "==> 1" ]) , CodeBlockComment (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/Simple.hs" 12 1 13 11 - , srcInfoPoints = [] - } - , "test + test\n==> 2" - )) - , PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/Simple.hs" 14 1 14 3 - , srcInfoPoints = [] - } - , "" - ) + (SrcSpan "test/assets/Simple.hs" 12 1 13 11) + [ "test + test" , "==> 2" ]) , CodeBlockComment (UnverifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/Simple.hs" 15 1 15 17 - , srcInfoPoints = [] - } - , "test + test" - )) + (SrcSpan "test/assets/Simple.hs" 15 1 15 17) [ "test + test" ]) ] } \ No newline at end of file diff --git a/test/golden-results/parse-unverified-examples.hs b/test/golden-results/parse-unverified-examples.hs index c2e1612..52d1ea9 100644 --- a/test/golden-results/parse-unverified-examples.hs +++ b/test/golden-results/parse-unverified-examples.hs @@ -28,89 +28,31 @@ Module , packageDbs = [] } , comments = - [ PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "test/assets/UnverifiedExamples.hs" 7 1 8 3 - , srcInfoPoints = [] - } - , " hello world\n" - ) - , CodeBlockComment + [ CodeBlockComment (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 9 1 10 11 - , srcInfoPoints = [] - } - , "test\n==> 1" - )) - , PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 11 1 11 3 - , srcInfoPoints = [] - } - , "" - ) + (SrcSpan "test/assets/UnverifiedExamples.hs" 9 1 10 11) + [ "test" , "==> 1" ]) , CodeBlockComment (UnverifiedExample - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 12 1 12 10 - , srcInfoPoints = [] - } - , "test" - )) - , PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 13 1 13 3 - , srcInfoPoints = [] - } - , "" - ) + (SrcSpan "test/assets/UnverifiedExamples.hs" 12 1 12 10) + [ "test" ]) , CodeBlockComment (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 14 1 15 11 - , srcInfoPoints = [] - } - , "test + test\n==> 3" - )) - , PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 18 1 19 3 - , srcInfoPoints = [] - } - , " | more stuff\n" - ) + (SrcSpan "test/assets/UnverifiedExamples.hs" 14 1 15 11) + [ "test + test" , "==> 3" ]) , CodeBlockComment (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 20 1 25 21 - , srcInfoPoints = [] - } - , "[ 1\n, 2\n, 3\n, 4\n] |> map (+ 1)\n==> [ 2, 4, 5 ]" - )) - , PlainTextComment - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 27 1 28 3 - , srcInfoPoints = [] - } - , " | compilation fails\n" - ) + (SrcSpan "test/assets/UnverifiedExamples.hs" 20 1 25 21) + [ "[ 1" + , ", 2" + , ", 3" + , ", 4" + , "] |> map (+ 1)" + , "==> [ 2, 4, 5 ]" + ]) , CodeBlockComment (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = - SrcSpan "test/assets/UnverifiedExamples.hs" 29 1 34 14 - , srcInfoPoints = [] - } - , "[ 1\n, 2\n, 3\n, 4\n] |> map (+ 1)\n==> True" - )) + (SrcSpan "test/assets/UnverifiedExamples.hs" 29 1 34 14) + [ "[ 1" , ", 2" , ", 3" , ", 4" , "] |> map (+ 1)" , "==> True" ]) ] } \ No newline at end of file diff --git a/test/golden-results/parse-with-context.hs b/test/golden-results/parse-with-context.hs new file mode 100644 index 0000000..0bfe965 --- /dev/null +++ b/test/golden-results/parse-with-context.hs @@ -0,0 +1,44 @@ +Module + { moduleInfo = + ModuleInfo + { moduleName = Just "WithContext" + , moduleSource = + SrcSpanInfo + { srcInfoSpan = SrcSpan "test/assets/WithContext.hs" 1 1 24 1 + , srcInfoPoints = + [ SrcSpan "test/assets/WithContext.hs" 1 1 1 1 + , SrcSpan "test/assets/WithContext.hs" 2 1 2 1 + , SrcSpan "test/assets/WithContext.hs" 4 1 4 1 + , SrcSpan "test/assets/WithContext.hs" 4 1 4 1 + , SrcSpan "test/assets/WithContext.hs" 6 1 6 1 + , SrcSpan "test/assets/WithContext.hs" 22 1 22 1 + , SrcSpan "test/assets/WithContext.hs" 23 1 23 1 + , SrcSpan "test/assets/WithContext.hs" 24 1 24 1 + , SrcSpan "test/assets/WithContext.hs" 24 1 24 1 + ] + } + , languageExtensions = [ "TypeApplications" , "NoImplicitPrelude" ] + , imports = + [ ModuleImport + { modName = "NriPrelude" + , modQual = NotQualified + , modImp = NoImportList + } + ] + , importPaths = [] + , packageDbs = [] + } + , comments = + [ ContextBlockComment + (SrcSpan "test/assets/WithContext.hs" 12 1 15 5) + [ "result :: Maybe [Char]" , "result = Just \"a\"" ] + , CodeBlockComment + (VerifiedExample + (SrcSpan "test/assets/WithContext.hs" 19 1 19 46) + [ "identity @(Maybe [Char]) test ==> result" ]) + , CodeBlockComment + (VerifiedExample + (SrcSpan "test/assets/WithContext.hs" 21 1 21 25) + [ "Just \"b\" ==> result" ]) + ] + } \ No newline at end of file diff --git a/test/golden-results/verifyExample-multiline-unverified.hs b/test/golden-results/verifyExample-multiline-unverified.hs index 06235f3..fcd672f 100644 --- a/test/golden-results/verifyExample-multiline-unverified.hs +++ b/test/golden-results/verifyExample-multiline-unverified.hs @@ -1,9 +1,15 @@ ExampleVerifySuccess (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "" (-1) (-1) (-1) (-1) - , srcInfoPoints = [] - } - , "[ 1\n, 2\n, 3\n]\n|> List.map (+ 1)\n==>\n[ 2\n, 3\n, 5\n]" - )) + (SrcSpan "" (-1) (-1) (-1) (-1)) + [ "[ 1" + , ", 2" + , ", 3" + , "]" + , "|> List.map (+ 1)" + , "==>" + , "[ 2" + , ", 3" + , ", 5" + , "]" + ]) (Unverified "[2,3,4]" "[2,3,5]") \ No newline at end of file diff --git a/test/golden-results/verifyExample-multiline-verified.hs b/test/golden-results/verifyExample-multiline-verified.hs index c0ec6fb..837f45c 100644 --- a/test/golden-results/verifyExample-multiline-verified.hs +++ b/test/golden-results/verifyExample-multiline-verified.hs @@ -1,9 +1,15 @@ ExampleVerifySuccess (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "" (-1) (-1) (-1) (-1) - , srcInfoPoints = [] - } - , "[ 1\n, 2\n, 3\n]\n|> List.map (+ 1)\n==>\n[ 2\n, 3\n, 4\n]" - )) + (SrcSpan "" (-1) (-1) (-1) (-1)) + [ "[ 1" + , ", 2" + , ", 3" + , "]" + , "|> List.map (+ 1)" + , "==>" + , "[ 2" + , ", 3" + , ", 4" + , "]" + ]) Verified \ No newline at end of file diff --git a/test/golden-results/verifyExample-unverified.hs b/test/golden-results/verifyExample-unverified.hs index 42fbfca..6ea5be3 100644 --- a/test/golden-results/verifyExample-unverified.hs +++ b/test/golden-results/verifyExample-unverified.hs @@ -1,9 +1,4 @@ ExampleVerifySuccess (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "" (-1) (-1) (-1) (-1) - , srcInfoPoints = [] - } - , "1 + 1 ==> 3" - )) + (SrcSpan "" (-1) (-1) (-1) (-1)) [ "1 + 1 ==> 3" ]) (Unverified "2" "3") \ No newline at end of file diff --git a/test/golden-results/verifyExample-verified.hs b/test/golden-results/verifyExample-verified.hs index 9a97f0a..eb195f9 100644 --- a/test/golden-results/verifyExample-verified.hs +++ b/test/golden-results/verifyExample-verified.hs @@ -1,9 +1,4 @@ ExampleVerifySuccess (VerifiedExample - ( SrcSpanInfo - { srcInfoSpan = SrcSpan "" (-1) (-1) (-1) (-1) - , srcInfoPoints = [] - } - , "1 + 1 ==> 2" - )) + (SrcSpan "" (-1) (-1) (-1) (-1)) [ "1 + 1 ==> 2" ]) Verified \ No newline at end of file