1{-
2    SockeyeChecks.hs: Helpers to run checks for Sockeye
3
4    Part of Sockeye
5
6    Copyright (c) 2018, ETH Zurich.
7
8    All rights reserved.
9
10    This file is distributed under the terms in the attached LICENSE file.
11    If you do not find this file, copies can be found by writing to:
12    ETH Zurich D-INFK, CAB F.78, Universitaetstrasse 6, CH-8092 Zurich,
13    Attn: Systems Group.
14-}
15
16module SockeyeChecks where
17
18import Control.Monad.Writer
19import Data.List (sortBy)
20
21import SockeyeASTMeta
22
23class CheckFailure a where
24    errorLines :: a -> [String]
25
26newtype FailedChecks f = FailedChecks [(ASTMeta,f)]
27
28instance (CheckFailure f) => Show (FailedChecks f) where
29    show (FailedChecks fs) = concat (map showFail $ sortBy failCompare fs)
30        where
31            failCompare a b = compare (fst a) (fst b)
32            showFail (m,f) = '\n':(show m) ++ '\n':(unlines $ map ("    " ++) (errorLines f))
33
34type Checks f = Writer [(ASTMeta,f)]
35
36failCheck :: ASTMeta -> f -> Checks f ()
37failCheck m f = tell [(m,f)]
38
39runChecks :: Checks f a -> Either (FailedChecks f) a
40runChecks checks =
41    let (a, fs) = runWriter checks in
42    case fs of
43        [] -> Right a
44        _  -> Left $ FailedChecks fs
45
46foldChecks :: (Foldable t) => (a -> b -> Checks f b) -> b -> t a -> Checks f b
47foldChecks fn acc as = foldl foldfn (return acc) as
48    where
49        foldfn m a = do
50            b <- m
51            fn a b
52