Skip to content

Commit 3bd755c

Browse files
author
Thomas Bleher
committed
lint: set exit code if any lint check triggers
This makes it easier to use `tttool lint` in scripts.
1 parent 5ad1912 commit 3bd755c

File tree

2 files changed

+18
-6
lines changed

2 files changed

+18
-6
lines changed

Diff for: src/Commands.hs

+2-1
Original file line numberDiff line numberDiff line change
@@ -133,7 +133,8 @@ dumpInfo conf file = do
133133
lint :: FilePath -> IO ()
134134
lint file = do
135135
(tt,segments) <- parseTipToiFile <$> B.readFile file
136-
lintTipToi tt segments
136+
result <- lintTipToi tt segments
137+
when (result == False) exitFailure
137138

138139
play :: Conf -> FilePath -> IO ()
139140
play conf file = do

Diff for: src/Lint.hs

+16-5
Original file line numberDiff line numberDiff line change
@@ -8,23 +8,31 @@ import qualified Data.Map as M
88
import Types
99
import PrettyPrint
1010

11-
lintTipToi :: TipToiFile -> Segments -> IO ()
11+
lintTipToi :: TipToiFile -> Segments -> IO (Bool)
1212
lintTipToi tt segments = do
1313
let hyps = [ (hyp1, "play indicies are correct")
1414
, (hyp2, "media indicies are correct")
1515
, (hyp3, "at most one jump per line, as last action")
1616
]
17-
forM_ hyps $ \(hyp, desc) -> do
17+
hyp_result <- forM hyps $ \(hyp, desc) -> do
1818
let wrong = filter (not . hyp) (concat (mapMaybe snd (ttScripts tt)))
1919
if null wrong
20-
then printf "All lines do satisfy hypothesis \"%s\"!\n" desc
20+
then do
21+
printf "All lines do satisfy hypothesis \"%s\"!\n" desc
22+
return True
2123
else do
2224
printf "These lines do not satisfy hypothesis \"%s\":\n" desc
2325
forM_ wrong $ \line -> do
2426
printf " %s\n" (ppLine M.empty line)
27+
return False
2528

26-
forM_ (fromMaybe [] (ttMediaFlags tt)) $ \f ->
27-
when (f > 1) $ printf "Media flag >1: %d" f
29+
media_result <- forM (fromMaybe [] (ttMediaFlags tt)) $ \f ->
30+
if (f > 1)
31+
then do
32+
printf "Media flag >1: %d" f
33+
return False
34+
else do
35+
return True
2836

2937
let overlapping_segments =
3038
filter (\((o1,l1,_),(o2,l2,_)) -> o1+l1 > o2) $
@@ -33,6 +41,9 @@ lintTipToi tt segments = do
3341
printf "Overlapping segments: %d\n"
3442
(length overlapping_segments)
3543
mapM_ (uncurry report) overlapping_segments
44+
45+
let no_failures = (all (==True)) $ (hyp_result ++ media_result ++ [null overlapping_segments])
46+
return no_failures
3647
where
3748
hyp1 :: Line ResReg -> Bool
3849
hyp1 (Line _ _ as mi) = all ok as

0 commit comments

Comments
 (0)