some work on avoiding partial functions

There are still hundreds of places that use partial functions head, tail,
init, and last.
This commit is contained in:
Joey Hess 2011-12-09 18:10:41 -04:00
parent 95e748cbd4
commit 28699c95a7
4 changed files with 45 additions and 14 deletions

View file

@ -73,6 +73,6 @@ readUnusedLog prefix = do
then M.fromList . map parse . lines <$> liftIO (readFile f) then M.fromList . map parse . lines <$> liftIO (readFile f)
else return M.empty else return M.empty
where where
parse line = (num, fromJust $ readKey $ tail rest) parse line = (num, fromJust $ readKey rest)
where where
(num, rest) = break (== ' ') line (num, rest) = separate (== ' ') line

18
Git.hs
View file

@ -507,11 +507,7 @@ configStore s repo = do
configParse :: String -> M.Map String String configParse :: String -> M.Map String String
configParse s = M.fromList $ map pair $ lines s configParse s = M.fromList $ map pair $ lines s
where where
pair l = (key l, val l) pair = separate (== '=')
key l = head $ keyval l
val l = join sep $ drop 1 $ keyval l
keyval l = split sep l :: [String]
sep = "="
{- Calculates a list of a repo's configured remotes, by parsing its config. -} {- Calculates a list of a repo's configured remotes, by parsing its config. -}
configRemotes :: Repo -> IO [Repo] configRemotes :: Repo -> IO [Repo]
@ -550,13 +546,11 @@ genRemote s repo = gen $ calcloc s
scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v) scpstyle v = ":" `isInfixOf` v && not ("//" `isInfixOf` v)
scptourl v = "ssh://" ++ host ++ slash dir scptourl v = "ssh://" ++ host ++ slash dir
where where
bits = split ":" v (host, dir) = separate (== ':') v
host = head bits slash d | d == "" = "/~/" ++ d
dir = join ":" $ drop 1 bits | "/" `isPrefixOf` d = d
slash d | d == "" = "/~/" ++ dir | "~" `isPrefixOf` d = '/':d
| head d == '/' = dir | otherwise = "/~/" ++ d
| head d == '~' = '/':dir
| otherwise = "/~/" ++ dir
{- Checks if a string from git config is a true value. -} {- Checks if a string from git config is a true value. -}
configTrue :: String -> Bool configTrue :: String -> Bool

24
Utility/BadPrelude.hs Normal file
View file

@ -0,0 +1,24 @@
{- Some stuff from Prelude should not be used, as it tends to be a source
- of bugs.
-
- This exports functions that conflict with the prelude, which avoids
- them being accidentially used.
-}
module Utility.BadPrelude where
{- head is a partial function; head [] is an error -}
head :: [a] -> a
head = Prelude.head
{- tail is also partial -}
tail :: [a] -> a
tail = Prelude.tail
{- init too -}
init :: [a] -> a
init = Prelude.init
{- last too -}
last :: [a] -> a
last = Prelude.last

View file

@ -27,6 +27,19 @@ readMaybe s = case reads s of
((x,_):_) -> Just x ((x,_):_) -> Just x
_ -> Nothing _ -> Nothing
{- Like break, but the character matching the condition is not included
- in the second result list.
-
- separate (== ':') "foo:bar" = ("foo", "bar")
- separate (== ':') "foobar" = ("foo, "")
-}
separate :: (a -> Bool) -> [a] -> ([a], [a])
separate c l = unbreak $ break c l
where
unbreak r@(a, b)
| null b = r
| otherwise = (a, tail b)
{- Catches IO errors and returns a Bool -} {- Catches IO errors and returns a Bool -}
catchBoolIO :: IO Bool -> IO Bool catchBoolIO :: IO Bool -> IO Bool
catchBoolIO a = catchDefaultIO a False catchBoolIO a = catchDefaultIO a False