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