Commit 7ac596e488525922e405b44d4933a6a94de5c53e

  • avatar
  • Ville Tirronen <ville.tirronen @j…u.fi> (Committer)
  • Wed Nov 08 12:53:49 EET 2017
  • avatar
  • Ville Tirronen <ville.tirronen @j…u.fi> (Author)
  • Wed Nov 08 12:53:49 EET 2017
Fixed/hinted two most common errors
DerivationChecker/DerivationChecker.cabal
(7 / 0)
  
2929 , http-client
3030 , http-client-tls
3131
32executable MostCommonError
33 hs-source-dirs: exec
34 main-is: MostCommonError.hs
35 other-modules: LogFile,API
36 default-language: Haskell2010
37 build-depends: base >= 4.7 && < 5, DerivationChecker, elm-bridge, text, servant, servant-lucid,lucid,dhall,time,aeson, LoginManager , http-client, directory, bytestring, containers
38
3239executable DCElmGen
3340 hs-source-dirs: exec
3441 main-is: DCElmGen.hs
DerivationChecker/exec/MostCommonError.hs
(2 / 1)
  
1#!/bin/env stack runghc
1#!/usr/bin/env stack
2--runghc
23{-#LANGUAGE ScopedTypeVariables#-}
34module Main where
45import LogFile
DerivationChecker/src/Reason.hs
(1 / 3)
  
6464 ApplyCons -> True
6565 ApplyDecons -> True
6666 FunctionComposition -> True
67 MultipleReasons rs -> all isCorrect rs
6768 -- Hint _ o -> isCorrect o
6869 _ -> False
6970
7071isCritical :: Reason a -> Bool
7172isCritical Unchanged = True
7273isCritical _ = False
73
74
75--instance Monoid (Reason r) where
7674
7775
7876data ErrorMsg r = CantParse String (Int,Int) String
DerivationChecker/tasks/letExprs
(3 / 1)
  
2121 ,hints=[./hint // {matchBefore=["let x = _ in x+x+x"] : Optional Text
2222 ,matchAfter=["_ + _ + _"] : Optional Text
2323 ,correct=[False] : Optional Bool
24 ,hint="You need to first replace the variable before getting rid of the 'let'-part"}]
24 ,hint="You need to first replace the variable before getting rid of the 'let'-part"}
25 ,./hint // {matchAfter=["((((5 + 11) + 5) + 11) + 5) + 11"] : Optional Text
26 ,hint = "Add parenthesis around '5+11'. Otherwise the structure becomes ((5+11) + 5) + 11 instead of (5+11) + (5+11). (This is crucial in more complex expressions) "}]
2527}
DerivationChecker/tests/Tests.hs
(22 / 1)
  
1010import Utils()
1111import Data.Fix
1212import Data.Monoid
13import Data.Maybe (isJust)
1314
1415allTests :: TestTree
1516allTests =
1919 , resolvers
2020 , patternMatching
2121 , functions
22 , bugs
2223  ]
2324
2425(~~) :: (Show a, Eq a) => a -> a -> Assertion
2526a ~~ b = assertEqual "" b a
2627
27functions,patternMatching, resolvers, basicOperations :: TestTree
28data SimplifiedResult = NoResolve | Incorrect | Correct deriving (Eq,Show)
29
30correctRes g = assertEqual "" Correct (simpler g)
31
32simpler g = case g of
33 Just x | isCorrect x -> Correct
34 Nothing -> NoResolve
35 _ -> Incorrect
36
37
38functions,patternMatching, resolvers, basicOperations,bugs :: TestTree
39
40bugs = testGroup "System bugs"
41 [testCase "Multiassignment" $
42 let Right f = parseEasyFun "y=2"
43 Right g = parseEasyFun "x=10"
44 in correctRes $ resolveChngs (flattenReasons $ treeRes (resNamed [f,g]))
45 "5 < x || (1 == y) && not (y /= 2)"
46 "5 < 10 || (1 == 2) && not (2 /= 2)"
47 ]
2848
2949functions = testGroup "Functions and definitions"
3050 [testCase "Basic Function" $