Skip to content

Commit

Permalink
lint: set exit code if any lint check triggers
Browse files Browse the repository at this point in the history
This makes it easier to use `tttool lint` in scripts.
  • Loading branch information
Thomas Bleher committed Dec 5, 2020
1 parent 002bff7 commit eb37ef7
Show file tree
Hide file tree
Showing 2 changed files with 18 additions and 6 deletions.
3 changes: 2 additions & 1 deletion src/Commands.hs
Original file line number Diff line number Diff line change
Expand Up @@ -133,7 +133,8 @@ dumpInfo conf file = do
lint :: FilePath -> IO ()
lint file = do
(tt,segments) <- parseTipToiFile <$> B.readFile file
lintTipToi tt segments
result <- lintTipToi tt segments
when (result == False) exitFailure

play :: Conf -> FilePath -> IO ()
play conf file = do
Expand Down
21 changes: 16 additions & 5 deletions src/Lint.hs
Original file line number Diff line number Diff line change
Expand Up @@ -8,23 +8,31 @@ import qualified Data.Map as M
import Types
import PrettyPrint

lintTipToi :: TipToiFile -> Segments -> IO ()
lintTipToi :: TipToiFile -> Segments -> IO (Bool)
lintTipToi tt segments = do
let hyps = [ (hyp1, "play indicies are correct")
, (hyp2, "media indicies are correct")
, (hyp3, "at most one jump per line, as last action")
]
forM_ hyps $ \(hyp, desc) -> do
hyp_result <- forM hyps $ \(hyp, desc) -> do
let wrong = filter (not . hyp) (concat (mapMaybe snd (ttScripts tt)))
if null wrong
then printf "All lines do satisfy hypothesis \"%s\"!\n" desc
then do
printf "All lines do satisfy hypothesis \"%s\"!\n" desc
return True
else do
printf "These lines do not satisfy hypothesis \"%s\":\n" desc
forM_ wrong $ \line -> do
printf " %s\n" (ppLine M.empty line)
return False

forM_ (fromMaybe [] (ttMediaFlags tt)) $ \f ->
when (f > 1) $ printf "Media flag >1: %d" f
media_result <- forM (fromMaybe [] (ttMediaFlags tt)) $ \f ->
if (f > 1)
then do
printf "Media flag >1: %d" f
return False
else do
return True

let overlapping_segments =
filter (\((o1,l1,_),(o2,l2,_)) -> o1+l1 > o2) $
Expand All @@ -33,6 +41,9 @@ lintTipToi tt segments = do
printf "Overlapping segments: %d\n"
(length overlapping_segments)
mapM_ (uncurry report) overlapping_segments

let no_failures = (all (==True)) $ (hyp_result ++ media_result ++ [null overlapping_segments])
return no_failures
where
hyp1 :: Line ResReg -> Bool
hyp1 (Line _ _ as mi) = all ok as
Expand Down

0 comments on commit eb37ef7

Please sign in to comment.