Add FileExt type (#2467)

This PR introduces FileExt type, and consequently, one can generalise
methods and matches based on the file extension; for example,
`parseInputJuvixAsmFile` is now an app. `parseInputFile FileExtJuvixAsm`

app/Commands/Compile/Options.hs

@@ -15,4 +15,4 @@ parseMainCompileOptions :: Parser CompileOptions
 parseMainCompileOptions =
   parseCompileOptions
     supportedTargets
-    parseInputJuvixFile
+    (parseInputFile FileExtJuvix)

app/Commands/Dev/Asm/Compile/Options.hs

@@ -21,4 +21,4 @@ parseAsmCompileOptions :: Parser AsmCompileOptions
 parseAsmCompileOptions =
   parseCompileOptions
     asmSupportedTargets
-    parseInputJuvixAsmFile
+    (parseInputFile FileExtJuvixAsm)

app/Commands/Dev/Asm/Run/Options.hs

@@ -17,5 +17,5 @@ parseAsmRunOptions = do
       ( long "no-validate"
           <> help "Don't validate the input before running"
       )
-  _asmRunInputFile <- parseInputJuvixAsmFile
+  _asmRunInputFile <- parseInputFile FileExtJuvixAsm
   pure AsmRunOptions {..}

app/Commands/Dev/Asm/Validate/Options.hs

@@ -12,7 +12,7 @@ makeLenses ''AsmValidateOptions
 
 parseAsmValidateOptions :: Parser AsmValidateOptions
 parseAsmValidateOptions = do
-  _asmValidateInputFile <- parseInputJuvixAsmFile
+  _asmValidateInputFile <- parseInputFile FileExtJuvixAsm
   _asmValidateNoPrint <-
     switch
       ( long "no-print"

app/Commands/Dev/Core/Asm/Options.hs

@@ -17,5 +17,5 @@ parseCoreAsmOptions = do
       ( long "print"
           <> help "print the generated JuvixAsm code instead of running it"
       )
-  _coreAsmInputFile <- parseInputJuvixCoreFile
+  _coreAsmInputFile <- parseInputFile FileExtJuvixCore
   pure CoreAsmOptions {..}

app/Commands/Dev/Core/Compile/Options.hs

@@ -24,4 +24,4 @@ parseCoreCompileOptions :: Parser CoreCompileOptions
 parseCoreCompileOptions =
   parseCompileOptions
     coreSupportedTargets
-    parseInputJuvixAsmFile
+    (parseInputFile FileExtJuvixAsm)

app/Commands/Dev/Core/Eval/Options.hs

@@ -38,11 +38,11 @@ parseCoreEvalOptions = do
   _coreEvalNoIO <-
     switch
       ( long "no-io"
-          <> help "Don't interpret the IO effects"
+          <> help "Do not interpret the IO effects"
       )
   _coreEvalShowDeBruijn <- optDeBruijn
   _coreEvalShowIdentIds <- optIdentIds
   _coreEvalShowArgsNum <- optArgsNum
   _coreEvalNoDisambiguate <- optNoDisambiguate
-  _coreEvalInputFile <- parseInputJuvixCoreFile
+  _coreEvalInputFile <- parseInputFile FileExtJuvixCore
   pure CoreEvalOptions {..}

app/Commands/Dev/Core/FromConcrete/Options.hs

@@ -66,7 +66,7 @@ parseCoreFromConcreteOptions = do
       ( long "no-io"
           <> help "Don't interpret the IO effects"
       )
-  _coreFromConcreteInputFile <- parseInputJuvixFile
+  _coreFromConcreteInputFile <- parseInputFile FileExtJuvixCore
   _coreFromConcreteSymbolName <-
     optional $
       strOption

app/Commands/Dev/Core/Normalize/Options.hs

@@ -38,5 +38,5 @@ parseCoreNormalizeOptions = do
   _coreNormalizeShowIdentIds <- optIdentIds
   _coreNormalizeShowArgsNum <- optArgsNum
   _coreNormalizeNoDisambiguate <- optNoDisambiguate
-  _coreNormalizeInputFile <- parseInputJuvixCoreFile
+  _coreNormalizeInputFile <- parseInputFile FileExtJuvixCore
   pure CoreNormalizeOptions {..}

app/Commands/Dev/Core/Read/Options.hs

@@ -71,5 +71,5 @@ parseCoreReadOptions = do
           <> help "normalize after the transformation"
       )
   _coreReadTransformations <- optTransformationIds
-  _coreReadInputFile <- parseInputJuvixCoreFile
+  _coreReadInputFile <- parseInputFile FileExtJuvixCore
   pure CoreReadOptions {..}

app/Commands/Dev/Core/Strip/Options.hs

@@ -26,5 +26,5 @@ parseCoreStripOptions = do
       ( long "no-print"
           <> help "do not print the stripped code"
       )
-  _coreStripInputFile <- parseInputJuvixCoreFile
+  _coreStripInputFile <- parseInputFile FileExtJuvixCore
   pure CoreStripOptions {..}

app/Commands/Dev/DisplayRoot/Options.hs

@@ -18,5 +18,5 @@ parseRoot = do
           <> help "print the juvix.yaml file as parsed"
       )
 
