Add CamelCase filename linter check

.gitlab-ci.yml

@@ -22,7 +22,7 @@ linter:
       - stack-cache
 
   script:
-    - stack --stack-root "$PWD/stack-cache" ./Lint.hs lexer
+    - stack --stack-root "$PWD/stack-cache" ./Lint.hs lexer syntax
 
   tags:
     - alive

Lint.hs

@@ -13,6 +13,7 @@ import Options.Applicative
 import System.Directory
 import System.Environment
 import System.Exit
+import System.FilePath.Posix
 import System.Process
 
 data LintOptions = LintOptions
@@ -27,6 +28,16 @@ lintOptions = LintOptions
 main = lint =<< readArguments
     where readArguments = execParser $ info (lintOptions <**> helper) $ fullDesc
 
+allChecks :: [(String, LintCheck)]
+allChecks =
+    [ ("no other files are present" , noOtherFiles)
+    , ("filenames are CamelCase", camelCaseFileNames)
+    , ("valid input files are ASCII", validsAreAscii)
+    , ("nonempty files have a trailing newline", haveTrailingNewline)
+    , ("a valid test file exists for every .out file", outsHaveValids)
+    , (".out files have no trailing whitespace at the end of each line", haveTrailingWhitespace)
+    ]
+
 lint options = do
     putStrLn "# Starting linting process"
     allProblems <- concat <$> mapM lintDirectory (directories options)
@@ -72,21 +83,13 @@ type Pathsets = (Set FilePath, Set FilePath, Set FilePath, Set FilePath)
 
 type LintCheck = Pathsets -> IO [Problem]
 
-allChecks :: [(String, LintCheck)]
-allChecks =
-    [ ("no other files are present" , noOtherFiles)
-    , ("valid input files are ASCII", validsAreAscii)
-    , ("nonempty files have a trailing newline", haveTrailingNewline)
-    , ("a valid test file exists for every .out file", outsHaveValids)
-    , (".out files have no trailing whitespace at the end of each line", haveTrailingWhitespace)
-    ]
-
 data Problem
     = ShouldNotExist FilePath
     | NotAnAsciiFile FilePath
     | MissingTrailingNewLine FilePath
     | MissingInFile FilePath
     | TrailingWhitespace FilePath Int
+    | FilenameNotCamelCase FilePath
 
 instance Show Problem where
     show (ShouldNotExist path) = path ++ " should not exist"
@@ -94,6 +97,7 @@ instance Show Problem where
     show (MissingTrailingNewLine path) = path ++ " does not have a trailing newline"
     show (MissingInFile path) = path ++ " does not have an input file"
     show (TrailingWhitespace path line) = path ++ " has trailing whitespace at the end of line " ++ show line
+    show (FilenameNotCamelCase path) = path ++ " is not CamelCase"
 
 newline = 10
 
@@ -152,6 +156,23 @@ haveTrailingWhitespace (_, _, outPaths, _) = concat <$> mapM go (Set.toList outP
                     | not $ BS.null $ BS8.takeWhileEnd (`elem` " \t") line = [TrailingWhitespace path i]
                     | otherwise                                            = []
 
+camelCaseFileNames (validPaths, invalidPaths, outPaths, _) =
+    pure $ concat $ map (catMaybes . map checkCamelCase . Set.toList)
+        [validPaths, invalidPaths, outPaths]
+    where
+        checkCamelCase path = toMaybe
+            (not $ isUpper (head str) && all isCamelCaseChar str)
+            (FilenameNotCamelCase path)
+            where str = dropExtensions $ takeBaseName path
+
+        toMaybe True  x = Just x
+        toMaybe False x = Nothing
+
+        isUpper         c = c `elem` ['A'..'Z']
+        isLower         c = c `elem` ['a'..'z']
+        isDigit         c = c `elem` ['0'..'9']
+        isCamelCaseChar c = isUpper c || isLower c || isDigit c
+
 runCheck :: (String, LintCheck) -> Pathsets -> IO [Problem]
 runCheck (label, check) pathsets = do
     putStr $ "### Checking whether " ++ label ++ "..."