import Control.Monad (unless)
import Data.List (genericReplicate, intersperse, transpose)
import Numeric (showFFloat)
import System.CPUTime (getCPUTime)

import Data.List (elemIndices)

{- basename0 is short, obvious, and - as it turns out - fast! -}

basename0 = reverse . takeWhile ('/' /=) . reverse

{- basename1 is a translation of the obvious C function:

        char *basename(char *fn) {
          char *p = fn, *r = fn;

          while (*p) {
            if (*p == '/')
              r = p + 1;
            ++p;
          }
          return r;
        }

Note that C is hampered by the fact that it doesn't know how long the
string is: if basename() doesn't examine each character, it must call
strlen() which will. -}

basename1 fp = bn fp fp
    where
      bn r [] = r
      bn r (x:xs) = bn (if x == '/' then xs else r) xs

{- basename2 uses the library function elemIndices -}

basename2 fp = drop (if null is then 0 else 1 + last is) fp
    where
      is = elemIndices '/' fp

timeFunctions = [basename0, basename1, basename2]

timeArgs = ["", "/", "/foo", "/foo/bar", "/foo/bar/qux", "foobarqux",
              "///foo", "foo///bar", "///foo///bar///qux",
              "foo/bar/qux", "/1/2/3/4/5/6/7/8/9/0/1/2/3/4/5/6/7/8/0",
              "/usr/share/doc/bcel-5.0/docs/api/org/apache/bcel/verifier/exc/class-use/StaticCodeInstructionOperandConstraintException.html",
              "/usr/local/src/gtk2hs-0.9.11/gtk/Graphics/UI/Gtk/Abstract/ContainerChildProperties_split/ContainerChildProperties__14.o",
              "/etc/gconf/gconf.xml.defaults/schemas/apps/panel/default_profiles/medium/objects/wordprocessor_launcher/%gconf.xml",
              "/longlongverylongextremelylonglongerlonger/longishheretoo",
              concat (replicate 1000 "/foo"),
              concat (replicate 1000 "bar"),
              concat (replicate 33 ("/" ++ concat (replicate 33 "qux"))) ]

{- timeCount says how many times to run each test: try around 100 for
hugs, 1000 for ghci, or 10000 for ghc -}

timeCount = 1000

ticksPerSec = 1e12 -- getCPUTime counts picoseconds

main = do
  unless (all check timeArgs)
             (fail "not all answers the same!")
  
  ts <- mapM (timeAll timeFunctions) timeArgs
  prettyPrint ts

timeAll fs x = mapM timeOne fs
    where
      timeOne f =
          let
            force = foldl seq "" (map f (genericReplicate timeCount x))
          in do
            r0 <- getCPUTime
            r1 <- seq force getCPUTime
            return $ (fromInteger (r1 - r0)) / ticksPerSec

prettyPrint ts = do
  mapM_ (putStrLn . display) (zip timeArgs ts)
  putStrLn . display $ ("TOTALS", map sum (transpose ts))
      where
        display (test, results) =
            concat (intersperse "  "
                    (dispString 20 (show test) :
                     map (dispFloat 10) results))
        dispString max s = take max (s ++ repeat ' ')
        dispFloat max f = take max (showFFloat Nothing f "" ++ repeat ' ')

check x = all (r ==) rs
    where
      (r:rs) = map ($ x) timeFunctions