-  _rootMainFile <- optional parseInputJuvixFile
+  _rootMainFile <- optional (parseInputFile FileExtJuvix)
   pure RootOptions {..}

app/Commands/Dev/Geb/Eval/Options.hs

@@ -1,6 +1,7 @@
 module Commands.Dev.Geb.Eval.Options where
 
 import CommonOptions
+import Data.List.NonEmpty qualified as NonEmpty
 import Juvix.Compiler.Backend.Geb.Evaluator qualified as Geb
 import Juvix.Compiler.Backend.Geb.Pretty qualified as Geb
 
@@ -23,7 +24,7 @@ instance CanonicalProjection GebEvalOptions Geb.Options where
 
 parseGebEvalOptions :: Parser GebEvalOptions
 parseGebEvalOptions = do
-  _gebEvalOptionsInputFile <- parseInputJuvixGebFile
+  _gebEvalOptionsInputFile <- parseInputFiles (NonEmpty.fromList [FileExtJuvixGeb, FileExtLisp])
   _gebEvalOptionsOutputMorphism <- optOutputMorphism
   pure GebEvalOptions {..}
 

app/Commands/Dev/Geb/Infer/Options.hs

@@ -1,6 +1,7 @@
 module Commands.Dev.Geb.Infer.Options where
 
 import CommonOptions
+import Data.List.NonEmpty qualified as NonEmpty
 import Juvix.Compiler.Backend.Geb.Pretty qualified as Geb
 
 newtype GebInferOptions = GebInferOptions
@@ -15,5 +16,5 @@ instance CanonicalProjection GebInferOptions Geb.Options where
 
 parseGebInferOptions :: Parser GebInferOptions
 parseGebInferOptions = do
-  _gebInferOptionsInputFile <- parseInputJuvixGebFile
+  _gebInferOptionsInputFile <- parseInputFiles (NonEmpty.fromList [FileExtJuvixGeb, FileExtLisp])
   pure GebInferOptions {..}

app/Commands/Dev/Geb/Read/Options.hs

@@ -1,6 +1,7 @@
 module Commands.Dev.Geb.Read.Options where
 
 import CommonOptions
+import Data.List.NonEmpty qualified as NonEmpty
 import Juvix.Compiler.Backend.Geb.Pretty qualified as Geb
 
 newtype GebReadOptions = GebReadOptions
@@ -15,5 +16,6 @@ instance CanonicalProjection GebReadOptions Geb.Options where
 
 parseGebReadOptions :: Parser GebReadOptions
 parseGebReadOptions = do
-  _gebReadOptionsInputFile <- parseInputJuvixGebFile
+  _gebReadOptionsInputFile <-
+    parseInputFiles (NonEmpty.fromList [FileExtJuvixGeb, FileExtLisp])
   pure GebReadOptions {..}

app/Commands/Dev/Highlight/Options.hs

@@ -26,7 +26,7 @@ parseHighlight = do
           <> completeWith (map show allBackends)
       )
 
-  _highlightInputFile <- parseInputJuvixFile
+  _highlightInputFile <- parseInputFile FileExtJuvix
   pure HighlightOptions {..}
   where
     allBackends :: [HighlightBackend]

app/Commands/Dev/Internal/Arity/Options.hs

