Convenience function for reading / parsing a whole file, also spotted needless attempt in effect pattern parser

parser-typechecker/src/Unison/FileParser.hs

@@ -1,24 +1,31 @@
 module Unison.FileParser where
 
-import qualified Text.Parsec.Layout as L
 -- import           Text.Parsec.Prim (ParsecT)
-import           Unison.Parser
 -- import qualified Unison.TypeParser as TypeParser
+import Prelude hiding (readFile)
+import           Unison.Parser
 import Control.Applicative
 import Data.Either (partitionEithers)
-import Unison.Parsers (unsafeGetRight)
+import Data.Map (Map)
 import Unison.DataDeclaration (DataDeclaration(..))
 import Unison.EffectDeclaration (EffectDeclaration(..))
-import Unison.Parser (PEnv)
+import Unison.Parser (PEnv, penv0)
+import Unison.Parsers (unsafeGetRight)
+import Unison.Symbol (Symbol)
 import Unison.Term (Term)
+import Unison.TypeParser (S)
+import Unison.Var (Var)
+import qualified Data.Map as Map
+import qualified Text.Parsec.Layout as L
+import qualified Unison.Parser
+import qualified Unison.Parsers as Parsers
 import qualified Unison.Term as Term
 import qualified Unison.TermParser as TermParser
 import qualified Unison.TypeParser as TypeParser
