Merge pull request #32 from NoRedInk/update-documentation

Generated documentation

Procfile

@@ -1,2 +1,3 @@
 test: ghcid --command "cabal repl tests" --test Main.main --allow-eval
-cli-smoke-test: ghcid --command "cabal repl haskell-verified-examples:haskell-verify-examples" --test Main.main --setup ":set args ./test/assets/Simple.hs"
+cli-smoke-test: ghcid --command "cabal repl haskell-verify-examples:haskell-verify-examples" --test Main.main --setup ":set args ./test/assets/Simple.hs"
+cli-docs-smoke-test: ghcid --command "cabal repl haskell-verify-examples:generate-documentation" --test Main.main --setup ":set args ./README.md"

README.md

@@ -1,6 +1,86 @@
 # Haskell-Verify-Examples
 
+Verify examples in your docs.
+
+⚠️ This is not a replacement for tests, this tool should be used for improving your documentation.
+
+## Install
+1. `$ direnv allow`
+2. `$ make install-exe`
+
+## Setup
+haskell-verify-examples will try to load the cradle automatically from the cwd to locate source files and project wide flags, so it should just work with cabal and stack projects.
+
+## Writing Verified Examples
+
+```haskell
+module Test where 
+
+-- Below is a verified example
+-- > testFunction 1 ==> 2
+testFunction :: Int -> Int
+testFunction = (+1) 
+```
+
+```
+Ok [(VerifiedExample (SrcSpan "/private/tmp/DocModule8657-23.hs" 4 1 4 26) ["testFunction 1 ==> 2"],ExampleVerifySuccess Verified)]
+```
+
+
+How about a failing example? 
+
+```haskell
+module Test where 
+
+-- Below is a verified example
+-- > testFunction 1 ==> 3
+testFunction :: Int -> Int
+testFunction = (+1) 
+```
+
+```
+Ok [(VerifiedExample (SrcSpan "/private/tmp/DocModule8657-24.hs" 4 1 4 26) ["testFunction 1 ==> 3"],ExampleVerifySuccess (Unverified "2" "3"))]
+```
+
+
+You can also inquire about the value of an expression using `?`
+
+```haskell
+module Test where 
+
+-- ? testFunc 1
+testFunc :: Int -> Int
+testFunc = (+1)
+```
+
+```
+Ok [(VerifiedExample (SrcSpan "/private/tmp/DocModule8657-25.hs" 3 1 3 16) ["evaluteExampleTodo (","testFunc 1",")"],ExampleVerifySuccess (HelpTodo "2"))]
+```
+
+
+Code blocks can be introduced using the '@' operator.  These blocks are useful to demonstrate example usage. 
+
+```haskell
+module Test where
+
+-- @
+-- import Test 
+--
+-- x :: Int
+-- x = testFunc $ testFunc $ testFunc 0
+-- @
+-- 
+-- > x ==> 3
+testFunc :: Int -> Int
+testFunc = (+1)
+```
+
+```
+Ok [(VerifiedExample (SrcSpan "/private/tmp/DocModule8657-26.hs" 10 1 10 13) ["x ==> 3"],ExampleVerifySuccess Verified)]
+```
+
+
 ## Development
 
 1. `$ direnv allow`
-1. `$ make watch`
+1. `$ make watch`

doc/Main.hs

@@ -0,0 +1,66 @@
+module Main where
+
+import Data.Foldable
+import qualified Data.List
+import qualified Haskell.Verify.Examples as HVE
+import qualified List
+import NriPrelude
+import qualified Result
+import qualified System.Environment
+import qualified System.IO
+import qualified System.IO.Temp
+import qualified Prelude
+
+verifyAnonymousBlocks :: List Prelude.String -> Prelude.IO ()
+verifyAnonymousBlocks blocks = do
+  logHandler <- Platform.silentHandler
+  handler <- HVE.handler
+  System.IO.Temp.withSystemTempDirectory "DocModules" <| \dirPath -> do
+    results <-
+      blocks
+        |> List.indexedMap (,)
+        |> Prelude.traverse
+          ( \(index, block) -> do
+              let filePath = dirPath ++ "/Example" ++ Prelude.show index ++ ".hs"
+              System.IO.writeFile filePath block
+              Task.attempt
+                logHandler
+                ( do
+                    parsed <- HVE.parse handler filePath
+                    cradleInfo <- HVE.tryLoadImplicitCradle handler filePath
+                    results <- HVE.verify handler cradleInfo parsed
+                    Task.succeed (HVE.moduleInfo parsed, results)
+                )
+          )
+    HVE.report [HVE.Stdout] (Prelude.sequence results)
+    Prelude.pure ()
+
+getBlocks :: List Prelude.String -> List Prelude.String -> Prelude.IO (List Prelude.String)
+getBlocks [] acc = Prelude.pure acc
+getBlocks (l : ls) acc =
+  if isHaskellStartBlock l
+    then haskellBlock ls [] acc
+    else getBlocks ls acc
+  where
+    isHaskellStartBlock l' =
+      -- TODO use a proper markdown parser. Markdown has so many
+      -- edge-cases. This might break in some cases.
+      Data.List.isPrefixOf "```haskell" l
+        || Data.List.isPrefixOf "```hs" l
+    isEndBlock = Data.List.isPrefixOf "```"
+
+    haskellBlock [] code acc = Prelude.pure (code : acc)
+    haskellBlock (l : ls) code acc =
+      if isEndBlock l
+        then getBlocks ls (code : acc)
+        else haskellBlock ls (code ++ "\n" ++ l) acc
+
+main :: Prelude.IO ()
+main = do
+  args <- System.Environment.getArgs
+  case args of
+    [] -> Prelude.pure ()
+    readmePath : _ -> do
+      readmeLines <- Prelude.fmap Prelude.lines (Prelude.readFile readmePath)
+      blocks <- getBlocks readmeLines []
+      verifyAnonymousBlocks blocks

package.yaml

@@ -27,6 +27,14 @@ executables:
       - text >= 1.2.3.1 && < 1.3
     main: Main.hs
     source-dirs: app
+  generate-documentation:
+    dependencies:
+      - base >= 4.12.0.0 && < 4.16
+      - haskell-verify-examples
+      - nri-prelude >= 0.1.0.0 && < 0.7
+      - temporary >= 1.3 && < 1.4
+    main: Main.hs
+    source-dirs: doc
 library:
   dependencies:
   - async >= 2.2.2 && < 2.3

src/Haskell/Verify/Examples.hs

@@ -419,7 +419,7 @@ toComment cs =
                 |> Ok
                 |> Just
       )
-    |> combineResults
+    |> Prelude.sequence
     |> Result.map Comment
 
 data CommentType
@@ -532,6 +532,7 @@ getPackageDbs :: List Prelude.String -> List PackageDb
 getPackageDbs = getTuples "-package-db" >> coerce
 
 getTuples :: Prelude.String -> List Prelude.String -> List Prelude.String
+getTuples _ [] = []
 getTuples key options =
   List.concat
     [ [l, r]

src/Haskell/Verify/Examples/Internal.hs

@@ -105,9 +105,6 @@ moduleFilePath :: ModuleInfo -> Prelude.FilePath
 moduleFilePath =
   LHE.SrcLoc.srcSpanFilename << LHE.SrcLoc.srcInfoSpan << moduleSource
 
-combineResults :: List (Result x a) -> Result x (List a)
-combineResults = List.foldr (Result.map2 (:)) (Ok [])
-
 shimModuleWithImports :: List Text -> ModuleInfo
 shimModuleWithImports imports =
   ModuleInfo