@@ -0,0 +1,419 @@
1+module Main where
2+
3+import Prelude
4+
5+import Data.Array as Array
6+import Data.Either (Either(..))
7+import Data.Enum (fromEnum)
8+import Data.Foldable (for_)
9+import Data.Maybe (Maybe(..))
10+import Data.Newtype (unwrap)
11+import Data.String.CodeUnits as String
12+import Data.Tuple.Nested ((/\))
13+import Effect (Effect)
14+import Effect.Console (log)
15+import Node.FS.Simple as FS
16+import Node.CLI as Process
17+import Options.Applicative (Parser, argument, execParserPure, fullDesc, header, help, helper, info, long, many, metavar, progDesc, str, switch, (<**>))
18+import Options.Applicative.Builder (defaultPrefs)
19+import Options.Applicative.Types (CompletionResult(..), ParserFailure(ParserFailure), ParserResult(..))
20+import Options.Applicative.Help.Types (ParserHelp(ParserHelp), renderHelp)
21+import Purslint.Config (defaultConfig, filterRules, parseConfig)
22+import Purslint.Fix (applyAllFixes)
23+import Purslint.Rule (Rule)
24+import Purslint.Rules.BooleanSimplify (booleanSimplifyRule)
25+import Purslint.Rules.CollapseLambdas (collapseLambdasRule)
26+import Purslint.Rules.ConcatMap (concatMapRule)
27+import Purslint.Rules.EtaReduce (etaReduceRule)
28+import Purslint.Rules.EtaReduceDecl (etaReduceDeclRule)
29+import Purslint.Rules.AlternativeLaw (alternativeLawRule)
30+import Purslint.Rules.EvaluateBool (evaluateBoolRule)
31+import Purslint.Rules.EvaluateConst (evaluateConstRule)
32+import Purslint.Rules.EvaluateEither (evaluateEitherRule)
33+import Purslint.Rules.EvaluateFst (evaluateFstRule)
34+import Purslint.Rules.MapIdentity (mapIdentityRule)
35+import Purslint.Rules.FunctorLaw (functorLawRule)
36+import Purslint.Rules.LetToDo (letToDoRule)
37+import Purslint.Rules.LetToWhere (letToWhereRule)
38+import Purslint.Rules.MapFusion (mapFusionRule)
39+import Purslint.Rules.MonadLaw (monadLawRule)
40+import Purslint.Rules.MonoidIdentity (monoidIdentityRule)
41+import Purslint.Rules.NotEqual (notEqualRule)
42+import Purslint.Rules.NothingBind (nothingBindRule)
43+import Purslint.Rules.RedundantBind (redundantBindRule)
44+import Purslint.Rules.RedundantFlip (redundantFlipRule)
45+import Purslint.Rules.RedundantGuard (redundantGuardRule)
46+import Purslint.Rules.RedundantId (redundantIdRule)
47+import Purslint.Rules.RedundantIf (redundantIfRule)
48+import Purslint.Rules.RedundantNegate (redundantNegateRule)
49+import Purslint.Rules.RedundantNot (redundantNotRule)
50+import Purslint.Rules.RedundantReverse (redundantReverseRule)
51+import Purslint.Rules.UnlessNot (unlessNotRule)
52+import Purslint.Rules.UseAll (useAllRule)
53+import Purslint.Rules.UseAnd (useAndRule)
54+import Purslint.Rules.UseAny (useAnyRule)
55+import Purslint.Rules.UseApplicative (useApplicativeRule)
56+import Purslint.Rules.UseApplyFlipped (useApplyFlippedRule)
57+import Purslint.Rules.UseBimap (useBimapRule)
58+import Purslint.Rules.UseBindFlip (useBindFlipRule)
59+import Purslint.Rules.UseBreak (useBreakRule)
60+import Purslint.Rules.UseComparing (useComparingRule)
61+import Purslint.Rules.UseConst (useConstRule)
62+import Purslint.Rules.UseDollar (useDollarRule)
63+import Purslint.Rules.UseEitherMap (useEitherMapRule)
64+import Purslint.Rules.UseElemIndex (useElemIndexRule)
65+import Purslint.Rules.UseFindMap (useFindMapRule)
66+import Purslint.Rules.UseFold (useFoldRule)
67+import Purslint.Rules.UseFoldBool (useFoldBoolRule)
68+import Purslint.Rules.UseFoldMap (useFoldMapRule)
69+import Purslint.Rules.UseFoldMapId (useFoldMapIdRule)
70+import Purslint.Rules.UseFor (useForRule)
71+import Purslint.Rules.UseFromJust (useFromJustRule)
72+import Purslint.Rules.UseFromMaybe (useFromMaybeRule)
73+import Purslint.Rules.UseFstSnd (useFstSndRule)
74+import Purslint.Rules.UseGuard (useGuardRule)
75+import Purslint.Rules.UseGuardMaybe (useGuardMaybeRule)
76+import Purslint.Rules.UseHead (useHeadRule)
77+import Purslint.Rules.UseIsJust (useIsJustRule)
78+import Purslint.Rules.UseIsNothing (useIsNothingRule)
79+import Purslint.Rules.UseJoin (useJoinRule)
80+import Purslint.Rules.UseLastReverse (useLastReverseRule)
81+import Purslint.Rules.UseMapMaybe (useMapMaybeRule)
82+import Purslint.Rules.UseMaybeMap (useMaybeMapRule)
83+import Purslint.Rules.UseMinMax (useMinMaxRule)
84+import Purslint.Rules.UseMinimumSort (useMinimumSortRule)
85+import Purslint.Rules.UseNotElem (useNotElemRule)
86+import Purslint.Rules.UseNull (useNullRule)
87+import Purslint.Rules.UseCaseOf (useCaseOfRule)
88+import Purslint.Rules.FlattenCase (flattenCaseRule)
89+import Purslint.Rules.UseOn (useOnRule)
90+import Purslint.Rules.UseOr (useOrRule)
91+import Purslint.Rules.UsePatternGuards (usePatternGuardsRule)
92+import Purslint.Rules.UseReplicate (useReplicateRule)
93+import Purslint.Rules.UseSequence (useSequenceRule)
94+import Purslint.Rules.UseSpan (useSpanRule)
95+import Purslint.Rules.UseTraverse (useTraverseRule)
96+import Purslint.Rules.UseTraverseSequence (useTraverseSequenceRule)
97+import Purslint.Rules.UseUncurry (useUncurryRule)
98+import Purslint.Rules.UseUnless (useUnlessRule)
99+import Purslint.Rules.UseUnwrap (useUnwrapRule)
100+import Purslint.Rules.UseVoid (useVoidRule)
101+import Purslint.Rules.UseWhen (useWhenRule)
102+import Purslint.Rules.UseZip (useZipRule)
103+import Purslint.Rules.WhenNot (whenNotRule)
104+import Purslint.Rules.RedundantParens (redundantParensRule)
105+import Purslint.Runner (runRules)
106+import Purslint.Types (LintResult(..), LintWarning(..), Severity(..), SourceCode(..), Suggestion(..))
107+
108+type CliOptions =
109+ { fix :: Boolean
110+ , listRules :: Boolean
111+ , initConfig :: Boolean
112+ , paths :: Array String
113+ }
114+
115+-- | All available rules (81 total)
116+allRules :: Array Rule
117+allRules =
118+ [ alternativeLawRule
119+ , booleanSimplifyRule
120+ , collapseLambdasRule
121+ , concatMapRule
122+ , etaReduceRule
123+ , etaReduceDeclRule
124+ , evaluateBoolRule
125+ , evaluateConstRule
126+ , evaluateEitherRule
127+ , evaluateFstRule
128+ , mapIdentityRule
129+ , functorLawRule
130+ , letToDoRule
131+ , letToWhereRule
132+ , mapFusionRule
133+ , monadLawRule
134+ , monoidIdentityRule
135+ , notEqualRule
136+ , nothingBindRule
137+ , redundantBindRule
138+ , redundantFlipRule
139+ , redundantGuardRule
140+ , redundantIdRule
141+ , redundantIfRule
142+ , redundantNegateRule
143+ , redundantNotRule
144+ , redundantParensRule
145+ , redundantReverseRule
146+ , unlessNotRule
147+ , useAllRule
148+ , useAndRule
149+ , useAnyRule
150+ , useApplicativeRule
151+ , useApplyFlippedRule
152+ , useBimapRule
153+ , useBindFlipRule
154+ , useBreakRule
155+ , useComparingRule
156+ , useConstRule
157+ , useDollarRule
158+ , useEitherMapRule
159+ , useElemIndexRule
160+ , useFindMapRule
161+ , useFoldRule
162+ , useFoldBoolRule
163+ , useFoldMapRule
164+ , useFoldMapIdRule
165+ , useForRule
166+ , useFromJustRule
167+ , useFromMaybeRule
168+ , useFstSndRule
169+ , useGuardRule
170+ , useGuardMaybeRule
171+ , useHeadRule
172+ , useIsJustRule
173+ , useIsNothingRule
174+ , useJoinRule
175+ , useLastReverseRule
176+ , useMapMaybeRule
177+ , useMaybeMapRule
178+ , useMinMaxRule
179+ , useMinimumSortRule
180+ , useNotElemRule
181+ , useNullRule
182+ , useOnRule
183+ , useOrRule
184+ , usePatternGuardsRule
185+ , useCaseOfRule
186+ , flattenCaseRule
187+ , useReplicateRule
188+ , useSequenceRule
189+ , useSpanRule
190+ , useTraverseRule
191+ , useTraverseSequenceRule
192+ , useUncurryRule
193+ , useUnlessRule
194+ , useUnwrapRule
195+ , useVoidRule
196+ , useWhenRule
197+ , useZipRule
198+ , whenNotRule
199+ ]
200+
201+-- | Load config from .purslintrc file
202+loadConfig :: Effect _
203+loadConfig = do
204+ hasConfig <- FS.exists ".purslintrc"
205+ if hasConfig then do
206+ content <- FS.readTextFile ".purslintrc"
207+ pure $ parseConfig content
208+ else
209+ pure defaultConfig
210+
211+-- | Format a source range for display
212+formatRange :: { start :: { line :: Int, column :: Int }, end :: { line :: Int, column :: Int } } -> String
213+formatRange r = show (r.start.line + 1) <> ":" <> show (r.start.column + 1) <> "-" <> show (r.end.line + 1) <> ":" <> show (r.end.column + 1)
214+
215+-- | Format severity for display
216+formatSeverity :: Severity -> String
217+formatSeverity Refactor = "[refactor]"
218+formatSeverity Hint = "[hint]"
219+formatSeverity Warning = "[warning]"
220+formatSeverity Error = "[error]"
221+
222+-- | Format a single warning for display
223+formatWarning :: String -> LintWarning -> String
224+formatWarning filePath (LintWarning w) =
225+ filePath <> ":" <> formatRange w.range <> " " <> formatSeverity w.severity <> " " <> unwrap w.ruleId <> ": " <> unwrap w.message <>
226+ case w.suggestion of
227+ Nothing -> ""
228+ Just (Suggestion s) -> "\n Replace with: " <> unwrap s.replacement
229+
230+-- | Lint a single file with config
231+lintFileWithConfig :: Array Rule -> String -> Effect Int
232+lintFileWithConfig rules filePath = do
233+ content <- FS.readTextFile filePath
234+ case runRules rules (SourceCode content) of
235+ Left err -> do
236+ log $ filePath <> ": " <> err
237+ pure 0
238+ Right (LintResult result) -> do
239+ for_ result.warnings \w -> do
240+ log $ formatWarning filePath w
241+ pure (Array.length result.warnings)
242+
243+-- | Fix a single file
244+fixFile :: Array Rule -> String -> Effect Int
245+fixFile rules filePath = do
246+ content <- FS.readTextFile filePath
247+ case runRules rules (SourceCode content) of
248+ Left err -> do
249+ log $ filePath <> ": " <> err
250+ pure 0
251+ Right result@(LintResult r) -> do
252+ let fixedContent = applyAllFixes content result
253+ when (fixedContent /= content) do
254+ FS.writeTextFile filePath fixedContent
255+ log $ filePath <> ": fixed " <> show (Array.length r.warnings) <> " issue(s)"
256+ pure (Array.length r.warnings)
257+
258+-- | Recursively find all .purs files in a directory
259+findPursFiles :: String -> Effect (Array String)
260+findPursFiles dir = do
261+ entries <- FS.readdir dir
262+ files <- Array.foldM (collectFiles dir) [] entries
263+ pure files
264+ where
265+ collectFiles :: String -> Array String -> String -> Effect (Array String)
266+ collectFiles parentDir acc entry = do
267+ let path = parentDir <> "/" <> entry
268+ -- Skip hidden directories and node_modules
269+ if String.take 1 entry == "." || entry == "node_modules" || entry == ".spago" then
270+ pure acc
271+ else do
272+ stats <- FS.stat path
273+ if stats.isDirectory then do
274+ subFiles <- findPursFiles path
275+ pure (acc <> subFiles)
276+ else if String.takeRight 5 entry == ".purs" then
277+ pure (Array.snoc acc path)
278+ else
279+ pure acc
280+
281+-- | Lint a file or directory with config
282+lintPathWithConfig :: Array Rule -> String -> Effect Int
283+lintPathWithConfig rules path = do
284+ stats <- FS.stat path
285+ if stats.isDirectory then do
286+ files <- findPursFiles path
287+ counts <- Array.foldM (\acc file -> do
288+ count <- lintFileWithConfig rules file
289+ pure (acc + count)) 0 files
290+ pure counts
291+ else
292+ lintFileWithConfig rules path
293+
294+-- | Fix a file or directory
295+fixPath :: Array Rule -> String -> Effect Int
296+fixPath rules path = do
297+ stats <- FS.stat path
298+ if stats.isDirectory then do
299+ files <- findPursFiles path
300+ counts <- Array.foldM (\acc file -> do
301+ count <- fixFile rules file
302+ pure (acc + count)) 0 files
303+ pure counts
304+ else
305+ fixFile rules path
306+
307+-- | Show usage
308+showUsage :: Effect Unit
309+showUsage = do
310+ log "purslint - a linter for PureScript (81 rules)"
311+ log ""
312+ log "Usage: purslint [OPTIONS] [FILES/DIRECTORIES...]"
313+ log ""
314+ log "Options:"
315+ log " --help Show this help"
316+ log " --fix Auto-fix issues (where possible)"
317+ log " --init Create a sample .purslintrc"
318+ log " --list List all available rules"
319+ log ""
320+ log "Configuration:"
321+ log " Create .purslintrc in your project root to disable rules."
322+ log " Add one rule name per line (lines starting with # are comments)."
323+ log ""
324+ log "Examples:"
325+ log " purslint src/ Lint all .purs files in src/"
326+ log " purslint --fix src/ Auto-fix issues in src/"
327+ log " purslint src/Main.purs Lint a single file"
328+
329+-- | List all available rules
330+listRules :: Effect Unit
331+listRules = do
332+ log $ "Available rules (" <> show (Array.length allRules) <> " total):"
333+ log ""
334+ for_ allRules \rule -> do
335+ log $ " " <> unwrap rule.ruleId
336+
337+-- | Create sample config file
338+initConfig :: Effect Unit
339+initConfig = do
340+ hasConfig <- FS.exists ".purslintrc"
341+ if hasConfig then
342+ log ".purslintrc already exists"
343+ else do
344+ let sampleConfig = """# purslint configuration
345+# Add rule names (one per line) to disable them
346+# Example:
347+# EtaReduce
348+# LetToWhere
349+"""
350+ FS.writeTextFile ".purslintrc" sampleConfig
351+ log "Created .purslintrc"
352+
353+parseFlags :: Array String -> Effect (Maybe CliOptions)
354+parseFlags args = case parseFlags' (Array.drop 2 args) of
355+ Success cli -> pure (Just cli)
356+ Failure (ParserFailure pf) -> case pf programName of
357+ ph@(ParserHelp _) /\ exitCode /\ i /\ _unit -> do
358+ log $ renderHelp i ph
359+ Process.exit (fromEnum exitCode)
360+ pure Nothing
361+ CompletionInvoked (CompletionResult { execCompletion }) -> do
362+ executedCompletion <- execCompletion programName
363+ log executedCompletion
364+ Process.exit 0
365+ pure Nothing
366+ where
367+ programName = "purslint"
368+
369+parseFlags' :: Array String -> ParserResult CliOptions
370+parseFlags' = execParserPure defaultPrefs opts
371+ where
372+ opts =
373+ info (flagsParser <**> helper) $
374+ fullDesc
375+ <> progDesc "Lint PureScript source files"
376+ <> header "purslint - a linter for PureScript"
377+
378+flagsParser :: Parser CliOptions
379+flagsParser = ado
380+ fix <- switch $ long "fix" <> help "Auto-fix issues (where possible)"
381+ listRules <- switch $ long "list" <> help "List all available rules"
382+ initConfig <- switch $ long "init" <> help "Create a sample .purslintrc"
383+ pathsList <- many $ argument str $ metavar "PATH..."
384+ let paths = Array.fromFoldable pathsList
385+ in { fix, listRules, initConfig, paths }
386+
387+main :: Effect Unit
388+main = do
389+ args <- Process.argv
390+ maybeCli <- parseFlags args
391+ case maybeCli of
392+ Nothing -> pure unit
393+ Just cli ->
394+ if cli.listRules then
395+ listRules
396+ else if cli.initConfig then
397+ initConfig
398+ else if Array.null cli.paths then
399+ showUsage
400+ else do
401+ -- Load config and filter rules
402+ config <- loadConfig
403+ let enabledRules = filterRules allRules config
404+
405+ if cli.fix then do
406+ -- Fix mode
407+ _ <- Array.foldM (\acc path -> do
408+ count <- fixPath enabledRules path
409+ pure (acc + count)) 0 cli.paths
410+ pure unit
411+ else do
412+ -- Lint mode
413+ totalWarnings <- Array.foldM (\acc path -> do
414+ count <- lintPathWithConfig enabledRules path
415+ pure (acc + count)) 0 cli.paths
416+ when (totalWarnings > 0) do
417+ log ""
418+ log $ "Total: " <> show totalWarnings <> " warning" <> if totalWarnings == 1 then "" else "s"
419+ Process.exit 1