-import Unison.Var (Var)
-import Unison.Symbol (Symbol)
-import Data.Map (Map)
-import qualified Data.Map as Map
-import Unison.TypeParser (S)
+import Control.Monad.Reader
+import Data.Text.IO (readFile)
+import System.IO (FilePath)
+import qualified Data.Text as Text
 
 data UnisonFile v = UnisonFile {
   dataDeclarations :: Map v (DataDeclaration v),
@@ -27,16 +34,32 @@ data UnisonFile v = UnisonFile {
 } deriving (Show)
 
 unsafeParseFile :: String -> PEnv -> UnisonFile Symbol
-unsafeParseFile s env = unsafeGetRight $ parseFile s env
+unsafeParseFile s env = unsafeGetRight $ parseFile "" s env
 
-parseFile :: String -> PEnv -> Either String (UnisonFile Symbol)
-parseFile = error ""
+parseFile :: FilePath -> String -> PEnv -> Either String (UnisonFile Symbol)
+parseFile filename s = Unison.Parser.run' (Unison.Parser.root file) s Parsers.s0 filename
+
+parseFile' :: FilePath -> String -> Either String (UnisonFile Symbol)
+parseFile' filename s = parseFile filename s penv0
+
+unsafeReadAndParseFile' :: String -> IO (UnisonFile Symbol)
+unsafeReadAndParseFile' = unsafeReadAndParseFile penv0
+
+unsafeReadAndParseFile :: PEnv -> String -> IO (UnisonFile Symbol)
+unsafeReadAndParseFile env filename = do
+  txt <- readFile filename
+  let str = Text.unpack txt
+  pure $ unsafeGetRight (parseFile filename str env)
 
 file :: Var v => Parser (S v) (UnisonFile v)
 file = traced "file" $ do
   (dataDecls, effectDecls) <- traced "declarations" declarations
-  term <- TermParser.block
-  pure $ UnisonFile dataDecls effectDecls term
+  local (`Map.union` environmentFor dataDecls effectDecls) $ do
+    term <- TermParser.block
+    pure $ UnisonFile dataDecls effectDecls term
+
+environmentFor :: Map v (DataDeclaration v) -> Map v (EffectDeclaration v) -> PEnv
+environmentFor ds es = Map.empty -- todo
 
 declarations :: Var v => Parser (S v)
                          (Map v (DataDeclaration v),

parser-typechecker/src/Unison/TermParser.hs

@@ -87,33 +87,34 @@ pattern :: Var v => Parser (S v) (Pattern, [v])
 pattern = traced "pattern" $ constructor <|> leaf
   where
   leaf = literal <|> var <|> unbound <|> parenthesized pattern <|> effect
-  literal = (,[]) <$> asum [true, false, number]
+  literal = traced "pattern.literal" $ (,[]) <$> asum [true, false, number]
   true = Pattern.Boolean True <$ token (string "true")
   false = Pattern.Boolean False <$ token (string "false")
-  number = number' Pattern.Int64 Pattern.UInt64 Pattern.Float
+  number = traced "pattern.number" $ number' Pattern.Int64 Pattern.UInt64 Pattern.Float
   var = traced "var" $ (\v -> (Pattern.Var, [v])) <$> prefixVar
-  unbound = (Pattern.Unbound, []) <$ token (char '_')
-  ctorName = token $ do
+  unbound = traced "unbound" $ (Pattern.Unbound, []) <$ token (char '_')
+  ctorName = traced "ctorName" . token $ do
     s <- wordyId keywords
     guard . isUpper . head $ s
     pure s
 
   effectBind0 = traced "effectBind0" $ do
     name <- ctorName
+    leaves <- many leaf
+    token_ (string "->")
+    pure (name, leaves)
+
+  effectBind = do
+    (name, leaves) <- attempt effectBind0
+    (cont, vsp) <- pattern
     env <- ask
     (ref,cid) <- case Map.lookup name env of
       Just (ref, cid) -> pure (ref, cid)
       Nothing -> fail $ "unknown data constructor " ++ name
-    leaves <- many leaf
-    token_ (string "->")
-    pure (ref, cid, leaves)
-
-  effectBind = do
-    (ref, cid, leaves) <- attempt effectBind0
-    (cont, vsp) <- pattern
     pure $ case unzip leaves of
       (patterns, vs) ->
          (Pattern.EffectBind ref cid patterns cont, join vs ++ vsp)
+
   effectPure = go <$> pattern where
     go (p, vs) = (Pattern.EffectPure p, vs)
 
@@ -125,11 +126,11 @@ pattern = traced "pattern" $ constructor <|> leaf
     name <- ctorName
     env <- ask
     case Map.lookup name env of
-      Just (ref, cid) -> go <$> many leaf
+      Just (ref, cid) -> go <$> traced "pattern.manyleaf" (many leaf)
         where
           go pairs = case unzip pairs of
             (patterns, vs) -> (Pattern.Constructor ref cid patterns, join vs)
-      Nothing -> fail $ "unknown data constructor " ++ name
+      Nothing -> traced ("failing " ++ name) . fail $ "unknown data constructor " ++ name
 
 
   -- where literal = boolean
@@ -232,7 +233,7 @@ vector p = Term.vector <$> (lbracket *> elements <* rbracket)
 
 binding :: Var v => Parser (S v) (v, Term v)
 binding = traced "binding" . label "binding" $ do
-  typ <- optional typedecl <* optional semicolon
+  typ <- optional typedecl
   let lhs = attempt ((\arg1 op arg2 -> (op,[arg1,arg2]))
                     <$> prefixVar <*> infixVar <*> prefixVar)
                 <|> ((,) <$> prefixVar <*> many prefixVar)

parser-typechecker/tests/Unison/Test/FileParser.hs

@@ -3,6 +3,7 @@
 module Unison.Test.FileParser where
 
   import EasyTest
+  import Control.Applicative
   import Unison.FileParser
   import Unison.Parser
   import Unison.DataDeclaration
@@ -15,7 +16,7 @@ module Unison.Test.FileParser where
   import qualified Unison.Reference as R
   import Unison.Symbol (Symbol)
 
-  test = scope "fileparser" . tests . map parses $
+  test1 = scope "fileparser" . tests . map parses $
     [
       "type Pair a b = Pair a b\n()"
     , "type Optional a = Just a | Nothing\n()"
@@ -45,6 +46,14 @@ module Unison.Test.FileParser where
       ,"ping"]
     ]
 
+  test2 = scope "fileparser.test1" $ do
+    file <- io $ unsafeReadAndParseFile' "unison-src/test1.u"
+    io $ putStrLn (show (file :: UnisonFile Symbol))
+    ok
+
+  test = test2
+    -- test1 <|> test2
+
   builtins = Map.fromList
     [("Pair", (R.Builtin "Pair", 0)),
      ("State.set", (R.Builtin "State", 0))]

unison-src/test1.u

@@ -0,0 +1,9 @@
+
+type Optional a = None | Some a
+
+Optional.isEmpty : ∀ a . Optional a -> Boolean
+Optional.isEmpty o = case o of
+  None -> True
+  _ -> False
+
+()