Utils.hs revision b4fbc96e05117839ca409f5f20f97b3ac872d1ed
f0aad5341752aefe5059832f6cf3abc3283c6e16Tinderbox UserModule : $Header$
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsCopyright : (c) Klaus L�ttich, Uni Bremen 2002-2004
5347c0fcb04eaea19d9f39795646239f487c6207Tinderbox UserLicence : similar to LGPL, see HetCATS/LICENCE.txt or LIZENZ.txt
5347c0fcb04eaea19d9f39795646239f487c6207Tinderbox UserMaintainer : luettich@tzi.de
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsStability : provisional
d6fa26d0adaec6c910115be34fe7a5a5f402c14fMark AndrewsPortability : portable
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews Useful functions that can't be found in the libraries.
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews But should shared across HetCATS.
cd32f419a8a5432fbb139f56ee73cbf68b9350ccTinderbox User - Add your own functions.
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews A function inspired by perls join function. It joins a list of
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews lists of elements by seperating them with a seperator element.
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsjoinWith :: a -- ^ seperator element
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews -> [[a]] -- ^ list of lists of elements
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsjoinWith sep = concat . intersperse (sep:[])
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews A function inspired by the perl function split. A list is splitted
fd2597f75693a2279fdf588bd40dfe2407c42028Tinderbox User on a seperator element in smaller lists. The seperator element is
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews dropped from the resulting list.
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsersplitOn :: Eq a => a -- ^ seperator
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User -> [a] -- ^ list to split
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsersplitOn sep = (\(f,r) -> f : case r of
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User _ -> (splitOn sep $ tail r)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User ) . break ((==) sep)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User A function inspired by a perl function from the standard perl-module
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User File::Basename. It removes the directory part of a filepath.
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrewsbasename :: FilePath -> FilePath
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox Userbasename fp = (\(_path,basen) -> basen) (stripDir fp)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User A function inspired by a perl function from the standard perl-module
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User File::Basename. It gives the directory part of a filepath.
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox Userdirname :: FilePath -> FilePath
ea640e04eae220b5e569f188563eb1f204c7c77eTinderbox Userdirname fp = (\(path,_basen) -> path) (stripDir fp)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User A function inspired by a perl function from the standard perl-module
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User File::Basename. It splits a filepath into the basename, the
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User directory and gives the suffix that matched from the list of
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User suffixes. If a suffix matched it is removed from the basename.
7e71f05d8643aca84914437c900cb716444507e4Tinderbox Userfileparse :: [String] -- ^ list of suffixes
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User -> (FilePath,FilePath,Maybe String)
d856585f5fe37cc2ea82115c10339578d2b517b1Automatic Updater -- ^ (basename,directory,matched suffix)
14a656f94b1fd0ababd84a772228dfa52276ba15Evan Huntfileparse sufs fp = let (path,base) = stripDir fp
d856585f5fe37cc2ea82115c10339578d2b517b1Automatic Updater (base',suf) = stripSuffix sufs base
d856585f5fe37cc2ea82115c10339578d2b517b1Automatic Updater in (base',path,suf)
d856585f5fe37cc2ea82115c10339578d2b517b1Automatic UpdaterstripDir :: FilePath -> (FilePath,FilePath)
14a656f94b1fd0ababd84a772228dfa52276ba15Evan Hunt (\(x,y) -> (if not (null y) then reverse y else "./", reverse x))
d856585f5fe37cc2ea82115c10339578d2b517b1Automatic Updater (break (== '/') (reverse fp))
14a656f94b1fd0ababd84a772228dfa52276ba15Evan HuntrmSuffix :: String -> String
14a656f94b1fd0ababd84a772228dfa52276ba15Evan HuntrmSuffix = reverse . tail . snd . break (=='.') . reverse
14a656f94b1fd0ababd84a772228dfa52276ba15Evan HuntstripSuffix :: [String] -> FilePath -> (FilePath,Maybe String)
d856585f5fe37cc2ea82115c10339578d2b517b1Automatic UpdaterstripSuffix suf fp = case filter justs $ map (stripSuf fp) suf of
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews ((Just (x,s)):_) -> (x,Just s)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User _ -> (fp, Nothing)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User where stripSuf f s | s `isSuffixOf` f = Just (stripOf s f, s)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User | otherwise = Nothing
7e71f05d8643aca84914437c900cb716444507e4Tinderbox User justs (Nothing) = False
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User justs (Just _) = True
f7b41fd9291b8f4dba27e2b57e1d93f0913a4f1dMark AndrewsstripOf :: (Show a, Eq a) => [a] -> [a] -> [a]
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UserstripOf suf inp = reverse $ stripOf' (reverse suf) (reverse inp)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User where stripOf' [] i = i
f7b41fd9291b8f4dba27e2b57e1d93f0913a4f1dMark Andrews stripOf' (_:_) [] = error $
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User concat ["suffix is longer than input string\n"
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User ,"input was: ", show suf, " ",show inp ]
ea640e04eae220b5e569f188563eb1f204c7c77eTinderbox User stripOf' (x:xs) (y:ys) | x == y = stripOf' xs ys
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User | otherwise =
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User error $ concat ["suffix don't match input"
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User ,show $ reverse (x:xs)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User ," ",show $ reverse (y:ys)]
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- stripOf suf = reverse . drop (length suf) . reverse
ea640e04eae220b5e569f188563eb1f204c7c77eTinderbox User-- like the chomp from Perl
ea640e04eae220b5e569f188563eb1f204c7c77eTinderbox User-- but this chomp removes trailing newlines AND trailing spaces if any
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox Userchomp :: String -> String
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox Userchomp = reverse . chomp' . reverse
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews where chomp' [] = []
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User chomp' xs@(x:xs') | x == '\n' || x == ' ' = chomp' xs'
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User | otherwise = xs
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews-- IgnoreMaybe datatype
14a656f94b1fd0ababd84a772228dfa52276ba15Evan Hunt-- extension to Maybe for use in computations over recursive types
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- that need a "don't care" result
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews-- RealJust a means result a was computed
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- RealNothing means computation failed
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- IgnoreNothing means the rest of the computation should not be
14a656f94b1fd0ababd84a772228dfa52276ba15Evan Hunt-- influenced by this result
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox Userdata IgnoreMaybe a = RealJust a
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User | RealNothing
990d0e893f5b70e735cdf990af66e9ec6e91fa78Tinderbox User | IgnoreNothing
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- drop IgnoreNothing from a list to get Maybe list
990d0e893f5b70e735cdf990af66e9ec6e91fa78Tinderbox UserdropIgnore :: [IgnoreMaybe a] -> [Maybe a]
990d0e893f5b70e735cdf990af66e9ec6e91fa78Tinderbox UserdropIgnore [] = []
990d0e893f5b70e735cdf990af66e9ec6e91fa78Tinderbox UserdropIgnore ((RealJust x):t) = (Just x):(dropIgnore t)
990d0e893f5b70e735cdf990af66e9ec6e91fa78Tinderbox UserdropIgnore (RealNothing:t) = Nothing:(dropIgnore t)
990d0e893f5b70e735cdf990af66e9ec6e91fa78Tinderbox UserdropIgnore (IgnoreNothing:t) = dropIgnore t
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- convert from Maybe to IgnoreMaybe
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewstoIgnore :: Maybe a -> IgnoreMaybe a
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsertoIgnore (Just x) = RealJust x
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsertoIgnore _ = RealNothing
d71e2e0c61df16ff37c9934c371a4a60c08974f7Mark Andrews-- convert from IgnoreMaybe to Maybe
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- IgnoreNothing is propagated (wrt to the meaning given above) to Nothing
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewstoMaybe :: IgnoreMaybe a -> Maybe a
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsertoMaybe (RealJust x) = Just x
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsertoMaybe _ = Nothing
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews-- map over IgnoreMaybe taking (Maybe a -> b) function
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsermapIgnore :: (Maybe a -> b) -> [IgnoreMaybe a] -> [b]
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsmapIgnore _ [] = []
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsermapIgnore f (IgnoreNothing:t) = mapIgnore f t
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsermapIgnore f (h:t) = (f $ toMaybe h):(mapIgnore f t)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- map over IgnoreMaybe taking (a -> b) function
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsermapIgnoreMaybe :: (a -> b) -> [IgnoreMaybe a] -> [b]
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsermapIgnoreMaybe _ [] = []
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsmapIgnoreMaybe f (RealJust x:t) = (f x):(mapIgnoreMaybe f t)
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsmapIgnoreMaybe f (_:t) = mapIgnoreMaybe f t
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- add element to list as if it were a set
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- addition is to the front if element wasn't already in the list, in which
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- case the list is not modified
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsersetAddOne :: Eq a => [a] -> a -> [a]
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsersetAddOne set x = if (x `elem` set) then set else (x:set)
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- concat two lists as if they were sets
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- adds each element from the second list using setAddOne
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox UsersetAdd :: Eq a => [a] -> [a] -> [a]
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewssetAdd set add = foldl setAddOne set add
7911e6f9de303bca5a3d8b34f4330c8f7cecffaeTinderbox User-- find out whether all the elements of a list occur only once
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsallUnique :: Eq a => [a] -> Bool
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsallUnique [] = False
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsallUnique [_] = True
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsallUnique (h:t) = ([ x | x<-t, x == h ]==[]) && allUnique t
14a656f94b1fd0ababd84a772228dfa52276ba15Evan Hunt-- compute members of a list occuring more than once
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsnotUnique :: Eq a => [a] -> [a]
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsnotUnique [] = []
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark AndrewsnotUnique (h:t) = let
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews diff = [ x | x<-t, x/=h ]
4abdfc917e6635a7c81d1f931a0c79227e72d025Mark Andrews rest = notUnique diff
5a4557e8de2951a2796676b5ec4b6a90caa5be14Mark Andrews case (h `elem` t) of True -> h : rest
4abdfc917e6635a7c81d1f931a0c79227e72d025Mark Andrews False -> rest