Sockeye: Implement module instantiator
[barrelfish] / tools / sockeye / SockeyeChecks.hs
1 {-
2     SockeyeChecks.hs: Helpers to run checks for Sockeye
3
4     Part of Sockeye
5
6     Copyright (c) 2017, 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, Universitaetstr. 6, CH-8092 Zurich,
13     Attn: Systems Group.
14 -}
15
16 module SockeyeChecks where
17
18 import Control.Monad.Writer
19
20 import Data.List (nub)
21
22 data FailedCheck t = FailedCheck
23     { inModule :: !String
24     , failed   :: t
25     }
26
27 newtype FailedChecks t = FailedChecks [FailedCheck t]
28
29 instance (Show t) => Show (FailedChecks t) where
30     show (FailedChecks fs) = 
31         let modules = nub $ map inModule fs
32         in unlines $ concat (map showFailsForModule modules)
33         where
34             showFailsForModule name =
35                 let
36                     title = "\nIn module '" ++ name ++ "':"
37                     fails = filter (\f -> name == inModule f) fs
38                 in case name of
39                     ""      -> "":showFails 0 fails
40                     ('@':_) -> "":showFails 0 fails
41                     _       -> title:showFails 1 fails
42             showFails indentLevel fs =
43                 let
44                     indent = replicate (indentLevel * 4) ' '
45                 in map ((indent ++) . showFail) fs
46             showFail f = (show $ failed f)
47
48 type Checks f = Writer [FailedCheck f]
49
50 failCheck :: String -> t -> Checks t ()
51 failCheck context f = tell [FailedCheck context f]
52
53 runChecks :: Checks f a -> Either (FailedChecks f) a
54 runChecks checks = do
55     let
56         (a, fs) = runWriter checks
57     case fs of
58         [] -> return a
59         _  -> Left $ FailedChecks fs
60
61 checkDuplicates :: (Eq a) => String  -> (a -> t) -> [a] -> (Checks t) ()
62 checkDuplicates context fail xs = do
63     let
64         ds = duplicates xs
65     case ds of
66         [] -> return ()
67         _  -> mapM_ (failCheck context . fail) ds
68     where
69         duplicates [] = []
70         duplicates (x:xs)
71             | x `elem` xs = nub $ [x] ++ duplicates xs
72             | otherwise = duplicates xs