🔥 Preluded and make prelude paths simpler/explicit

Preluded was overengineered anyway.

semantic.cabal

@@ -130,7 +130,6 @@ library
                      , Language.PHP.Assignment
                      , Language.PHP.Grammar
                      , Language.PHP.Syntax
-                     , Language.Preluded
                      , Language.Python.Assignment
                      , Language.Python.Grammar
                      , Language.Python.Syntax

src/Data/Language.hs

@@ -93,3 +93,13 @@ extensionsForLanguage language = case language of
 -- | Return a language based on a FilePath's extension, or Nothing if extension is not found or not supported.
 languageForFilePath :: FilePath -> Language
 languageForFilePath = languageForType . takeExtension
+
+-- | Return the filename representing the prelude for the passed language, if any.
+-- The convention here is "languagename.ext", lowercase. Note that this path
+-- does not include the prelude directory, as that is configurable.
+preludeFilename :: Language -> Maybe FilePath
+preludeFilename l = case l of
+  Python     -> Just "python.py"
+  Ruby       -> Just "ruby.rb"
+  JavaScript -> Just "javascript.js"
+  _          -> Nothing

src/Data/Project.hs

@@ -15,6 +15,7 @@ module Data.Project (
   -- * Files
   , File (..)
   , file
+  , preludePath
   ) where
 
 import Prelude hiding (readFile)
@@ -112,3 +113,6 @@ readFile Project{..} f =
     | p == "/dev/null"  -> pure Nothing
     | isJust candidate  -> pure candidate
     | otherwise         -> throwError (SomeException (FileNotFound p))
+
+preludePath :: FilePath -> Language -> Maybe File
+preludePath dir lang = fmap (\p -> File (dir </> p) lang) (preludeFilename lang)

src/Language/Preluded.hs

@@ -1,22 +0,0 @@
-{-# LANGUAGE DataKinds, TypeFamilies #-}
-
-module Language.Preluded
-    ( Preluded (..)
-    ) where
-
-import GHC.TypeLits
-import qualified Language.Python.Assignment as Python
-import qualified Language.Ruby.Assignment as Ruby
-import qualified Language.TypeScript.Assignment as TypeScript
-
-class Preluded syntax where
-  type PreludePath syntax :: Symbol
-
-instance Preluded Ruby.Term where
-  type PreludePath Ruby.Term = "preludes/ruby.rb"
-
-instance Preluded Python.Term where
-  type PreludePath Python.Term = "preludes/python.py"
-
-instance Preluded TypeScript.Term where
-  type PreludePath TypeScript.Term = "preludes/javascript.js"

src/Parsing/Parser.hs

@@ -41,7 +41,6 @@ import qualified Language.Java.Assignment as Java
 import qualified Language.JSON.Assignment as JSON
 import qualified Language.Markdown.Assignment as Markdown
 import qualified Language.PHP.Assignment as PHP
-import           Language.Preluded
 import qualified Language.Python.Assignment as Python
 import qualified Language.Ruby.Assignment as Ruby
 import qualified Language.TypeScript.Assignment as TypeScript
@@ -81,14 +80,14 @@ someAnalysisParser :: ( ApplyAll' typeclasses Go.Syntax
                    => proxy typeclasses                                -- ^ A proxy for the list of typeclasses required, e.g. @(Proxy :: Proxy '[Show1])@.
                    -> Language                                         -- ^ The 'Language' to select.
                    -> SomeAnalysisParser typeclasses (Record Location) -- ^ A 'SomeAnalysisParser abstracting the syntax type to be produced.
-someAnalysisParser _ Go         = SomeAnalysisParser goParser Nothing
-someAnalysisParser _ Java       = SomeAnalysisParser javaParser Nothing
-someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) JavaScript)
-someAnalysisParser _ Haskell    = SomeAnalysisParser haskellParser Nothing
-someAnalysisParser _ PHP        = SomeAnalysisParser phpParser Nothing
-someAnalysisParser _ Python     = SomeAnalysisParser pythonParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Python)
-someAnalysisParser _ Ruby       = SomeAnalysisParser rubyParser $ Just (File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Ruby)
-someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser Nothing
+someAnalysisParser _ Go         = SomeAnalysisParser goParser (preludePath "preludes" Go)
+someAnalysisParser _ Java       = SomeAnalysisParser javaParser (preludePath "preludes" Java)
+someAnalysisParser _ JavaScript = SomeAnalysisParser typescriptParser $ (preludePath "" JavaScript)
+someAnalysisParser _ Haskell    = SomeAnalysisParser haskellParser (preludePath "preludes" Haskell)
+someAnalysisParser _ PHP        = SomeAnalysisParser phpParser (preludePath "preludes" PHP)
+someAnalysisParser _ Python     = SomeAnalysisParser pythonParser (preludePath "preludes" Python)
+someAnalysisParser _ Ruby       = SomeAnalysisParser rubyParser (preludePath "preludes" Ruby)
+someAnalysisParser _ TypeScript = SomeAnalysisParser typescriptParser (preludePath "preludes" TypeScript)
 someAnalysisParser _ l          = error $ "Analysis not supported for: " <> show l
 
 

src/Semantic/Util.hs

@@ -20,7 +20,6 @@ import           Data.Term
 import qualified GHC.TypeLits as TypeLevel
 import           Language.Haskell.HsColour
 import           Language.Haskell.HsColour.Colourise
-import           Language.Preluded
 import           Parsing.Parser
 import           Prologue hiding (weaken)
 import           Semantic.Graph
@@ -96,9 +95,9 @@ evalTypeScriptProject path = justEvaluating =<< evaluateProject typescriptParser
 
 typecheckGoFile path = checking =<< evaluateProjectWithCaching goParser Language.Go Nothing path
 
-rubyPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Ruby.Term))) Language.Ruby
-pythonPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath Python.Term))) Language.Python
-javaScriptPrelude = Just $ File (TypeLevel.symbolVal (Proxy :: Proxy (PreludePath TypeScript.Term))) Language.JavaScript
+rubyPrelude = preludePath "preludes" Language.Ruby
+pythonPrelude = preludePath "preludes" Language.Python
+javaScriptPrelude = preludePath "preludes" Language.JavaScript
 
 -- Evaluate a project, starting at a single entrypoint.
 evaluateProject parser lang prelude path = evaluatePackageWith id withTermSpans . fmap quieterm <$> runTask (readProject Nothing path lang [] >>= addPrelude lang >>= parsePackage parser prelude)
@@ -116,8 +115,8 @@ addPrelude l proj = do
   case p of
     Nothing -> pure proj
     Just pth -> do
-      bl <- readBlobFromPath pth
-      pure $ proj { projectBlobs = bl : projectBlobs proj }
+      mBlob <- IO.readFile pth
+      pure (maybe proj (\bl -> proj { projectBlobs = bl : projectBlobs proj }) mBlob)
 
 parseFile :: Parser term -> FilePath -> IO term
 parseFile parser = runTask . (parse parser <=< readBlob . file)