WIP remove parseProgramDef.

IntersectMBO · Jan 18, 2022 · 4f253f8 · 4f253f8
1 parent efc3ff7
commit 4f253f8
Show file tree

Hide file tree

Showing 4 changed files with 19 additions and 25 deletions.
diff --git a/plutus-core/plutus-core/src/PlutusCore.hs b/plutus-core/plutus-core/src/PlutusCore.hs
@@ -2,6 +2,7 @@
 {-# LANGUAGE ExplicitNamespaces #-}
 {-# LANGUAGE OverloadedStrings  #-}
 {-# LANGUAGE PatternSynonyms    #-}
+{-# OPTIONS_GHC -Wno-deferred-out-of-scope-variables #-}
 
 module PlutusCore
     (
@@ -163,34 +164,29 @@ import UntypedPlutusCore.Evaluation.Machine.Cek.CekMachineCosts
 import Control.Monad.Except
 import Data.ByteString.Lazy qualified as BSL
 import Data.Text qualified as T
-import Text.Megaparsec (ParseErrorBundle, SourcePos, initialPos)
-
+import Text.Megaparsec (ParseErrorBundle, SourcePos, errorBundlePretty, initialPos)
 
 topSourcePos :: SourcePos
 topSourcePos = initialPos "top"
 
 -- | Given a file at @fibonacci.plc@, @fileType "fibonacci.plc"@ will display
 -- its type or an error message.
 fileType :: FilePath -> IO T.Text
-fileType = fmap (either prettyErr id . printType) . BSL.readFile
-    where
-        prettyErr :: Error DefaultUni DefaultFun SourcePos -> T.Text
-        prettyErr = displayPlcDef
+fileType = fmap (either (T.pack . errorBundlePretty) id . printType) . BSL.readFile
+
 
 -- | Given a file, display
 -- its type or an error message, optionally dumping annotations and debug
 -- information.
-fileTypeCfg :: PrettyConfigPlc -> FilePath -> IO T.Text
-fileTypeCfg cfg = fmap (either prettyErr id . printType) . BSL.readFile
-    where
-        prettyErr :: Error DefaultUni DefaultFun SourcePos -> T.Text
-        prettyErr = displayBy cfg
+fileTypeCfg :: FilePath -> IO T.Text
+fileTypeCfg = fmap (either (T.pack . errorBundlePretty) id . printType) . BSL.readFile
+
 
 -- | Print the type of a program contained in a 'ByteString'
 printType
     :: BSL.ByteString
     -> Either (ParseErrorBundle T.Text ParseError) T.Text
-printType bs = runQuoteT $ T.pack . show . pretty <$> do
+printType bs = T.pack . show . pretty <$> do
     scoped <- parseScoped bs
     config <- getDefTypeCheckConfig topSourcePos
     inferTypeOfProgram config scoped
@@ -220,20 +216,17 @@ typecheckPipeline
     -> m (Normalized (Type TyName DefaultUni ()))
 typecheckPipeline = inferTypeOfProgram
 
-parseProgramDef
-    :: BSL.ByteString -> Either (ParseErrorBundle T.Text ParseError) (Program TyName Name DefaultUni DefaultFun SourcePos)
-parseProgramDef = parseProgram
-
 formatDoc ::
     PrettyConfigPlc -> BSL.ByteString ->
         Either (ParseErrorBundle T.Text ParseError) (Doc a)
 -- don't use parseScoped since we don't bother running sanity checks when we format
-formatDoc cfg = runQuoteT . fmap (prettyBy cfg) . (rename <=< parseProgramDef)
+formatDoc cfg = fmap (prettyBy cfg) . (rename <=< parseProgram)
 
 format
-    :: PrettyConfigPlc -> BSL.ByteString -> m T.Text
+    :: PrettyConfigPlc -> BSL.ByteString ->
+        Either (ParseErrorBundle T.Text ParseError) T.Text
 -- don't use parseScoped since we don't bother running sanity checks when we format
-format cfg = runQuoteT . fmap (displayBy cfg) . (rename <=< parseProgramDef)
+format cfg = fmap (displayBy cfg) . (rename <=< parseProgram)
 
 -- | Take one PLC program and apply it to another.
 applyProgram

diff --git a/plutus-core/plutus-core/src/PlutusCore/Error.hs b/plutus-core/plutus-core/src/PlutusCore/Error.hs
@@ -26,6 +26,7 @@ module PlutusCore.Error
     , Error (..)
     , AsError (..)
     , throwingEither
+    , ShowErrorComponent (..)
     ) where
 
 import PlutusPrelude

diff --git a/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs b/plutus-core/plutus-core/src/PlutusCore/Parser/ParserCommon.hs
@@ -21,6 +21,7 @@ import Text.Megaparsec.Char.Lexer qualified as Lex
 import Control.Monad.State (MonadState (get, put), StateT, evalStateT)
 
 import Data.ByteString.Lazy (ByteString)
+import Data.ByteString.Lazy.Internal (unpackChars)
 import PlutusCore.Core.Type qualified as PLC
 import PlutusCore.Default qualified as PLC
 import PlutusCore.Error qualified as PLC
@@ -61,8 +62,9 @@ parse p file str = PLC.runQuote $ parseQuoted p file str
 parseGen :: Parser a -> ByteString -> Either (ParseErrorBundle T.Text PLC.ParseError) a
 parseGen stuff bs = parse stuff "test" $ (T.pack . unpackChars) bs
 
-parseQuoted :: Parser a -> String -> T.Text -> PLC.Quote
-                   (Either (ParseErrorBundle T.Text PLC.ParseError) a)
+parseQuoted ::
+    Parser a -> String -> T.Text ->
+        PLC.Quote (Either (ParseErrorBundle T.Text PLC.ParseError) a)
 parseQuoted p file str = flip evalStateT initial $ runParserT p file str
 
 -- | Space consumer.

diff --git a/plutus-core/plutus-core/src/PlutusCore/TypeCheck.hs b/plutus-core/plutus-core/src/PlutusCore/TypeCheck.hs
@@ -1,9 +1,7 @@
 -- | Kind/type inference/checking.
 
-{-# LANGUAGE ConstraintKinds  #-}
-{-# LANGUAGE TypeApplications #-}
-{-# LANGUAGE TypeFamilies     #-}
-{-# LANGUAGE TypeOperators    #-}
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TypeFamilies    #-}
 
 module PlutusCore.TypeCheck
     ( ToKind