1 -- % 2 -- % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996 3 4 -- with changes by myself (joe@informatik.uni-jena.de) 5 6 -- % 7 -- \section[Maybes]{The `Maybe' types and associated utility functions} 8 -- 9 10 11 module Maybes ( 12 13 exists, the, -- this is missing in 1.4 ? 14 15 16 -- Maybe(..), -- no, it's in 1.3 17 MaybeErr(..), 18 19 allMaybes, 20 firstJust, 21 expectJust, 22 maybeToBool, 23 24 assocMaybe, 25 mkLookupFun, mkLookupFunDef, 26 27 failMaB, 28 failMaybe, 29 seqMaybe, 30 returnMaB, 31 returnMaybe, 32 thenMaB 33 34 35 36 , findJust 37 , foldlMaybeErrs 38 , listMaybeErrs 39 40 ) where 41 42 43 -- import Maybe -- renamer will tell us if there are any conflicts 44 45 46 exists = maybeToBool 47 48 the (Just x) = x; the Nothing = error "the" 49 50 -- 51 -- 52 -- %************************************************************************ 53 -- %* * 54 -- \subsection[Maybe type]{The @Maybe@ type} 55 -- %* * 56 -- %************************************************************************ 57 -- 58 maybeToBool :: Maybe a -> Bool 59 maybeToBool Nothing = False 60 maybeToBool (Just x) = True 61 -- 62 -- @catMaybes@ takes a list of @Maybe@s and returns a list of 63 -- the contents of all the @Just@s in it. @allMaybes@ collects 64 -- a list of @Justs@ into a single @Just@, returning @Nothing@ if there 65 -- are any @Nothings@. 66 -- 67 68 69 allMaybes :: [Maybe a] -> Maybe [a] 70 allMaybes [] = Just [] 71 allMaybes (Nothing : ms) = Nothing 72 allMaybes (Just x : ms) = case (allMaybes ms) of 73 Nothing -> Nothing 74 Just xs -> Just (x:xs) 75 -- 76 -- @firstJust@ takes a list of @Maybes@ and returns the 77 -- first @Just@ if there is one, or @Nothing@ otherwise. 78 -- 79 firstJust :: [Maybe a] -> Maybe a 80 firstJust [] = Nothing 81 firstJust (Just x : ms) = Just x 82 firstJust (Nothing : ms) = firstJust ms 83 -- 84 findJust :: (a -> Maybe b) -> [a] -> Maybe b 85 findJust f [] = Nothing 86 findJust f (a:as) = case f a of 87 Nothing -> findJust f as 88 b -> b 89 -- 90 expectJust :: String -> Maybe a -> a 91 {- not # INLINE expectJust #-} 92 expectJust err (Just x) = x 93 expectJust err Nothing = error ("expectJust " ++ err) 94 -- 95 -- The Maybe monad 96 -- ~~~~~~~~~~~~~~~ 97 seqMaybe :: Maybe a -> Maybe a -> Maybe a 98 seqMaybe (Just x) _ = Just x 99 seqMaybe Nothing my = my 100 101 returnMaybe :: a -> Maybe a 102 returnMaybe = Just 103 104 failMaybe :: Maybe a 105 failMaybe = Nothing 106 -- 107 -- Lookup functions 108 -- ~~~~~~~~~~~~~~~~ 109 -- 110 -- @assocMaybe@ looks up in an assocation list, returning 111 -- @Nothing@ if it fails. 112 -- 113 assocMaybe :: (Eq a) => [(a,b)] -> a -> Maybe b 114 115 assocMaybe alist key 116 = lookup alist 117 where 118 lookup [] = Nothing 119 lookup ((tv,ty):rest) = if key == tv then Just ty else lookup rest 120 121 122 -- 123 -- @mkLookupFun eq alist@ is a function which looks up 124 -- its argument in the association list @alist@, returning a Maybe type. 125 -- @mkLookupFunDef@ is similar except that it is given a value to return 126 -- on failure. 127 -- 128 mkLookupFun :: (key -> key -> Bool) -- Equality predicate 129 -> [(key,val)] -- The assoc list 130 -> key -- The key 131 -> Maybe val -- The corresponding value 132 133 mkLookupFun eq alist s 134 = case [a | (s',a) <- alist, s' `eq` s] of 135 [] -> Nothing 136 (a:_) -> Just a 137 138 mkLookupFunDef :: (key -> key -> Bool) -- Equality predicate 139 -> [(key,val)] -- The assoc list 140 -> val -- Value to return on failure 141 -> key -- The key 142 -> val -- The corresponding value 143 144 mkLookupFunDef eq alist deflt s 145 = case [a | (s',a) <- alist, s' `eq` s] of 146 [] -> deflt 147 (a:_) -> a 148 -- 149 -- %************************************************************************ 150 -- %* * 151 -- \subsection[MaybeErr type]{The @MaybeErr@ type} 152 -- %* * 153 -- %************************************************************************ 154 -- 155 data MaybeErr val err = Succeeded val | Failed err 156 -- 157 thenMaB :: MaybeErr val1 err -> (val1 -> MaybeErr val2 err) -> MaybeErr val2 err 158 thenMaB m k 159 = case m of 160 Succeeded v -> k v 161 Failed e -> Failed e 162 163 returnMaB :: val -> MaybeErr val err 164 returnMaB v = Succeeded v 165 166 failMaB :: err -> MaybeErr val err 167 failMaB e = Failed e 168 -- 169 -- 170 -- @listMaybeErrs@ takes a list of @MaybeErrs@ and, if they all succeed, returns 171 -- a @Succeeded@ of a list of their values. If any fail, it returns a 172 -- @Failed@ of the list of all the errors in the list. 173 -- 174 listMaybeErrs :: [MaybeErr val err] -> MaybeErr [val] [err] 175 listMaybeErrs 176 = foldr combine (Succeeded []) 177 where 178 combine (Succeeded v) (Succeeded vs) = Succeeded (v:vs) 179 combine (Failed err) (Succeeded _) = Failed [err] 180 combine (Succeeded v) (Failed errs) = Failed errs 181 combine (Failed err) (Failed errs) = Failed (err:errs) 182 -- 183 -- @foldlMaybeErrs@ works along a list, carrying an accumulator; it 184 -- applies the given function to the accumulator and the next list item, 185 -- accumulating any errors that occur. 186 -- 187 foldlMaybeErrs :: (acc -> input -> MaybeErr acc err) 188 -> acc 189 -> [input] 190 -> MaybeErr acc [err] 191 192 foldlMaybeErrs k accum ins = do_it [] accum ins 193 where 194 do_it [] acc [] = Succeeded acc 195 do_it errs acc [] = Failed errs 196 do_it errs acc (v:vs) = case (k acc v) of 197 Succeeded acc' -> do_it errs acc' vs 198 Failed err -> do_it (err:errs) acc vs