From 77dbe32785d8709a2a9ada8b7e6fada6e94e0b4e Mon Sep 17 00:00:00 2001
From: Joshua Potter <jrpotter2112@gmail.com>
Date: Sun, 26 Dec 2021 16:10:35 -0500
Subject: [PATCH] Strict dynamic.

---
 tagless-final/app/Main.hs         |  4 ++--
 tagless-final/src/Parser/Final.hs | 16 ++++++++++++++--
 2 files changed, 16 insertions(+), 4 deletions(-)

diff --git a/tagless-final/app/Main.hs b/tagless-final/app/Main.hs
index 8c43775..f732548 100644
--- a/tagless-final/app/Main.hs
+++ b/tagless-final/app/Main.hs
@@ -42,9 +42,9 @@ runExpr :: Parser (Dynamic Eval) -> Text -> IO ()
 runExpr p input = case runParser p input of
   Left e -> print e
   Right d -> case fromDyn @Eval @Integer d of
-    Just a -> print a
+    Just (Eval a) -> print a
     Nothing -> case fromDyn @Eval @Bool d of
-      Just a -> print a
+      Just (Eval a) -> print a
       Nothing -> print "Could not evaluate expression fully."
 
 run :: Args -> IO ()
diff --git a/tagless-final/src/Parser/Final.hs b/tagless-final/src/Parser/Final.hs
index 3e3ca64..a2c0ac3 100644
--- a/tagless-final/src/Parser/Final.hs
+++ b/tagless-final/src/Parser/Final.hs
@@ -30,6 +30,8 @@ import qualified Data.Eq.Type as EQ
 import qualified Text.Megaparsec as M
 
 import Control.Applicative ((<|>))
+import Control.DeepSeq (NFData(..), deepseq)
+import Control.Monad.Combinators (sepBy)
 import Data.Eq.Type ((:=))
 import Data.Functor (void)
 import Data.Maybe (isJust)
@@ -182,7 +184,17 @@ parseSingle = expr >>= either offsetFail pure
 -- Strict
 -- ========================================
 
-parseStrict :: forall repr. TextSymantics repr => Parser (Dynamic repr)
+instance (NFData t) => NFData (Eval t) where
+  rnf (Eval t) = t `seq` ()
+
+instance NFData (Dynamic Eval) where
+  rnf (Dynamic _ e) = e `seq` ()
+
+parseStrict
+  :: forall repr
+   . NFData (Dynamic repr)
+  => TextSymantics repr
+  => Parser (Dynamic repr)
 parseStrict = term >>= expr
  where
   expr :: Dynamic repr -> Parser (Dynamic repr)
@@ -206,7 +218,7 @@ parseStrict = term >>= expr
     t' <- term
     case asDyn bin t t' of
       Nothing -> fail $ "Invalid operands for `" <> show op <> "`"
-      Just a -> a `seq` expr a
+      Just a -> a `deepseq` expr a
 
   term :: Parser (Dynamic repr)
   term = do