@@ -11,5 +11,5 @@ makeLenses ''InternalArityOptions
 
 parseInternalArity :: Parser InternalArityOptions
 parseInternalArity = do
-  _internalArityInputFile <- parseInputJuvixFile
+  _internalArityInputFile <- parseInputFile FileExtJuvix
   pure InternalArityOptions {..}

app/Commands/Dev/Internal/Pretty/Options.hs

@@ -11,5 +11,5 @@ makeLenses ''InternalPrettyOptions
 
 parseInternalPretty :: Parser InternalPrettyOptions
 parseInternalPretty = do
-  _internalPrettyInputFile <- parseInputJuvixFile
+  _internalPrettyInputFile <- parseInputFile FileExtJuvix
   pure InternalPrettyOptions {..}

app/Commands/Dev/Internal/Reachability/Options.hs

@@ -11,5 +11,5 @@ makeLenses ''InternalReachabilityOptions
 
 parseInternalReachability :: Parser InternalReachabilityOptions
 parseInternalReachability = do
-  _internalReachabilityInputFile <- parseInputJuvixFile
+  _internalReachabilityInputFile <- parseInputFile FileExtJuvix
   pure InternalReachabilityOptions {..}

app/Commands/Dev/Internal/Typecheck/Options.hs

@@ -17,5 +17,5 @@ parseInternalType = do
       ( long "print-result"
           <> help "Print the type checked module if successful"
       )
-  _internalTypeInputFile <- parseInputJuvixFile
+  _internalTypeInputFile <- parseInputFile FileExtJuvix
   pure InternalTypeOptions {..}

app/Commands/Dev/Parse.hs

@@ -9,5 +9,5 @@ runCommand :: (Members '[Embed IO, App] r) => ParseOptions -> Sem r ()
 runCommand opts = do
   m <-
     head . (^. Parser.resultModules)
-      <$> runPipeline (opts ^. parseInputFile) upToParsing
-  if opts ^. parseNoPrettyShow then say (show m) else say (pack (ppShow m))
+      <$> runPipeline (opts ^. parseOptionsInputFile) upToParsing
+  if opts ^. parseOptionsNoPrettyShow then say (show m) else say (pack (ppShow m))

app/Commands/Dev/Parse/Options.hs

@@ -3,8 +3,8 @@ module Commands.Dev.Parse.Options where
 import CommonOptions
 
 data ParseOptions = ParseOptions
-  { _parseNoPrettyShow :: Bool,
-    _parseInputFile :: AppPath File
+  { _parseOptionsNoPrettyShow :: Bool,
+    _parseOptionsInputFile :: AppPath File
   }
   deriving stock (Data)
 
@@ -12,10 +12,10 @@ makeLenses ''ParseOptions
 
 parseParse :: Parser ParseOptions
 parseParse = do
-  _parseNoPrettyShow <-
+  _parseOptionsNoPrettyShow <-
     switch
       ( long "no-pretty-show"
           <> help "Disable formatting of the Haskell AST"
       )
-  _parseInputFile <- parseInputJuvixFile
+  _parseOptionsInputFile <- parseInputFile FileExtJuvix
   pure ParseOptions {..}

app/Commands/Dev/Repl/Options.hs

@@ -8,7 +8,7 @@ parseDevRepl :: Parser ReplOptions
 parseDevRepl = do
   let _replPrintValues = False
       _replIsDev = True
-  _replInputFile <- optional parseInputJuvixFile
+  _replInputFile <- optional (parseInputFile FileExtJuvix)
   _replTransformations <- do
     ts <- optTransformationIds
     pure $

app/Commands/Dev/Runtime/Options.hs

@@ -19,7 +19,7 @@ parseRuntimeOptions :: Parser CompileOptions
 parseRuntimeOptions =
   parseCompileOptions
     runtimeSupportedTargets
-    parseInputJuvixFile
+    (parseInputFile FileExtJuvix)
 
 parseRuntimeCommand :: Parser RuntimeCommand
 parseRuntimeCommand =

app/Commands/Dev/Scope/Options.hs

@@ -25,7 +25,7 @@ parseScope = do
       ( long "list-comments"
           <> help "List the user comments"
       )
-  _scopeInputFile <- parseInputJuvixFile
+  _scopeInputFile <- parseInputFile FileExtJuvix
   pure ScopeOptions {..}
 
 instance CanonicalProjection (GlobalOptions, ScopeOptions) Scoper.Options where

app/Commands/Dev/Termination/CallGraph/Options.hs

@@ -22,5 +22,5 @@ parseCallGraph = do
               <> short 'f'
               <> help "Only shows the specified function"
           )
-  _graphInputFile <- parseInputJuvixFile
+  _graphInputFile <- parseInputFile FileExtJuvix
   pure CallGraphOptions {..}

app/Commands/Dev/Termination/Calls/Options.hs

@@ -34,7 +34,7 @@ parseCalls = do
           <> value Internal.ArgRel
           <> help "possible values: argument, relation, both"
       )
