From ba66f6e8e40624490911bc60f6a1e306c09be0cd Mon Sep 17 00:00:00 2001
From: Kirill Andreev <hindmost.one@gmail.com>
Date: Fri, 14 Aug 2020 14:54:04 +0400
Subject: [PATCH] Make extension-aware parser entrypoint

---
 tools/lsp/squirrel/app/Main.hs       |  7 ++-----
 tools/lsp/squirrel/src/AST.hs        |  1 +
 tools/lsp/squirrel/src/AST/Parser.hs | 27 +++++++++++++++++++++++++++
 3 files changed, 30 insertions(+), 5 deletions(-)
 create mode 100644 tools/lsp/squirrel/src/AST/Parser.hs

diff --git a/tools/lsp/squirrel/app/Main.hs b/tools/lsp/squirrel/app/Main.hs
index 65e82d7e9..d5780a779 100644
--- a/tools/lsp/squirrel/app/Main.hs
+++ b/tools/lsp/squirrel/app/Main.hs
@@ -28,13 +28,10 @@ import qualified System.Log                            as L
 import           Duplo.Error
 import           Duplo.Tree (collect)
 
-import           Parser
-import           ParseTree
 import           Range
 import           Product
 import           AST                                           hiding (def)
 import qualified AST.Find                              as Find
-import           AST.Pascaligo.Parser 
 -- import           Error
 
 main :: IO ()
@@ -219,7 +216,7 @@ loadFromVFS funs uri = do
   Just vf <- Core.getVirtualFileFunc funs $ J.toNormalizedUri uri
   let txt = virtualFileText vf
   let Just fin = J.uriToFilePath uri
-  (tree, _) <- runParserM . recognise =<< mkRawTreePascal (Text fin txt)
+  (tree, _) <- parse (Text fin txt)
   return $ addLocalScopes tree
 
 -- loadByURI
@@ -242,7 +239,7 @@ collectErrors
 collectErrors funs uri path version = do
   case path of
     Just fin -> do
-      (tree, errs) <- runParserM . recognise =<< mkRawTreePascal (Path fin)
+      (tree, errs) <- parse (Path fin)
       Core.publishDiagnosticsFunc funs 100 uri version
         $ partitionBySource
         $ map errorToDiag (errs <> map (getElem *** void) (collect tree))
diff --git a/tools/lsp/squirrel/src/AST.hs b/tools/lsp/squirrel/src/AST.hs
index 11ab94670..1c38cbb13 100644
--- a/tools/lsp/squirrel/src/AST.hs
+++ b/tools/lsp/squirrel/src/AST.hs
@@ -5,3 +5,4 @@ import AST.Completion as M
 import AST.Find as M
 import AST.Scope as M
 import AST.Skeleton as M
+import AST.Parser as M
diff --git a/tools/lsp/squirrel/src/AST/Parser.hs b/tools/lsp/squirrel/src/AST/Parser.hs
new file mode 100644
index 000000000..8d144f566
--- /dev/null
+++ b/tools/lsp/squirrel/src/AST/Parser.hs
@@ -0,0 +1,27 @@
+
+module AST.Parser
+  ( Source(..)
+  , parse
+  ) where
+
+import Control.Monad.Catch
+
+import System.FilePath
+
+import qualified AST.Pascaligo.Parser as Pascal
+import qualified AST.Reasonligo.Parser as Reason
+import           AST.Skeleton
+
+import ParseTree
+import Parser
+
+data UnsupportedExtension = UnsupportedExtension String
+  deriving stock Show
+  deriving anyclass Exception
+
+parse :: Source -> IO (LIGO Info, [Msg])
+parse src = do
+  case takeExtension $ srcPath src of
+    "religo" -> mkRawTreeReason src >>= runParserM . Reason.recognise
+    "ligo"   -> mkRawTreePascal src >>= runParserM . Pascal.recognise
+    ext      -> throwM $ UnsupportedExtension ext