content: -- 
  -- Copyright (c) 2005 Don Stewart - http://www.cse.unsw.edu.au/~dons
  -- 
  -- This program is free software; you can redistribute it and/or
  -- modify it under the terms of the GNU General Public License as
  -- published by the Free Software Foundation; either version 2 of
  -- the License, or (at your option) any later version.
  -- 
  -- This program is distributed in the hope that it will be useful,
  -- but WITHOUT ANY WARRANTY; without even the implied warranty of
  -- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
  -- General Public License for more details.
  -- 
  -- You should have received a copy of the GNU General Public License
  -- along with this program; if not, write to the Free Software
  -- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  -- 02111-1307, USA.
  -- 
  
  --
  -- | Useful string functions for command line scripting in h4sh.  Some
  -- functions taken from MissingH <http://quux.org/devel/missingh/>, and
  -- postings to the Haskell mailing lists. @breakAll@ and @tokens@ are
  -- courtesy Simon Marlow. 
  --
  
  module H4SH.List (
          breakAll,       -- :: (a -> Bool) -> [a] -> [[a]]
          tokens,         -- :: (a -> Bool) -> [a] -> [[a]]
          matches,        -- :: String -> String -> Bool
          snoc,           -- :: a -> [a] -> [a]
          split,          -- :: Eq a => [a] -> [a] -> [[a]]
          replace,        -- :: Eq a => [a] -> [a] -> [a] -> [a]
          joinBy,         -- :: [a] -> [[a]] -> [a]
          contains,       -- :: [a] -> [a] -> Bool
          breakList,      -- :: ([a] -> Bool) -> [a] -> ([a], [a])
          spanList,       -- :: ([a] -> Bool) -> [a] -> ([a], [a])
          takeWhileList,  -- :: ([a] -> Bool) -> [a] -> [a]
          dropWhileList,  -- :: ([a] -> Bool) -> [a] -> [a]
  
          (</>), (<.>), (<+>), (<>),
  
          basename,       -- :: FilePath -> FilePath
          dirname,        -- :: FilePath -> FilePath
    ) where
  
  import Data.List
  import Data.Maybe
  import Text.Regex
  
  ------------------------------------------------------------------------
  
  -- | Splits a list into components delimited by separators, where the
  -- predicate returns True for a separator element.  The resulting
  -- components do not contain the separators.  Two adjacent separators
  -- result in an empty component in the output.  eg.
  --
  -- @
  --   > breakAll (=='a') "aabbaca"
  --   ["","","bb","c",""]
  -- @
  breakAll :: (a -> Bool) -> [a] -> [[a]]
  breakAll p s = case rest of
                  []     -> [chunk]
                  _:rest -> chunk : breakAll p rest
    where (chunk, rest) = break p s
  
  -- | Like 'breakAll', except that sequences of adjacent separators are
  -- treated as a single separator. eg.
  -- 
  -- @
  --   > tokens (=='a') "aabbaca"
  --   ["bb","c"]
  -- @
  tokens :: (a -> Bool) -> [a] -> [[a]]
  tokens p = filter (not.null) . breakAll p
  
  ------------------------------------------------------------------------
  
  -- | Return True if a regular expression matches a String. Useful in
  -- list functions that take a predicate. eg.
  --
  -- @
  --   > filter (matches "aabb")
  -- @
  matches :: String -> String -> Bool
  matches p s = isJust (matchRegex (mkRegex p) s)
  
  -- | Reverse cons. Add an element to the back of a list. Example:
  --
  -- @
  -- > snoc 3 [2, 1] ===> [2, 1, 3]
  -- @
  snoc :: a -> [a] -> [a]
  snoc x xs = xs ++ [x]
  
  ------------------------------------------------------------------------
  
  -- | Given a delimiter and a list (or string), split into components.
  --Example:
  --
  -- @
  --  > split "," "foo,bar,,baz," -> ["foo", "bar", "", "baz", ""]
  --  > split "ba" ",foo,bar,,baz," -> [",foo,","r,,","z,"]
  -- @
  split :: Eq a => [a] -> [a] -> [[a]]
  split _ [] = []
  split delim str =
      let (firstline, remainder) = breakList (isPrefixOf delim) str
          in 
          firstline : case remainder of
                                     [] -> []
                                     x -> if x == delim
                                          then [] : []
                                          else split delim 
                                                   (drop (length delim) x)
  
  -- | Given a list and a replacement list, replaces each occurance of the search
  -- list with the replacement list in the operation list. Example:
  --
  -- @
  --  > replace "," "." "127,0,0,1" -> "127.0.0.1"
  -- @
  replace :: Eq a => [a] -> [a] -> [a] -> [a]
  replace old new l = joinBy new . split old $ l
  
  -- | Given a delimiter and a list of items (or strings), join the items
  -- by using the delimiter. Example:
  --
  -- @
  --  > joinBy "|" ["foo", "bar", "baz"] -> "foo|bar|baz"
  -- @
  joinBy :: [a] -> [[a]] -> [a]
  joinBy delim l = concat (intersperse delim l)
  
  -- | Returns true if the given parameter is a sublist of the given list;
  -- false otherwise. Example:
  --
  -- @
  --  > contains "Haskell" "I really like Haskell." -> True
  --  > contains "Haskell" "OCaml is great." -> False
  -- @
  contains :: Eq a => [a] -> [a] -> Bool
  contains [] _ = True                    -- Sub is empty; matches anything
  contains _ [] = False                   -- List is empty; matches nothing
  contains sub searchlist =
      let testlist = take (length sub) searchlist
          in
          case sub == testlist of
                               True -> True
                               False -> contains sub (tail searchlist)
  
  
  -- | Similar to Data.List.break, but performs the test on the entire remaining
  -- list instead of just one element.
  --
  breakList :: ([a] -> Bool) -> [a] -> ([a], [a])
  breakList func = spanList (not . func)
  
  -- | Similar to Data.List.span, but performs the test on the entire remaining
  -- list instead of just one element. 
  --
  -- @spanList p xs@ is the same as @(takeWhileList p xs, dropWhileList p xs)@ 
  --
  spanList :: ([a] -> Bool) -> [a] -> ([a], [a])
  spanList p xs = (takeWhileList p xs, dropWhileList p xs)
  
  -- | Similar to Data.List.takeWhile, takes elements while the func is true.
  -- The function is given the remainder of the list to examine.
  takeWhileList :: ([a] -> Bool) -> [a] -> [a]
  takeWhileList _ [] = []
  takeWhileList func list@(x:xs) =
      if func list 
         then x : takeWhileList func xs
         else []
  
  -- | Similar to Data.List.dropWhile, drops elements while the func is true.
  -- The function is given the remainder of the list to examine.
  dropWhileList :: ([a] -> Bool) -> [a] -> [a]
  dropWhileList _ [] = []
  dropWhileList func list@(x:xs) =
      if func list
         then dropWhileList func xs
         else list
  
  ------------------------------------------------------------------------
  
  infixr 6 </>
  infixr 6 <.>
  infixr 6 <+>
  infixr 6 <>
  
  --
  -- | </>, <.>, <+>, <> : join Strings with various delimiters
  --
  (</>), (<.>), (<+>), (<>) :: FilePath -> FilePath -> FilePath
  [] </> b = b
  a  </> b = a ++ "/" ++ b
  
  [] <.> b = b
  a  <.> b = a ++ "." ++ b
  
  [] <+> b = b
  a  <+> b = a ++ " " ++ b
  
  [] <> b = b
  a  <> b = a ++ b
  
  -- | Drop path component from FilePath
  -- @
  -- > basename "/f/g/h/i.hs" == "i.hs"
  -- > basename "i.hs"        == "i.hs"
  -- @
  basename :: FilePath -> FilePath
  basename p =
      let x = findIndices (== '\\') p
          y = findIndices (== '/') p
      in
      if not $ null x
        then if not $ null y
            then if (maximum x) > (maximum y) then basename' '\\' p else basename' '/' p
            else basename' '\\' p
        else basename' '/' p
      where
          basename' chara pa = reverse $ takeWhile (/= chara) $ reverse pa
  
  -- | Drop file name from path
  -- @
  -- > dirname ""            == ""
  -- > dirname "a.hs"        == "a.hs"
  -- > dirname "/f/g/h/a.hs" == "/f/g/h/"
  -- @
  dirname :: FilePath -> FilePath
  dirname p  =
      let x = findIndices (== '\\') p
          y = findIndices (== '/') p
      in
      if not $ null x
        then if not $ null y
            then if (maximum x) > (maximum y) then dirname' '\\' p else dirname' '/' p
            else dirname' '\\' p
        else dirname' '/' p
      where
          dirname' chara pa =
              case reverse $ dropWhile (/= chara) $ reverse pa of
                  [] -> "."
                  pa' -> pa'
  