Upgrade stack to lts-16.17, tests, minor fixes

Author: adamwespiser

.gitignore

@@ -7,3 +7,5 @@ cabal.sandbox.config
 output/*
 *.hi
 *.o
+scheme.cabal
+stack.yaml.lock

Build.hs

@@ -1,6 +1,7 @@
+{-# LANGUAGE OverloadedStrings, RankNTypes, ScopedTypeVariables, TypeApplications #-}
 module Main where
 
-import Prelude hiding ((*>))
+import Prelude
 import Development.Shake
 import Development.Shake.FilePath
 
@@ -14,12 +15,12 @@ main = shakeArgs shakeOptions $ do
  let targets = ["output" </> (f -<.> "wiki") | f <- files]
  need targets
 
- "output/scheme.html" *> \out -> do
+ "output/scheme.html" %> \out -> do
  need ["resources/page.tmpl"]
  files <- fmap ("docs/" </>) <$> getDirectoryFiles "docs" ["*.md"]
  need files
- cmd "pandoc" files ["-o"] out ["--template", "resources/page.tmpl"]
+ cmd ("pandoc" :: String) files ["-o" :: String] out (["--template", "resources/page.tmpl"] :: [String])
 
  "output//*.wiki" %> \out -> do
  let src = dropDirectory1 $ out -<.> "md"
- cmd "pandoc" src "-o" out ["-t", "mediawiki"]
+ cmd ("pandoc" :: String) src ("-o" :: String) out (["-t", "mediawiki"] :: [String])

package.yaml

@@ -0,0 +1,87 @@
+name: scheme
+version: 0.1
+synopsis: Write You a Scheme
+license-file: LICENSE
+author: "Adam Wespiser"
+maintainer: "adamwespiser@gmail.com"
+
+default-extensions:
+- OverloadedStrings
+
+dependencies:
+- base >= 4.8 && <5.0
+- bytestring
+- containers
+- directory
+- haskeline
+- mtl
+- optparse-applicative
+- parsec
+- text
+- transformers
+- HTTP
+- tasty
+- tasty-golden
+- hspec
+
+ghc-options:
+- -Werror
+- -fno-warn-unused-do-bind
+- -fno-warn-unused-binds
+- -fno-warn-type-defaults
+- -fno-warn-type-defaults
+- -fno-warn-name-shadowing
+- -fwarn-duplicate-exports
+- -fwarn-dodgy-exports
+- -fwarn-dodgy-imports
+- -fwarn-incomplete-patterns
+- -fwarn-incomplete-record-updates
+- -fwarn-missing-fields
+- -fwarn-missing-methods
+- -fwarn-orphans
+- -fwarn-overlapping-patterns
+- -fwarn-unused-imports
+- -fwarn-tabs
+- -fwarn-unrecognised-pragmas
+
+library:
+ source-dirs: src/
+
+executables:
+ scheme:
+ main: Main.hs
+ source-dirs: exec
+ dependencies:
+ - base >= 4.8 && < 5
+ - scheme
+ docs:
+ main: Build.hs
+ dependencies:
+ - base >= 4.8 && < 5.0
+ - shake
+ - pandoc
+
+tests:
+ test:
+ main: Main.hs
+ source-dirs: test-hs/Spec/
+ dependencies:
+ - scheme
+ - hspec
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+ test-golden:
+ main: Main.hs
+ source-dirs: test-hs/Golden
+ dependencies:
+ - scheme
+ - tasty
+ - tasty-golden
+ - bytestring
+ ghc-options:
+ - -threaded
+ - -rtsopts
+ - -with-rtsopts=-N
+

scheme.cabal

@@ -20,7 +20,6 @@ import Parser
 import LispVal
 
 import Data.Map as Map
-import Data.Monoid
 import qualified Data.Text as T
 import qualified Data.Text.IO as TIO
 import System.Directory

src/Eval.hs

@@ -6,7 +6,6 @@ import LispVal
 
 import Data.Text as T
 import Data.Text.IO as TIO
-import Data.Monoid
 import System.Directory
 import System.IO
 import Network.HTTP

src/Prim.hs

@@ -1,4 +1,4 @@
-resolver: lts-7.12
+resolver: lts-16.17
 packages:
 - '.'
 extra-deps: []

stack.yaml

@@ -2,14 +2,14 @@
 module Main (main) where
 
 import LispVal
-import Parser
 import Eval
 
 import qualified Data.Text as T
 
 import Test.Tasty
 import Test.Tasty.Golden
 import qualified Data.ByteString.Lazy.Char8 as C
+import Data.Functor ((<&>))
 
 main :: IO ()
 main = defaultMain tests
@@ -30,7 +30,7 @@ tests = testGroup "Golden Tests"
  , tastyGoldenRun "greater than" "test/test_gt.scm" "test/ans/test_gt.txt"
  , tastyGoldenRun "lexical scope 1" "test/test_scope1.scm" "test/ans/test_scope1.txt"
  , tastyGoldenRun "lexical scope 2" "test/test_scope2.scm" "test/ans/test_scope2.txt"
- , tastyGoldenRun "issue #23"  "test/test_scope3.scm" "test/ans/test_scope3.txt"
+ , tastyGoldenFail "issue #23" "test/test_scope3.scm" "test/ans/test_scope3.txt"
  , tastyGoldenRun "issue #25" "test/test_scope4.scm" "test/ans/test_scope4.txt"
  , tastyGoldenRun "Recursion 1" "test/test_fix.scm" "test/ans/test_fix.txt"
  , tastyGoldenRun "Recursion 2" "test/test_fix2.scm" "test/ans/test_fix2.txt"
@@ -40,13 +40,18 @@ tests = testGroup "Golden Tests"
  ]
 
 tastyGoldenRun :: TestName -> T.Text -> FilePath -> TestTree
-tastyGoldenRun testName testFile correct = goldenVsString testName correct (evalTextTest (Just "lib/stdlib.scm") (testFile) >>= (return . C.pack . show))
-
-evalTextTest :: Maybe T.Text -> T.Text -> IO LispVal --REPL
-evalTextTest (Just stdlib) file= do
- stdlib <- getFileContents $ T.unpack stdlib
- f <- getFileContents $ T.unpack file
- runASTinEnv basicEnv $ textToEvalForm stdlib f
-evalTextTest Nothing file = do
+tastyGoldenRun testName testFile correct =
+ goldenVsString testName correct $
+ evalTextTest "lib/stdlib.scm" testFile <&> C.pack . show
+
+tastyGoldenFail :: TestName -> T.Text -> FilePath -> TestTree
+tastyGoldenFail testName testFile correct =
+ goldenVsString testName correct $
+ (safeExec $ evalTextTest "lib/stdlib.scm" testFile) <&>
+ either C.pack (C.pack . show)
+
+evalTextTest :: T.Text -> T.Text -> IO LispVal --REPL
+evalTextTest stdlib file= do
+ stdlib' <- getFileContents $ T.unpack stdlib
  f <- getFileContents $ T.unpack file
- runASTinEnv basicEnv $ fileToEvalForm (T.unpack file) f
+ runASTinEnv basicEnv $ textToEvalForm stdlib'  f

test-hs/Golden.hs renamed to test-hs/Golden/Main.hs

@@ -0,0 +1 @@
+101