packages feed

remarks 0.1.7 → 0.1.8

raw patch · 15 files changed

+338/−166 lines, 15 files

Files

README.md view
@@ -89,8 +89,8 @@ make a judgement about this point.  Structural remarks are good for listing things to look for. For instance, a-(template) judgement for an operating systems exercise may look something like-this:+(template) judgement for an operating systems exercise might look something+like this:  ``` ## T1: /15@@ -109,12 +109,15 @@   * Avoids race conditions   * Has a good degree of multiprogramming   * Solves the problem++### Bonus: +0+  * Has an accompanying implementation / simulation ```  Once filled in by a teaching assistant, this may look something like this:  ```-## T1: 7/15+## T1: 9/15  ### Formal requirements: 5/5   * Has code@@ -146,7 +149,15 @@     + It's a ticket system, so it could be okay.   * Solves the problem     + In a complicated way, but yes.++### Bonus: +2+  * Has an accompanying implementation / simulation+    + Yes! ```++Bonus-judgements _must_ have the title `Bonus`, but they don't have to be there+if you don't like them. The presence of bonus judgments also allows points to+sum up to more than the given maximum. This is regarded as a feature.  ## Points and Sums
app/Main.hs view
@@ -3,10 +3,11 @@ import Ast import Parser import PointsChecker+import PropertyInterp import PrettyPrinter-import Collector+import Export -import Control.Monad ( void, filterM, liftM )+import Control.Monad ( void, filterM, liftM, (<=<) ) import Data.List ( sort ) import System.Directory   ( doesFileExist, doesDirectoryExist, listDirectory )@@ -18,6 +19,10 @@  import Text.PrettyPrint.GenericPretty +splitBy delimiter = foldr f [[]] +  where f c l@(x:xs) | c == delimiter = []:l+                     | otherwise = (c:x):xs+ report :: String -> IO () report = hPutStrLn stderr @@ -112,26 +117,26 @@     if not hasDir     then parseTopFile pathWithExt     else do -- we now also have directory-      (fjs, (Judgement (h, cs, js))) <- parseFileWithDir pathWithExt+      (fjs, (Judgement (h, p, cs, js))) <- parseFileWithDir pathWithExt       dirJs <- parseDir pathWithoutExt-      pure $ fjs ++ [Judgement (h, cs, js ++ dirJs)]+      pure $ fjs ++ [Judgement (h, p, cs, js ++ dirJs)]  parsePaths :: [FilePath] -> IO [[Judgement]] parsePaths = mapM parsePath  check :: [Judgement] -> IO () check js = do-  case mapM checkPoints js of+  case mapM (interpProps <=< checkPoints) js of     Right newJs -> printJs newJs     Left e -> putStrLn $ show e  printJs :: [Judgement] -> IO () printJs = putStrLn . ppJs -collect :: [Judgement] -> IO ()-collect js = do-  case mapM checkPoints js of-    Right newJs -> putStrLn $ collectHTML newJs+export :: [String] -> [Judgement] -> IO ()+export format js = do+  case mapM (interpProps <=< checkPoints) js of+    Right newJs -> putStrLn $ exportCSV ";" format newJs     Left e -> putStrLn $ show e  main :: IO ()@@ -142,5 +147,6 @@     ("parse" : paths) -> parsePaths paths >>= putStrLn . pretty     ("check" : paths) -> parsePaths paths >>= mapM_ check     ("show" : paths) -> parsePaths paths >>= mapM_ printJs-    ("collect" : paths) -> parsePaths paths >>= mapM_ collect+    ("export" : "--format" : format : paths) -> parsePaths paths >>= mapM_ (export (splitBy ';' format))+    ("export" : paths) -> parsePaths paths >>= mapM_ (export ["Title", "Total", "MaxPoints"])     (c:args) -> invalidCommand c args
remarks.cabal view
@@ -1,5 +1,5 @@ name:                remarks-version:             0.1.7+version:             0.1.8 synopsis:            A DSL for marking student work description:         A DSL for marking student work; see README.md for further details. homepage:            https://github.com/oleks/remarks#readme@@ -16,13 +16,17 @@ library   hs-source-dirs:      src   exposed-modules:     Ast+                     , Config+                     , Export+                     , Export.Html+                     , Export.Generic+                     , Export.CSV+                     , Invalid                      , Parser                      , Parser.Impl                      , PointsChecker                      , PrettyPrinter-                     , Config-                     , Collector-                     , Collector.Html+                     , PropertyInterp   build-depends:       base >= 4.7 && < 5                      , GenericPretty >= 1.2.1                      , pretty >= 1.1.3.3
src/Ast.hs view
@@ -32,8 +32,22 @@  instance Out Comment +newtype Property +  = Property (String, PropertyExp)+  deriving (Eq, Show, Generic)++instance Out Property++data PropertyExp +  = Lookup (Int, String)+  | Value  String+  | Num  Double+  deriving (Eq, Show, Generic)++instance Out PropertyExp+ data Judgement-  = Judgement (Header, [Comment], [Judgement])+  = Judgement (Header, [Property], [Comment], [Judgement])   | Bonus (Double, [Comment])   deriving (Eq, Show, Generic)
− src/Collector.hs 
@@ -1,9 +0,0 @@-module Collector (collectHTML) where--import Ast-import Collector.Html--import Text.PrettyPrint--collectHTML :: [Judgement] -> String-collectHTML = render . htmlRemarks
− src/Collector/Html.hs 
@@ -1,108 +0,0 @@-module Collector.Html (htmlRemarks) where--import Ast--import Text.PrettyPrint--htmlRemarks :: [Judgement] -> Doc-htmlRemarks js = -  doctype $ html $ -    (head_ $ documentStyle $$ documentScript) $$ -    (body . table $ htmlTableHead (head js) $+$ vcat (map htmlJudgement js))--tag :: String -> Doc -> Doc -> Doc-tag tagStr attr doc = (text "<" <> text tagStr <+> attr <> text ">") $$ nest 2 doc $$ text ("</" ++ tagStr ++ ">") --etag :: String -> Doc -> Doc-etag tagStr = tag tagStr empty--atag :: String -> String -> Doc -> Doc-atag tagStr attrStr = tag tagStr (text attrStr)--doctype = ($$) (text "<!DOCTYPE html>")-html   = etag "html"-head_  = etag "head"-body   = etag "body"-script = atag "script" "type=\"text/javascript\""-style_ = etag "style"-table  = atag "table" "border=\"1\""-tr     = etag "tr"-trhidden = atag "tr" "style=\"display: none;\""-th     = etag "th"-td     = etag "td"-toggle = atag "a" "href=\"#\" onclick=\"toggleRow(this);\""-ul     = etag "ul"-li     = etag "li"--liclass c = atag "li" $ "class=\"" ++ c ++ "\""-tdspan i  = atag "td" $ "colspan=\"" ++ (show i) ++ "\""--br = text "<br>"--details d1 d2 = etag "details" ((etag "summary" d1) $$ d2)--documentStyle = style_ $ -  text "details {padding-left: 16px;}" $$      -  text "ul {list-style: none; padding-left: 16px; padding-top: 0px; padding-bottom: 0px; margin-top: 0px; margin-bottom: 0px;}" $$-  text "li.plus:before {content: \"+\"; margin-right: 4px;}" $$-  text "li.minus:before {content: \"-\"; margin-right: 4px;}" $$-  text "li.quest:before {content: \"?\"; margin-right: 4px;}" $$-  text "li.star:before {content: \"*\"; margin-right: 4px;}"--documentScript = script $ -  nest 2 ((text "function toggleRow(e){") $$-          nest  2 ((text "var subRow = e.parentNode.parentNode.nextElementSibling;") $$-          text "subRow.style.display = subRow.style.display === 'none' ? 'table-row' : 'none';") $$-   (text "}"))--isIntegral :: Double -> Bool-isIntegral x = x == fromInteger (round x)--pointsDoc :: Double -> Doc-pointsDoc v | isNaN v = empty-pointsDoc v | isIntegral v = integer (round v)-pointsDoc v = double v--htmlTableHead :: Judgement -> Doc-htmlTableHead (Judgement (_, _, js)) = -  tr $ th (text "Title") $$ (vcat $ map maketd js) $$ th (text "Total")-  where-    maketd (Judgement (Header(title, _, maxPoint), _, _)) = th $ text (title ++ "/") <> pointsDoc maxPoint--htmlJudgement :: Judgement -> Doc-htmlJudgement (Judgement (Header(title, points, maxPoint), comments, judgements)) = -  (tr $ (td . toggle $ text title) $$ vcat (map htmlSubJudgement judgements) $$ (td $ pointsDoc points)) $$-  (trhidden $ tdspan (length judgements+2) $ (htmlDetailComments comments $$ htmlDetailJudgements judgements))--htmlSubJudgement :: Judgement -> Doc-htmlSubJudgement (Judgement (Header(title, points, maxPoint), comments, judgements)) = -  (td $ pointsDoc points) --htmlDetailJudgements :: [Judgement] -> Doc -htmlDetailJudgements = vcat . (map htmlDetailJudgement) --htmlDetailJudgement :: Judgement -> Doc-htmlDetailJudgement (Judgement (Header(title, points, maxPoint), comments, judgements)) = -  details -    (text title <> parens (pointsDoc points <> text "/" <> pointsDoc maxPoint)) -    (htmlDetailComments comments $$ htmlDetailJudgements judgements)--htmlDetailComments :: [Comment] -> Doc-htmlDetailComments [] = text ""-htmlDetailComments comments = -  ul . vcat $ map htmlDetailComment comments--htmlDetailComment :: Comment -> Doc-htmlDetailComment (Comment (mood, commentParts)) =-  liclass (htmlDetailMood mood) $ vcat $ map htmlDetailCommentPart commentParts--htmlDetailMood :: Mood -> String-htmlDetailMood Positive  = "plus"-htmlDetailMood Negative  = "minus"-htmlDetailMood Neutral   = "star"-htmlDetailMood Impartial = "quest"--htmlDetailCommentPart :: CommentPart -> Doc-htmlDetailCommentPart (CommentStr string) = text string-htmlDetailCommentPart (CommentCmt comment) =-  ul $ htmlDetailComment comment
+ src/Export.hs view
@@ -0,0 +1,14 @@+module Export (exportHTML, exportCSV) where++import Ast+import Export.Html+import Export.CSV++import Text.PrettyPrint++exportHTML :: [Judgement] -> String+exportHTML = render . htmlRemarks++exportCSV :: String -> [String] -> [Judgement] -> String+exportCSV delim ps js = render $ csvRemarks delim ps js+
+ src/Export/CSV.hs view
@@ -0,0 +1,30 @@+module Export.CSV (csvRemarks) where++import Ast+import Export.Generic++import Text.PrettyPrint+import Data.List (intersperse)++csvRemarks :: String -> [String] -> [Judgement] -> Doc+csvRemarks delimiter propertyList judgements = +  (hcat $ (intersperse (text delimiter)) $ map text propertyList) $$+  (vcat $ map (formatJudgement delimiter propertyList) judgements)++formatJudgement :: String -> [String] -> Judgement -> Doc+formatJudgement delimiter properties judgement = +  hcat $ (intersperse (text delimiter)) $ map (mapfun judgement) properties+  where+    mapfun = flip lookupProperty ++lookupProperty :: String -> Judgement -> Doc+lookupProperty name (Judgement (_, properties, _, _)) = +  case (lookup name (map (\(Property (n,v)) -> (n,v)) properties)) of+    Nothing -> error "Property not found."+    Just(value) -> formatPropertyExp value++formatPropertyExp :: PropertyExp -> Doc+formatPropertyExp (Lookup (index, name)) =+  brackets $ int index <> text "." <> text name+formatPropertyExp (Value value) = text value+formatPropertyExp (Num value) = pointsDoc value
+ src/Export/Generic.hs view
@@ -0,0 +1,11 @@+module Export.Generic where++import Text.PrettyPrint++isIntegral :: Double -> Bool+isIntegral x = x == fromInteger (round x)++pointsDoc :: Double -> Doc+pointsDoc v | isNaN v = empty+pointsDoc v | isIntegral v = integer (round v)+pointsDoc v = double v
+ src/Export/Html.hs view
@@ -0,0 +1,101 @@+module Export.Html (htmlRemarks) where++import Ast++import Export.Generic+import Text.PrettyPrint++htmlRemarks :: [Judgement] -> Doc+htmlRemarks js = +  doctype $ html $ +    (head_ $ documentStyle $$ documentScript) $$ +    (body . table $ htmlTableHead (head js) $+$ vcat (map htmlJudgement js))++tag :: String -> Doc -> Doc -> Doc+tag tagStr attr doc = (text "<" <> text tagStr <+> attr <> text ">") $$ nest 2 doc $$ text ("</" ++ tagStr ++ ">") ++etag :: String -> Doc -> Doc+etag tagStr = tag tagStr empty++atag :: String -> String -> Doc -> Doc+atag tagStr attrStr = tag tagStr (text attrStr)++doctype = ($$) (text "<!DOCTYPE html>")+html   = etag "html"+head_  = etag "head"+body   = etag "body"+script = atag "script" "type=\"text/javascript\""+style_ = etag "style"+table  = atag "table" "border=\"1\""+tr     = etag "tr"+trhidden = atag "tr" "style=\"display: none;\""+th     = etag "th"+td     = etag "td"+toggle = atag "a" "href=\"#\" onclick=\"toggleRow(this);\""+ul     = etag "ul"+li     = etag "li"++liclass c = atag "li" $ "class=\"" ++ c ++ "\""+tdspan i  = atag "td" $ "colspan=\"" ++ (show i) ++ "\""++br = text "<br>"++details d1 d2 = etag "details" ((etag "summary" d1) $$ d2)++documentStyle = style_ $ +  text "details {padding-left: 16px;}" $$      +  text "ul {list-style: none; padding-left: 16px; padding-top: 0px; padding-bottom: 0px; margin-top: 0px; margin-bottom: 0px;}" $$+  text "li.plus:before {content: \"+\"; margin-right: 4px;}" $$+  text "li.minus:before {content: \"-\"; margin-right: 4px;}" $$+  text "li.quest:before {content: \"?\"; margin-right: 4px;}" $$+  text "li.star:before {content: \"*\"; margin-right: 4px;}"++documentScript = script $ +  nest 2 ((text "function toggleRow(e){") $$+          nest  2 ((text "var subRow = e.parentNode.parentNode.nextElementSibling;") $$+          text "subRow.style.display = subRow.style.display === 'none' ? 'table-row' : 'none';") $$+   (text "}"))++htmlTableHead :: Judgement -> Doc+htmlTableHead (Judgement (_, _, _, js)) = +  tr $ th (text "Title") $$ (vcat $ map maketd js) $$ th (text "Total")+  where+    maketd (Judgement (Header(title, _, maxPoint), _, _, _)) = th $ text (title ++ "/") <> pointsDoc maxPoint++htmlJudgement :: Judgement -> Doc+htmlJudgement (Judgement (Header(title, points, maxPoint), _, comments, judgements)) = +  (tr $ (td . toggle $ text title) $$ vcat (map htmlSubJudgement judgements) $$ (td $ pointsDoc points)) $$+  (trhidden $ tdspan (length judgements+2) $ (htmlDetailComments comments $$ htmlDetailJudgements judgements))++htmlSubJudgement :: Judgement -> Doc+htmlSubJudgement (Judgement (Header(title, points, maxPoint), _, comments, judgements)) = +  (td $ pointsDoc points) ++htmlDetailJudgements :: [Judgement] -> Doc +htmlDetailJudgements = vcat . (map htmlDetailJudgement) ++htmlDetailJudgement :: Judgement -> Doc+htmlDetailJudgement (Judgement (Header(title, points, maxPoint), _, comments, judgements)) = +  details +    (text title <> parens (pointsDoc points <> text "/" <> pointsDoc maxPoint)) +    (htmlDetailComments comments $$ htmlDetailJudgements judgements)++htmlDetailComments :: [Comment] -> Doc+htmlDetailComments [] = text ""+htmlDetailComments comments = +  ul . vcat $ map htmlDetailComment comments++htmlDetailComment :: Comment -> Doc+htmlDetailComment (Comment (mood, commentParts)) =+  liclass (htmlDetailMood mood) $ vcat $ map htmlDetailCommentPart commentParts++htmlDetailMood :: Mood -> String+htmlDetailMood Positive  = "plus"+htmlDetailMood Negative  = "minus"+htmlDetailMood Neutral   = "star"+htmlDetailMood Impartial = "quest"++htmlDetailCommentPart :: CommentPart -> Doc+htmlDetailCommentPart (CommentStr string) = text string+htmlDetailCommentPart (CommentCmt comment) =+  ul $ htmlDetailComment comment
+ src/Invalid.hs view
@@ -0,0 +1,18 @@+{-# LANGUAGE DeriveGeneric #-}++module Invalid where++import Ast++import Text.PrettyPrint.GenericPretty++data Invalid+  = PointsExceedMaxPoints Header+  | BadSubJudgementPointsSum Judgement+  | BadSubJudgementMaxPointsSum Judgement+  | NoPointsInBottomJudgement Judgement+  | PropertyNotFound String+  deriving (Eq, Show, Generic)++instance Out Invalid+
src/Parser/Impl.hs view
@@ -59,6 +59,31 @@   comments <- many parseComment'   pure $ Bonus (points, comments) +parsePropertyExp :: ReadP PropertyExp+parsePropertyExp = choice [lookupProp, value]+  where +    lookupProp = do+      void $ char '['+      index <- parseIntegral+      void $ char '.'+      name <- lineToken $ munchTillExcl ']'+      void $ lineBreak+      case (maybeRead (index)) of+        Just i -> pure $ Lookup (i, name)+        _ -> pfail+    value = do+      v <- satisfy (/='[')+      value <- parseLine+      pure $ Value (v:value)++parseProperty :: ReadP Property+parseProperty = do+  void $ string "  :"+  name <- lineToken $ munchTillExcl ':'+  void $ char ' '+  value <- parsePropertyExp+  pure $ Property (name, value)+ parseRegularJudgement :: Int -> String -> ReadP Judgement parseRegularJudgement depth title = do   points <- (lineToken $ parsePoints) +++ (return $ 1/0)@@ -68,9 +93,10 @@    let header = Header (title, points, maxPoints) +  properties <- many parseProperty   comments <- many parseComment'   subjs <- many $ parseJudgement (depth + 1)-  pure $ Judgement (header, comments, subjs)+  pure $ Judgement (header, properties, comments, subjs)  parseJudgement :: Int -> ReadP Judgement parseJudgement depth = skipSpaces *> do
src/PointsChecker.hs view
@@ -1,22 +1,12 @@ {-# LANGUAGE DeriveGeneric #-} -module PointsChecker ( checkPoints, Invalid(..) ) where+module PointsChecker ( checkPoints ) where  import Ast+import Invalid  import Control.Monad ( forM_ ) -import Text.PrettyPrint.GenericPretty--data Invalid-  = PointsExceedMaxPoints Header-  | BadSubJudgementPointsSum Judgement-  | BadSubJudgementMaxPointsSum Judgement-  | NoPointsInBottomJudgement Judgement-  deriving (Eq, Show, Generic)--instance Out Invalid- try :: Bool -> Invalid -> Either Invalid () try True = \_ -> Right () try False = Left@@ -26,20 +16,20 @@ x ~= y = abs (x - y) <= 0.01  checkPointsSubJs :: Judgement -> Either Invalid Judgement-checkPointsSubJs (Judgement (h @ (Header (t, _, maxP)), cs, subJs)) = do+checkPointsSubJs (Judgement (h @ (Header (t, _, maxP)), prop, cs, subJs)) = do   newSubJs <- mapM checkPoints subJs   let newP = sum $ map points newSubJs-  pure $ Judgement (Header (t, newP, maxP), cs, newSubJs)+  pure $ Judgement (Header (t, newP, maxP), prop, cs, newSubJs) checkPointsSubJs j = pure j  checkPoints :: Judgement -> Either Invalid Judgement-checkPoints j @ (Judgement (h @ (Header (_, p, maxP)), _, [])) | isInfinite p = do+checkPoints j @ (Judgement (h @ (Header (_, p, maxP)), _, _, [])) | isInfinite p = do   Left $ NoPointsInBottomJudgement j-checkPoints j @ (Judgement (h @ (Header (_, p, maxP)), _, subJs @ (_:_))) | isInfinite p = do+checkPoints j @ (Judgement (h @ (Header (_, p, maxP)), _, _, subJs @ (_:_))) | isInfinite p = do   try ((sum $ map maxPoints subJs) ~= maxP)     (BadSubJudgementMaxPointsSum j)   checkPointsSubJs j-checkPoints j @ (Judgement (h @ (Header (_, p, maxP)), _, subJs)) = do+checkPoints j @ (Judgement (h @ (Header (_, p, maxP)), _, _, subJs)) = do   try (p <= maxP)     (PointsExceedMaxPoints h)   case subJs of@@ -54,8 +44,8 @@  points :: Judgement -> Double points (Bonus (v, _)) = v-points (Judgement (Header (_, v, _), _, _)) = v+points (Judgement (Header (_, v, _), _, _, _)) = v  maxPoints :: Judgement -> Double maxPoints (Bonus _) = 0.0-maxPoints (Judgement (Header (_, _, v), _, _)) = v+maxPoints (Judgement (Header (_, _, v), _, _, _)) = v
src/PrettyPrinter.hs view
@@ -1,6 +1,7 @@ module PrettyPrinter (ppJs) where  import Ast+import Export.Generic  import Text.PrettyPrint import Data.List (intersperse)@@ -12,23 +13,26 @@ formatJudgement level (Bonus (points, comments)) =   (text $ replicate level '#') <+> text "Bonus" <> colon <+> text "+" <>     pointsDoc points-formatJudgement level (Judgement (header, comments, judgements)) =+formatJudgement level (Judgement (header, properties, comments, judgements)) =   formatHeader level header $+$-  (nest 2 $ vcat $ map (formatComment) comments) $+$+  (nest 2 $ vcat $ map formatProperty properties) $+$+  (nest 2 $ vcat $ map formatComment comments) $+$   (vcat $ map (formatJudgement (level + 1)) judgements) -isIntegral :: Double -> Bool-isIntegral x = x == fromInteger (round x)--pointsDoc :: Double -> Doc-pointsDoc v | isNaN v = empty-pointsDoc v | isIntegral v = integer (round v)-pointsDoc v = double v- formatHeader :: Int -> Header -> Doc formatHeader level (Header (title, point, maxPoints)) =-  (text $ replicate level '#') <+> text title <> colon <> space <>+  (text $ replicate level '#') <+> text title <> colon <>     pointsDoc point <> text "/" <> pointsDoc maxPoints++formatProperty :: Property -> Doc+formatProperty (Property (name, value)) =+  colon <> text name <> colon <+> formatPropertyExp value++formatPropertyExp :: PropertyExp -> Doc+formatPropertyExp (Lookup (index, name)) =+  brackets $ int index <> text "." <> text name+formatPropertyExp (Value value) = text value+formatPropertyExp (Num double) = pointsDoc double  formatComment :: Comment -> Doc formatComment (Comment (mood, commentParts)) =
+ src/PropertyInterp.hs view
@@ -0,0 +1,60 @@+{-# LANGUAGE DeriveGeneric #-}++module PropertyInterp ( interpProps ) where++import Ast+import Invalid++import Text.PrettyPrint.GenericPretty++-- In the lists index 0 is used for predifined variables: Title, Total, MaxPoints+-- This should refactored to real monadic programming++data PropertyValue+  = StrVal String+  | DoubVal Double+  deriving (Eq, Show, Generic)++instance Out PropertyValue++interpProps :: Judgement -> Either Invalid Judgement+interpProps j = +  case (interpJudgement j) of+    Right (jnew, _) -> Right jnew+    Left invalid -> Left invalid++interpJudgement :: Judgement -> Either Invalid (Judgement, [(String, PropertyValue)])+interpJudgement j @ (Judgement (h, prop, cs, js)) = do+  updlist <- mapM interpJudgement js+  let (jupdates, jsPropVals) = unzip updlist+  predef <- generatePredefinedValues h+  propVals <- mapM (bindProp (predef:jsPropVals)) (addPredifinedProps prop)+  let newProps = map propValToProperties propVals+  pure (Judgement (h, newProps, cs, jupdates), propVals)++propValToProperties :: (String, PropertyValue) -> Property+propValToProperties (str, StrVal string) = Property (str, Value string)+propValToProperties (str, DoubVal double) = Property (str, Num double)++addPredifinedProps :: [Property] -> [Property]+addPredifinedProps p = +  Property("Title", Lookup (0, "Title")) : +  Property("Total", Lookup (0, "Total")) : +  Property("MaxPoints", Lookup (0, "MaxPoints")) : p++generatePredefinedValues :: Header -> Either Invalid [(String, PropertyValue)]+generatePredefinedValues (Header (t, p, maxP)) = +  pure [("Title", StrVal t), ("Total", DoubVal p), ("MaxPoints", DoubVal maxP)]++bindProp :: [[(String, PropertyValue)]] -> Property -> Either Invalid (String, PropertyValue)+bindProp propEnv (Property (name, propExp)) = +  case (evalPropExp propExp propEnv) of+    Right (val)  -> pure (name, val)+    Left invalid -> Left invalid++evalPropExp :: PropertyExp -> [[(String, PropertyValue)]] -> Either Invalid PropertyValue+evalPropExp (Value s) _ = pure $ StrVal s+evalPropExp (Lookup (i, p)) propEnv = +  case (lookup p (propEnv !! (i))) of+    Nothing -> Left $ PropertyNotFound p+    (Just s) -> pure s