Cleanup parser-initial code.

cabal.project

@@ -1,5 +1,4 @@
 packages:
   leibniz-proof
-  parser-adt
   parser-closed
-  parser-gadt
+  parser-initial

flake.nix

@@ -10,11 +10,22 @@
     flake-utils.lib.eachDefaultSystem (system:
       let
         pkgs = nixpkgs.legacyPackages.${system};
+        ghc = pkgs.haskellPackages.ghc;
+        hls = pkgs.haskell-language-server.override {
+          supportedGhcVersions = [ "8107" ];
+        };
       in {
         devShell = pkgs.mkShell {
           buildInputs = [
+            ghc
+            hls
+            pkgs.gdb
+            # GHC depends on LANG so need this package to properly interpret our
+            # files with e.g. tasty-discover.
+            # https://www.reddit.com/r/Nix/comments/jyczts/nixshell_locale_issue/
+            pkgs.glibcLocales
             pkgs.haskellPackages.cabal-install
-            pkgs.haskellPackages.ghc
+            pkgs.haskellPackages.tasty-discover
           ];
         };
       });

hie.yaml

@@ -0,0 +1,2 @@
+cradle:
+  cabal:

parser-gadt/app/Main.hs

@@ -1,116 +0,0 @@
-{-# LANGUAGE BlockArguments #-}
-{-# LANGUAGE ExplicitForAll #-}
-{-# LANGUAGE FlexibleInstances #-}
-{-# LANGUAGE GADTs #-}
-{-# LANGUAGE OverloadedStrings #-}
-{-# LANGUAGE StandaloneDeriving #-}
-
-module Main where
-
-import qualified Control.Monad.Combinators.Expr as E
-import qualified Text.Megaparsec as M
-import qualified Text.Megaparsec.Char as MC
-import qualified Text.Megaparsec.Char.Lexer as ML
-
-import Control.Applicative ((<|>))
-import Data.Char (isDigit)
-import Data.Foldable (foldl')
-import Data.Functor (($>))
-import Data.Text (Text)
-import Data.Void (Void)
-import Numeric (readDec)
-import System.Environment (getArgs)
-
--- ========================================
--- GADT
--- ========================================
-
-data Expr a where
-  EInt  :: Integer -> Expr Integer
-  EBool :: Bool -> Expr Bool
-  EAdd  :: Expr Integer -> Expr Integer -> Expr Integer
-  ESub  :: Expr Integer -> Expr Integer -> Expr Integer
-  EAnd  :: Expr Bool -> Expr Bool -> Expr Bool
-  EOr   :: Expr Bool -> Expr Bool -> Expr Bool
-
-deriving instance Show (Expr Integer)
-deriving instance Show (Expr Bool)
-
-eval :: forall a. Expr a -> Either Bool Integer
-eval (EInt e) = Right e
-eval (EBool e) = Left e
-eval (EAdd lhs rhs) =
-  let Right r1 = eval lhs
-      Right r2 = eval rhs
-   in Right (r1 + r2)
-eval (ESub lhs rhs) =
-  let Right r1 = eval lhs
-      Right r2 = eval rhs
-   in Right (r1 - r2)
-eval (EAnd lhs rhs) =
-  let Left r1 = eval lhs
-      Left r2 = eval rhs
-   in Left (r1 && r2)
-eval (EOr lhs rhs) =
-  let Left r1 = eval lhs
-      Left r2 = eval rhs
-   in Left (r1 || r2)
-
--- ========================================
--- Unused parser code
--- ========================================
-
-type Parser = M.Parsec Void Text
-
-space :: Parser ()
-space = ML.space MC.space1 M.empty M.empty
-{-# INLINE space #-}
-
-lexeme_ :: forall a. Parser a -> Parser a
-lexeme_ = ML.lexeme $ MC.space1 <|> M.eof
-{-# INLINE lexeme_ #-}
-
-symbol :: Text -> Parser Text
-symbol = ML.symbol space
-{-# INLINE symbol #-}
-
-parens :: forall a. Parser a -> Parser a
-parens = M.between (symbol "(") (symbol ")")
-{-# INLINE parens #-}
-
-boolean :: Parser Bool
-boolean = lexeme_ do
-  MC.string "true" $> True <|> MC.string "false" $> False
-{-# INLINE boolean #-}
-
-integer :: Parser Integer
-integer = lexeme_ do
-  i <- M.some $ M.satisfy isDigit
-  case readDec i of
-    [(value, "")] -> pure value
-    _ -> fail "integer"
-{-# INLINE integer #-}
-
-{-
-Couldn't match type `Bool` with `Integer`
-
-parseExpr = E.makeExprParser parseTerm
-  [ [binary "+" EAdd, binary "-" ESub]
-  , [binary "&&" EAnd, binary "||" EOr]
-  ]
- where
-  binary name f = E.InfixL  (f <$ symbol name)
-  parseTerm = parens parseExpr <|>
-              EInt <$> integer <|>
-              EBool <$> boolean
--}
-
--- ========================================
--- Main
--- ========================================
-
-main :: IO ()
-main = do
-  [count] <- map read <$> getArgs
-  let expr = foldl' EAdd (EInt 0) $ take count (EInt <$> [1..])
-  print $ {-# SCC "evaluated" #-} eval expr

parser-gadt/parser-gadt.cabal

@@ -1,12 +0,0 @@
-  cabal-version:      3.4
-  name:               parser-gadt
-  version:            0.1.0.0
-
-executable parser-gadt
-  main-is:            Main.hs
-  build-depends:      base ^>=4.14.3.0,
-                      megaparsec,
-                      parser-combinators,
-                      text
-  hs-source-dirs:     app
-  default-language:   Haskell2010

parser-initial/app/Main.hs

@@ -0,0 +1,52 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import qualified Parser as P
+import qualified Text.Megaparsec as M
+
+import Data.Text (Text)
+import Data.Text.IO (hGetContents)
+import Options.Applicative
+import System.Environment (getArgs)
+import System.IO (IOMode(ReadMode), openFile)
+
+data Args = Args
+  { argsFileName :: !FilePath
+  , argsMethod :: !Text
+  }
+
+args :: Parser Args
+args = Args
+  <$> strArgument (metavar "FILENAME" <> help "The file we want to parse.")
+  <*> strOption
+     ( short 'm'
+    <> long "method"
+    <> metavar "METHOD"
+    <> showDefault
+    <> value "naive"
+    <> help "The parse strategy we want to try. Should be one of \
+            \\"naive\", \"mul_pass\", or \"mem_cons\"."
+     )
+
+run :: Args -> IO ()
+run args = do
+  let method = case argsMethod args of
+                 "naive"    -> P.naiveExpr
+                 "mul_pass" -> P.mulPassExpr
+                 "mem_cons" -> P.memConsExpr
+                 _          -> error "Encountered an invalid parsing strategy."
+  handle <- openFile (argsFileName args) ReadMode
+  contents <- hGetContents handle
+  case M.parse (method <* M.eof) (argsFileName args) contents of
+    Left e -> print $ M.errorBundlePretty e
+    Right a -> print $ P.eval a
+
+main :: IO ()
+main = run =<< execParser opts
+  where
+    opts = info (args <**> helper)
+      ( fullDesc
+     <> progDesc "Different parsing strategies using initial encoding"
+     <> header "Initial encoding parsing"
+      )

parser-initial/parser-initial.cabal

@@ -1,9 +1,18 @@
   cabal-version:      3.4
-  name:               parser-adt
+  name:               parser-initial
   version:            0.1.0.0
 
-executable parser-adt
+executable parser-initial
   main-is:            Main.hs
+  build-depends:      base ^>=4.14.3.0,
+                      megaparsec,
+                      optparse-applicative,
+                      parser-initial,
+                      text,
+  hs-source-dirs:     app
+  default-language:   Haskell2010
+
+library
   build-depends:      base ^>=4.14.3.0,
                       deepseq,
                       megaparsec,
@@ -12,5 +21,6 @@ executable parser-adt
                       text,
                       transformers,
                       transformers-either
-  hs-source-dirs:     app
+  hs-source-dirs:     src
   default-language:   Haskell2010
+  exposed-modules:    Parser

parser-initial/src/Parser.hs

@@ -1,10 +1,13 @@
 {-# LANGUAGE BlockArguments #-}
 {-# LANGUAGE ExplicitForAll #-}
-{-# LANGUAGE FlexibleContexts #-}
-{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Main where
+module Parser
+( eval
+, memConsExpr
+, mulPassExpr
+, naiveExpr
+) where
 
 import qualified Control.Monad.Combinators.Expr as E
 import qualified Text.Megaparsec as M
@@ -178,23 +181,6 @@ memConsExpr = do
     z `deepseq` expr z
 
   term = do
-    p <- lift $ M.option Nothing $ Just <$> (symbol "(")
+    p <- lift $ M.option Nothing $ Just <$> symbol "("
     if isJust p then (term >>= expr) <* lift (symbol ")") else
       lift $ EInt <$> integer <|> EBool <$> boolean
-
--- ========================================
--- Main
--- ========================================
-
-run :: FilePath -> IO ()
-run fileName = do
-  handle <- openFile fileName ReadMode
-  contents <- hGetContents handle
-  case M.parse (memConsExpr <* M.eof) fileName contents of
-    Left e -> print $ M.errorBundlePretty e
-    Right a -> print $ eval a
-
-main :: IO ()
-main = do
-  [fileName] <- getArgs
-  run fileName