-  _callsInputFile <- parseInputJuvixFile
+  _callsInputFile <- parseInputFile FileExtJuvix
   pure CallsOptions {..}
   where
     decrArgsParser :: ReadM Internal.ShowDecrArgs

app/Commands/Eval/Options.hs

@@ -29,7 +29,7 @@ instance CanonicalProjection EvalOptions Eval.EvalOptions where
 
 parseEvalOptions :: Parser EvalOptions
 parseEvalOptions = do
-  _evalInputFile <- parseInputJuvixFile
+  _evalInputFile <- parseInputFile FileExtJuvix
   _evalSymbolName <-
     optional $
       strOption

app/Commands/Extra/Compile.hs

@@ -86,26 +86,26 @@ outputFile opts inputFile =
       return $ case opts ^. compileTarget of
         TargetNative64 ->
           if
-              | opts ^. compileCOutput -> replaceExtension' ".c" inputFile
-              | opts ^. compilePreprocess -> addExtension' ".c" (addExtension' ".out" (removeExtension' inputFile))
+              | opts ^. compileCOutput -> replaceExtension' cFileExt inputFile
+              | opts ^. compilePreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
               | opts ^. compileAssembly -> replaceExtension' ".s" inputFile
               | otherwise -> removeExtension' baseOutputFile
         TargetWasm32Wasi ->
           if
-              | opts ^. compileCOutput -> replaceExtension' ".c" inputFile
-              | opts ^. compilePreprocess -> addExtension' ".c" (addExtension' ".out" (removeExtension' inputFile))
+              | opts ^. compileCOutput -> replaceExtension' cFileExt inputFile
+              | opts ^. compilePreprocess -> addExtension' cFileExt (addExtension' ".out" (removeExtension' inputFile))
               | opts ^. compileAssembly -> replaceExtension' ".wat" inputFile
               | otherwise -> replaceExtension' ".wasm" baseOutputFile
         TargetGeb ->
           if
-              | opts ^. compileTerm -> replaceExtension' ".geb" inputFile
-              | otherwise -> replaceExtension' ".lisp" baseOutputFile
+              | opts ^. compileTerm -> replaceExtension' juvixGebFileExt inputFile
+              | otherwise -> replaceExtension' lispFileExt baseOutputFile
         TargetVampIR ->
-          replaceExtension' ".pir" baseOutputFile
+          replaceExtension' vampIRFileExt baseOutputFile
         TargetCore ->
-          replaceExtension' ".jvc" baseOutputFile
+          replaceExtension' juvixCoreFileExt baseOutputFile
         TargetAsm ->
-          replaceExtension' ".jva" baseOutputFile
+          replaceExtension' juvixAsmFileExt baseOutputFile
 
 clangNativeCompile ::
   forall r.

app/Commands/Extra/Compile/Options.hs

@@ -48,7 +48,7 @@ parseCompileOptions ::
   SupportedTargets ->
   Parser (AppPath File) ->
   Parser CompileOptions
-parseCompileOptions supportedTargets parseInputFile = do
+parseCompileOptions supportedTargets parserFile = do
   _compileDebug <-
     switch
       ( short 'g'
@@ -110,7 +110,7 @@ parseCompileOptions supportedTargets parseInputFile = do
       )
   _compileTarget <- optCompileTarget supportedTargets
   _compileOutputFile <- optional parseGenericOutputFile
-  _compileInputFile <- optional parseInputFile
+  _compileInputFile <- optional parserFile
   pure CompileOptions {..}
 
 optCompileTarget :: SupportedTargets -> Parser CompileTarget

app/Commands/Format/Options.hs

@@ -15,8 +15,8 @@ parseInputJuvixFileOrDir :: Parser (Prepath FileOrDir)
 parseInputJuvixFileOrDir =
   strArgument
     ( metavar "JUVIX_FILE_OR_PROJECT"
-        <> help "Path to a .juvix file or to a directory containing a Juvix project."
-        <> completer juvixCompleter
+        <> help ("Path to a " <> show FileExtJuvix <> " file or to a directory containing a Juvix project.")
+        <> completer (extCompleter FileExtJuvix)
         <> action "directory"
     )
 

app/Commands/Html/Options.hs

@@ -91,7 +91,7 @@ parseHtml = do
       ( long "open"
           <> help "Open the documentation after generating it"
       )
-  _htmlInputFile <- parseInputJuvixFile
+  _htmlInputFile <- parseInputFile FileExtJuvix
   pure HtmlOptions {..}
   where
     allThemes :: [Theme]

app/Commands/Repl/Options.hs

@@ -30,7 +30,7 @@ parseRepl = do
       _replNoDisambiguate = False
       _replPrintValues = True
       _replIsDev = False
-  _replInputFile <- optional parseInputJuvixFile
+  _replInputFile <- optional (parseInputFile FileExtJuvix)
   _replNoPrelude <-
     switch
       ( long "no-prelude"

app/Commands/Typecheck/Options.hs

@@ -12,7 +12,7 @@ makeLenses ''TypecheckOptions
 
 parseTypecheck :: Parser TypecheckOptions
 parseTypecheck = do
-  _typecheckInputFile <- parseInputJuvixFile
+  _typecheckInputFile <- parseInputFile FileExtJuvix
   pure TypecheckOptions {..}
 
 instance CanonicalProjection TypecheckOptions Internal.InternalTypeOptions where

app/CommonOptions.hs

@@ -7,7 +7,9 @@ module CommonOptions
 where
 
 import Control.Exception qualified as GHC
+import Data.List.NonEmpty qualified as NonEmpty
 import Juvix.Compiler.Core.Data.TransformationId.Parser
+import Juvix.Data.FileExt
 import Juvix.Prelude
 import Options.Applicative
 import System.Process
@@ -26,61 +28,25 @@ makeLenses ''AppPath
 instance Show (AppPath f) where
   show = Prelude.show . (^. pathPath)
 
-parseInputJuvixFile :: Parser (AppPath File)
-parseInputJuvixFile = do
+parseInputFiles :: NonEmpty FileExt -> Parser (AppPath File)
+parseInputFiles exts' = do
+  let exts = NonEmpty.toList exts'
+      mvars = intercalate "|" (map toMetavar exts)
+      dotExts = intercalate ", " (map Prelude.show exts)
+      helpMsg = "Path to a " <> dotExts <> " file"
+      completers = foldMap (completer . extCompleter) exts
   _pathPath <-
     argument
       somePreFileOpt
-      ( metavar "JUVIX_FILE"
-          <> help "Path to a .juvix file"
-          <> completer juvixCompleter
+      ( metavar mvars
+          <> help helpMsg
+          <> completers
+          <> action "file"
       )
   pure AppPath {_pathIsInput = True, ..}
 
-parseInputJuvixCoreFile :: Parser (AppPath File)
-parseInputJuvixCoreFile = do
-  _pathPath <-
-    argument
-      somePreFileOpt
-      ( metavar "JUVIX_CORE_FILE"
-          <> help "Path to a .jvc file"
-          <> completer juvixCoreCompleter
-      )
-  pure AppPath {_pathIsInput = True, ..}
-
-parseInputJuvixGebFile :: Parser (AppPath File)
-parseInputJuvixGebFile = do
-  _pathPath <-
-    argument
-      somePreFileOpt
-      ( metavar "JUVIX_GEB_FILE"
-          <> help "Path to a .geb or custom .lisp file"
-          <> completer juvixGebCompleter
-          <> completer juvixGebLispCompleter
-      )
-  pure AppPath {_pathIsInput = True, ..}
-
-parseInputJuvixAsmFile :: Parser (AppPath File)
-parseInputJuvixAsmFile = do
-  _pathPath <-
-    argument
-      somePreFileOpt
-      ( metavar "JUVIX_ASM_FILE"
-          <> help "Path to a .jva file"
-          <> completer juvixAsmCompleter
-      )
-  pure AppPath {_pathIsInput = True, ..}
-
-parseInputCFile :: Parser (AppPath File)
-parseInputCFile = do
-  _pathPath <-
-    argument
-      somePreFileOpt
-      ( metavar "C_FILE"
-          <> help "Path to a .c file"
-          <> completer juvixCCompleter
-      )
-  pure AppPath {_pathIsInput = True, ..}
+parseInputFile :: FileExt -> Parser (AppPath File)
+parseInputFile = parseInputFiles . NonEmpty.singleton
 
 parseGenericInputFile :: Parser (AppPath File)
 parseGenericInputFile = do
@@ -143,30 +109,12 @@ naturalNumberOpt = eitherReader aux
     aux :: String -> Either String Word
     aux s = maybe (Left $ s <> " is not a nonnegative number") Right (readMaybe s :: Maybe Word)
 
-extCompleter :: String -> Completer
+extCompleter :: FileExt -> Completer
 extCompleter ext = mkCompleter $ \word -> do
-  let cmd = unwords ["compgen", "-o", "plusdirs", "-f", "-X", "!*." <> ext, "--", requote word]
+  let cmd = unwords ["compgen", "-o", "plusdirs", "-f", "-X", "!*" <> Prelude.show ext, "--", requote word]
   result <- GHC.try @GHC.SomeException $ readProcess "bash" ["-c", cmd] ""
   return . lines . fromRight [] $ result
 
-juvixCompleter :: Completer
-juvixCompleter = extCompleter "juvix"
-
-juvixCoreCompleter :: Completer
-juvixCoreCompleter = extCompleter "jvc"
-
-juvixGebLispCompleter :: Completer
-juvixGebLispCompleter = extCompleter "lisp"
-
-juvixGebCompleter :: Completer
-juvixGebCompleter = extCompleter "geb"
-
-juvixAsmCompleter :: Completer
-juvixAsmCompleter = extCompleter "jva"
-
-juvixCCompleter :: Completer
-juvixCCompleter = extCompleter "c"
-
 requote :: String -> String
 requote s =
   let -- Bash doesn't appear to allow "mixed" escaping

src/Juvix/Compiler/Backend/Geb/Translation/FromSource.hs

@@ -7,6 +7,7 @@ where
 import Juvix.Compiler.Backend.Geb.Keywords
 import Juvix.Compiler.Backend.Geb.Language qualified as Geb
 import Juvix.Compiler.Backend.Geb.Translation.FromSource.Lexer
+import Juvix.Data.FileExt
 import Juvix.Parser.Error
 import Juvix.Prelude
 import Text.Megaparsec qualified as P

src/Juvix/Compiler/Backend/VampIR/Pretty/Base.hs

@@ -100,9 +100,9 @@ vampIRDefs bits unsafe =
     <> ";\n\n"
     <> if
         | unsafe ->
-            UTF8.toString $(FE.makeRelativeToProject "runtime/src/vampir/stdlib_unsafe.pir" >>= FE.embedFile)
+            UTF8.toString $(FE.makeRelativeToProject ("runtime/src/vampir/stdlib_unsafe" <> vampIRFileExt) >>= FE.embedFile)
         | otherwise ->
-            UTF8.toString $(FE.makeRelativeToProject "runtime/src/vampir/stdlib.pir" >>= FE.embedFile)
+            UTF8.toString $(FE.makeRelativeToProject ("runtime/src/vampir/stdlib" <> vampIRFileExt) >>= FE.embedFile)
 
 --------------------------------------------------------------------------------
 -- helper functions

src/Juvix/Compiler/Concrete/Translation/FromParsed/Analysis/PathResolver/Paths.hs

@@ -4,7 +4,8 @@ import Juvix.Compiler.Concrete.Data.Name
 import Juvix.Prelude
 
 topModulePathToRelativePath' :: TopModulePath -> Path Rel File
-topModulePathToRelativePath' = topModulePathToRelativePath ".juvix" "" (</>)
+topModulePathToRelativePath' =
+  topModulePathToRelativePath (show FileExtJuvix) "" (</>)
 
 topModulePathToRelativePath :: String -> String -> (FilePath -> FilePath -> FilePath) -> TopModulePath -> Path Rel File
 topModulePathToRelativePath ext suffix joinpath mp = relFile relFilePath

src/Juvix/Data.hs

@@ -2,6 +2,7 @@ module Juvix.Data
   ( module Juvix.Data.Effect,
     module Juvix.Data.Error,
     module Juvix.Data.Fixity,
+    module Juvix.Data.FileExt,
     module Juvix.Data.Hole,
     module Juvix.Data.IsImplicit,
     module Juvix.Data.Loc,
@@ -23,6 +24,7 @@ import Juvix.Data.Comment
 import Juvix.Data.DependencyInfo
 import Juvix.Data.Effect
 import Juvix.Data.Error
+import Juvix.Data.FileExt
 import Juvix.Data.Fixity
 import Juvix.Data.Hole
 import Juvix.Data.Irrelevant

src/Juvix/Data/FileExt.hs

@@ -0,0 +1,151 @@
+module Juvix.Data.FileExt where
+
+import Data.Text qualified as Text
+import Juvix.Prelude.Base
+import Juvix.Prelude.Path
+import Juvix.Prelude.Pretty
+import Prelude (show)
+
+-- | File extensions Juvix interacts with.
+data FileExt
+  = FileExtJuvix
+  | FileExtJuvixMarkdown
+  | FileExtJuvixGeb
+  | FileExtJuvixCore
+  | FileExtJuvixAsm
+  | FileExtVampIR
+  | FileExtVampIRParams
+  | FileExtPlonk
+  | FileExtHalo
+  | FileExtLisp
+  | FileExtC
+  | FileExtMarkdown
+  | FileExtHtml
+  | FileExtCss
+  deriving stock (Eq)
+
+juvixFileExt :: (IsString a) => a
+juvixFileExt = ".juvix"
+
+juvixMarkdownFileExt :: (IsString a) => a
+juvixMarkdownFileExt = ".juvix.md"
+
+juvixGebFileExt :: (IsString a) => a
+juvixGebFileExt = ".geb"
+
+juvixCoreFileExt :: (IsString a) => a
+juvixCoreFileExt = ".jvc"
+
+juvixAsmFileExt :: (IsString a) => a
+juvixAsmFileExt = ".jva"
+
+vampIRFileExt :: (IsString a) => a
+vampIRFileExt = ".pir"
+
+vampIRParamsFileExt :: (IsString a) => a
+vampIRParamsFileExt = ".pp"
+
+plonkFileExt :: (IsString a) => a
+plonkFileExt = ".plonk"
+
+haloFileExt :: (IsString a) => a
+haloFileExt = ".halo2"
+
+lispFileExt :: (IsString a) => a
+lispFileExt = ".lisp"
+
+htmlFileExt :: (IsString a) => a
+htmlFileExt = ".html"
+
+markdownFileExt :: (IsString a) => a
+markdownFileExt = ".md"
+
+cFileExt :: (IsString a) => a
+cFileExt = ".c"
+
+cssFileExt :: (IsString a) => a
+cssFileExt = ".css"
+
+fileExtToText :: FileExt -> Text
+fileExtToText = \case
+  FileExtJuvix -> juvixFileExt
+  FileExtJuvixMarkdown -> juvixMarkdownFileExt
+  FileExtJuvixGeb -> juvixGebFileExt
+  FileExtJuvixCore -> juvixCoreFileExt
+  FileExtJuvixAsm -> juvixAsmFileExt
+  FileExtVampIR -> vampIRFileExt
+  FileExtVampIRParams -> vampIRParamsFileExt
+  FileExtPlonk -> plonkFileExt
+  FileExtHalo -> haloFileExt
+  FileExtLisp -> lispFileExt
+  FileExtC -> cFileExt
+  FileExtMarkdown -> markdownFileExt
+  FileExtHtml -> htmlFileExt
+  FileExtCss -> cssFileExt
+
+toMetavar :: FileExt -> String
+toMetavar = \case
+  FileExtJuvix -> "JUVIX_FILE"
+  FileExtJuvixMarkdown -> "JUVIX_MARKDOWN_FILE"
+  FileExtJuvixGeb -> "JUVIX_GEB_FILE"
+  FileExtJuvixCore -> "JUVIX_CORE_FILE"
+  FileExtJuvixAsm -> "JUVIX_ASM_FILE"
+  FileExtVampIR -> "VAMPIR_FILE"
+  FileExtVampIRParams -> "VAMPIR_PARAMS_FILE"
+  FileExtPlonk -> "PLONK_FILE"
+  FileExtHalo -> "HALO_FILE"
+  FileExtLisp -> "LISP_FILE"
+  FileExtC -> "C_FILE"
+  FileExtMarkdown -> "MARKDOWN_FILE"
+  FileExtHtml -> "HTML_FILE"
+  FileExtCss -> "CSS_FILE"
+
+instance Show FileExt where
+  show = Text.unpack . fileExtToText
+
+instance Pretty FileExt where
+  pretty = pretty . fileExtToText
+
+isJuvixFile :: Path b File -> Bool
+isJuvixFile = (== Just juvixFileExt) . fileExtension
+
+isJuvixMarkdownFile :: Path b File -> Bool
+isJuvixMarkdownFile p = case splitExtension p of
+  Just (f, ext) -> ext == juvixMarkdownFileExt && isJuvixFile f
+  _ -> False
+
+isJuvixGebFile :: Path b File -> Bool
+isJuvixGebFile = (== Just juvixGebFileExt) . fileExtension
+
+isJuvixCoreFile :: Path b File -> Bool
+isJuvixCoreFile = (== Just juvixCoreFileExt) . fileExtension
+
+isVampIRFile :: Path b File -> Bool
+isVampIRFile = (== Just vampIRFileExt) . fileExtension
+
+isVampIRParamsFile :: Path b File -> Bool
+isVampIRParamsFile = (== Just vampIRParamsFileExt) . fileExtension
+
+isPlonkFile :: Path b File -> Bool
+isPlonkFile = (== Just plonkFileExt) . fileExtension
+
+isHaloFile :: Path b File -> Bool
+isHaloFile = (== Just haloFileExt) . fileExtension
+
+isJuvixAsmFile :: Path b File -> Bool
+isJuvixAsmFile = (== Just juvixAsmFileExt) . fileExtension
+
+isLispFile :: Path b File -> Bool
+isLispFile = (== Just lispFileExt) . fileExtension
+
+isMarkdownFile :: Path b File -> Bool
+isMarkdownFile = (== Just markdownFileExt) . fileExtension
+
+isCFile :: Path b File -> Bool
+isCFile = (== Just cFileExt) . fileExtension
+
+isHtmlFile :: Path b File -> Bool
+isHtmlFile = (== Just htmlFileExt) . fileExtension
+
+isCssFile :: Path b File -> Bool
+isCssFile = (== Just cssFileExt) . fileExtension

src/Juvix/Extra/Paths.hs

@@ -4,6 +4,7 @@ module Juvix.Extra.Paths
   )
 where
 
+import Juvix.Data.FileExt
 import Juvix.Extra.Paths.Base
 import Juvix.Prelude.Base
 import Juvix.Prelude.Path
@@ -40,4 +41,4 @@ formatStdinPath :: Path Abs File
 formatStdinPath = $(mkAbsFile "/format-stdin")
 
 gebReplPath :: Path Abs File
-gebReplPath = $(mkAbsFile "/repl.geb")
+gebReplPath = $(mkAbsFile ("/repl" <> juvixGebFileExt))

src/Juvix/Prelude/Path.hs

@@ -64,15 +64,6 @@ destructAbsFile x = (root, dirs, filename x)
   where
     (root, dirs) = destructAbsDir (parent x)
 
-isJuvixFile :: Path b File -> Bool
-isJuvixFile = (== Just ".juvix") . fileExtension
-
-isJuvixGebFile :: Path b File -> Bool
-isJuvixGebFile = (== Just ".geb") . fileExtension
-
-isLispFile :: Path b File -> Bool
-isLispFile = (== Just ".lisp") . fileExtension
-
 isHiddenDirectory :: Path b Dir -> Bool
 isHiddenDirectory p
   | toFilePath p == relRootFP = False