diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/gact.cabal b/gact.cabal
new file mode 100644
--- /dev/null
+++ b/gact.cabal
@@ -0,0 +1,14 @@
+Name: gact
+Version:       0.1
+License:       GPL
+Cabal-Version: >= 1.6
+Build-Type:    Simple
+Category:      Bioinformatics
+Author:        Ketil Malde
+Maintainer:    Ketil Malde <ketil@malde.org>
+Synopsis:      General Alignment Clustering Tool
+
+Executable gact
+    Hs-Source-Dirs:  src
+    Main-Is:         GACT.hs
+    Build-Depends:   base >= 4 && < 5, biopsl >= 0.2, cmdargs, hashable, unordered-containers, bytestring
diff --git a/src/GACT.hs b/src/GACT.hs
new file mode 100644
--- /dev/null
+++ b/src/GACT.hs
@@ -0,0 +1,49 @@
+{-# Language PackageImports #-}
+
+module Main where
+
+import "biopsl" Bio.Alignment.PSL
+-- import Bio.Sequence (SeqData)
+import qualified Data.HashSet as S
+import Data.List (partition,foldl',sortBy)
+import qualified Data.ByteString.Lazy.Char8 as B
+import Data.Hashable
+
+import Options
+
+main :: IO ()
+main = do
+  opts <- getArgs
+  pss <- mapM readPSL $ files opts
+  mapM_ (if long_output opts then print_cluster else print_list) . cluster_sl qname tname . concat $ pss
+
+print_list :: (S.HashSet B.ByteString, [PSL]) -> IO ()
+print_list (s,_) = B.putStrLn . B.unwords . S.toList $ s
+
+print_cluster :: (S.HashSet B.ByteString, [PSL]) -> IO ()
+print_cluster (s,b) = do 
+  B.putStrLn . B.unwords . S.toList $ s
+  B.putStrLn $ unparsePSL $ sortOn tname $ sortOn tstarts $ b
+
+sortOn :: Ord a1 => (a -> a1) -> [a] -> [a]
+sortOn f = sortBy (\x y -> compare (f x) (f y))
+
+cluster_sl  :: (Hashable a, Ord a) => (b->a) -> (b->a) -> [b] -> [(S.HashSet a,[b])]
+cluster_sl f1 f2 = foldl' csl []
+    where csl cs b = 
+              -- can be short circuited for more performance
+              let (acs,tmp)   = partition (S.member (f1 b) . fst) cs
+                  (bcs,rest)  = partition (S.member (f2 b) . fst) tmp
+              in case (acs,bcs) of 
+                   ([(ao,as)],[(bo,bs)]) -> (S.union ao bo,b:as++bs):rest
+                   ([(ao,as)],[])        -> (S.insert (f2 b) ao, b:as):rest
+                   ([],[(bo,bs)])        -> (S.insert (f1 b) bo, b:bs):rest
+                   ([],[])               -> (S.fromList [f1 b,f2 b],[b]):rest
+                   _                     -> error "Grave mistake"
+
+select :: (t -> Bool) -> [t] -> ([t],[t])
+select p = go []
+  where go acc (x:xs) | p x = ([x],acc++xs)
+                      | otherwise = go (x:acc) xs
+        go acc [] = ([],acc)
+