diff --git a/Graphics/Formats/Collada.hs b/Graphics/Formats/Collada.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Formats/Collada.hs
@@ -0,0 +1,34 @@
+module Graphics.Formats.Collada 
+    ( Config(..), load, defaultConfig, pathTextureLoader )
+where
+
+import qualified Graphics.Rendering.OpenGL.GL as GL
+import Graphics.Formats.Collada.Objects
+import Graphics.Formats.Collada.Render
+import qualified Codec.Image.STB as Image
+import qualified Data.Bitmap.OpenGL as Bitmap
+
+data Config = Config {
+    textureLoader :: String -> IO GL.TextureObject
+}
+
+load :: Config -> String -> IO (IO ())
+load config contents = do
+    case parseCollada contents of
+        Nothing -> fail "Parse error"
+        Just (mainid, dict) -> compile dict (textureLoader config) mainid
+
+defaultConfig :: Config
+defaultConfig = Config {
+    textureLoader = pathTextureLoader "."
+}
+
+-- | Takes a prefix and returns a texture loader that prepends the prefix to the path
+-- and loads from disk.
+pathTextureLoader :: String -> String -> IO GL.TextureObject
+pathTextureLoader prefix path = do
+    let loc = prefix ++ "/" ++ path
+    e <- Image.loadImage loc
+    case e of
+        Left err -> fail $ "Couldn't load " ++ loc ++ ": " ++ err
+        Right bmp -> Bitmap.makeSimpleBitmapTexture bmp
diff --git a/Graphics/Formats/Collada/Objects.hs b/Graphics/Formats/Collada/Objects.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Formats/Collada/Objects.hs
@@ -0,0 +1,251 @@
+module Graphics.Formats.Collada.Objects
+    ( Dict, ID
+    , Object(..), Matrix(..)
+    , Accessor(..), Input(..), InputSemantic(..), Primitive(..)
+    , Mesh(..), Parameter(..), Technique(..)
+    , ColorOrTexture(..), Node(..), NodeRef(..), NodeInstance(..)
+    , MaterialBinding(..), parseCollada
+    )
+where
+
+import Prelude hiding ((.), id)
+import qualified Text.XML.HXT.Arrow as X
+import qualified Text.XML.HXT.Arrow.ParserInterface as X
+import qualified Control.Arrow.ListArrow as LA
+import qualified Graphics.Rendering.OpenGL.GL as GL
+import qualified Data.Map as Map
+import Data.Maybe (listToMaybe)
+import Control.Category
+import Control.Arrow
+import Foreign.Ptr
+import Foreign.Marshal.Array
+import Data.List
+
+type Dict = Map.Map ID Object
+type ID = String
+
+data Object
+    = OVisualScene [NodeRef]
+    | OFloatArray [GL.GLfloat]
+    | OSource Accessor
+    | OVertices [Input]
+    | OGeometry Mesh
+    | OImage FilePath
+    | OParam Parameter
+    | OEffect Technique
+    | OMaterial ID -- instance_effect
+    | ONode Node
+    deriving Show
+
+data Matrix
+    = Matrix [GL.GLfloat]
+    deriving Show
+
+identityMatrix :: Matrix
+identityMatrix = Matrix [ 1, 0, 0, 0
+                        , 0, 1, 0, 0
+                        , 0, 0, 1, 0
+                        , 0, 0, 0, 1 ]
+
+data Accessor
+    = Accessor ID Int Int Int Int -- array components count stride offset
+    deriving Show
+
+data Input
+    = Input Int InputSemantic ID -- offset semantic source
+    deriving Show
+
+data InputSemantic
+    = SemPosition
+    | SemNormal
+    | SemVertex
+    | SemTexCoord
+    deriving (Eq,Show)
+
+data Primitive
+    = PrimTriangles String [Input] [Int]  -- material inputs indices
+    deriving Show
+
+data Mesh = Mesh [Primitive]
+    deriving Show
+
+data Parameter
+    = ParamSurface2D ID
+    | ParamSampler2D ID
+    deriving Show
+
+data Technique
+    = TechLambert ColorOrTexture -- diffuse
+    | TechConstant ColorOrTexture GL.GLfloat -- transparent transparency
+    deriving Show
+
+data ColorOrTexture
+    = COTColor GL.GLfloat GL.GLfloat GL.GLfloat GL.GLfloat
+    | COTTexture ID String   -- source texcoord
+    deriving Show
+
+data Node
+    = Node Matrix [NodeInstance]
+    deriving Show
+
+data NodeRef
+    = NRNode Node
+    | NRInstance ID
+    deriving Show
+
+data NodeInstance
+    = NINode NodeRef
+    | NIGeometry ID [MaterialBinding]
+    deriving Show
+
+data MaterialBinding
+    = MaterialBinding String ID String String -- symbol target semantic input_semantic
+    deriving Show
+
+parseCollada :: String -> Maybe (ID, Dict)
+parseCollada = listToMaybe . LA.runLA (mainA <<< X.parseXmlDoc <<^ (\x -> ("<stdin>", x)))
+
+mainA :: LA.LA X.XmlTree (ID, Dict)
+mainA = mainScene &&& (Map.unions .< X.multi objects) <<< X.hasName "COLLADA"
+
+infixr 1 .<
+(.<) = flip (X.>.)
+
+refAttr :: String -> LA.LA X.XmlTree ID
+refAttr name = stripHash ^<< X.getAttrValue0 name
+    where
+    stripHash ('#':x) = x
+    stripHash x = x
+
+objects = asum [ float_array, source, vertices, geometry, image, newparam, effect, material, node, visual_scene ]
+
+mainScene :: LA.LA X.XmlTree ID
+mainScene = refAttr "url" <<< child (X.hasName "instance_visual_scene") <<< child (X.hasName "scene")
+
+asum = foldr1 (X.<+>)
+
+objectWithIDAttr :: String -> String -> LA.LA X.XmlTree Object -> LA.LA X.XmlTree Dict
+objectWithIDAttr attr name proc = uncurry Map.singleton ^<< (X.getAttrValue0 attr &&& proc) . X.hasName name
+
+object :: String -> LA.LA X.XmlTree Object -> LA.LA X.XmlTree Dict
+object = objectWithIDAttr "id"
+
+float_array :: LA.LA X.XmlTree Dict
+float_array = object "float_array" $ toArray ^<< X.getText . X.getChildren
+    where
+    toArray = OFloatArray . map read . words
+
+accessor :: LA.LA X.XmlTree Accessor
+accessor = massage ^<< (length .< child (X.hasName "param")) &&& refAttr "source" &&& X.getAttrValue0 "count" &&& X.getAttrValue "stride" &&& X.getAttrValue "offset" <<< X.hasName "accessor"
+    where
+    massage (len, (source, (count, (stride, offset)))) = Accessor source len (read count) (readDef len stride) (readDef 0 offset)
+
+readDef d "" = d
+readDef _ s  = read s
+
+child n = n <<< X.getChildren
+
+source :: LA.LA X.XmlTree Dict
+source = object "source" $ OSource ^<< accessor <<< X.getChildren <<< child (X.hasName "technique_common")
+
+input :: LA.LA X.XmlTree Input
+input = massage ^<< X.getAttrValue "offset" &&& X.getAttrValue0 "semantic" &&& refAttr "source" <<< X.hasName "input"
+    where
+    massage (offset, (semantic, source)) = Input (readDef (-1) offset) (massageSemantic semantic) source -- -1 hax!!  See vertices where this is fixedup.
+    massageSemantic "POSITION" = SemPosition
+    massageSemantic "NORMAL"   = SemNormal
+    massageSemantic "VERTEX"   = SemVertex
+    massageSemantic "TEXCOORD" = SemTexCoord
+    massageSemantic s = error $ "Unknown semantic: " ++ s
+
+vertices :: LA.LA X.XmlTree Dict
+vertices = object "vertices" $ OVertices . fixups .< child input
+    where
+    fixups = zipWith fixup [0..]
+    fixup n (Input z sem source) | z == -1 = Input n sem source
+                                 | otherwise = Input z sem source
+
+
+triangles :: LA.LA X.XmlTree Primitive
+triangles = massage ^<< X.getAttrValue "material" &&& procBody <<< X.hasName "triangles"
+    where
+    procBody = (id .< child input) &&& (map read . words ^<< child X.getText <<< child (X.hasName "p"))
+    massage (material, (inputs, p)) = PrimTriangles material inputs p
+
+mesh :: LA.LA X.XmlTree Mesh
+mesh = (Mesh .< child primitives) <<< X.hasName "mesh"
+    where
+    primitives = asum [ triangles ]
+
+geometry :: LA.LA X.XmlTree Dict
+geometry = object "geometry" $ OGeometry ^<< child mesh
+
+image :: LA.LA X.XmlTree Dict
+image = object "image" $ OImage ^<< child X.getText <<< child (X.hasName "init_from")
+
+newparam :: LA.LA X.XmlTree Dict
+newparam = objectWithIDAttr "sid" "newparam" $ OParam ^<< asum [surface, sampler2D] <<< X.getChildren
+    where
+    surface = ParamSurface2D ^<< child X.getText <<< child (X.hasName "init_from") <<< X.hasAttrValue "type" (== "2D") <<< X.hasName "surface"
+    sampler2D = ParamSampler2D ^<< child X.getText <<< child (X.hasName "source") <<< X.hasName "sampler2D"
+
+colorOrTexture :: LA.LA X.XmlTree ColorOrTexture
+colorOrTexture = texture X.<+> color
+    where
+    texture = uncurry COTTexture ^<< X.getAttrValue0 "texture" &&& X.getAttrValue0 "texcoord" <<< X.hasName "texture"
+    color = colorify . map read . words ^<< child X.getText <<< X.hasName "color"
+    colorify [r,g,b,a] = COTColor r g b a
+    colorify s = error "Malformed color"
+
+lambert :: LA.LA X.XmlTree Technique
+lambert = TechLambert ^<< child colorOrTexture <<< child (X.hasName "diffuse") <<< X.hasName "lambert"
+
+constant :: LA.LA X.XmlTree Technique
+constant = uncurry TechConstant ^<< (child colorOrTexture <<< child (X.hasName "transparent")) &&& (read ^<< child (X.getText) <<< child (X.hasName "float") <<< child (X.hasName "transparency")) <<< X.hasName "constant"
+
+technique :: LA.LA X.XmlTree Technique
+technique = asum [lambert, constant] <<< X.getChildren <<< X.hasName "technique"
+
+effect :: LA.LA X.XmlTree Dict
+effect = object "effect" $ OEffect ^<< child technique <<< child (X.hasName "profile_COMMON")
+
+material :: LA.LA X.XmlTree Dict
+material = object "material" $ OMaterial ^<< refAttr "url" <<< child (X.hasName "instance_effect")
+
+nodeRef :: LA.LA X.XmlTree NodeRef
+nodeRef = asum [inline, instance_node] 
+    where
+    inline = (arr NRInstance ||| (NRNode ^<< rawNode)) <<< switch <<< X.hasName "node"
+    switch = convid ^<< X.getAttrValue "id" &&& id
+    convid ("", xml) = Right xml
+    convid (x, _)    = Left x
+
+instance_node :: LA.LA X.XmlTree NodeRef
+instance_node = NRInstance ^<< refAttr "url" <<< X.hasName "instance_node"
+
+nodeInstance :: LA.LA X.XmlTree NodeInstance
+nodeInstance = asum [NINode ^<< nodeRef, instance_geometry]
+
+instance_geometry :: LA.LA X.XmlTree NodeInstance
+instance_geometry = uncurry NIGeometry ^<< refAttr "url" &&& bindings <<< X.hasName "instance_geometry"
+    where
+    bindings = id .< (child instance_material <<< child (X.hasName "technique_common") <<< child (X.hasName "bind_material"))
+
+matrix :: LA.LA X.XmlTree Matrix
+matrix = Matrix . map read . words ^<< child X.getText <<< X.hasName "matrix"
+
+rawNode :: LA.LA X.XmlTree Node
+rawNode = uncurry Node ^<< (child matrix `X.withDefault` identityMatrix) &&& (id .< child nodeInstance) <<< X.hasName "node"
+
+node :: LA.LA X.XmlTree Dict
+node = object "node" $ ONode ^<< rawNode
+
+instance_material :: LA.LA X.XmlTree MaterialBinding
+instance_material = conv ^<< myAttrs &&& bindAttrs <<< X.hasName "instance_material"
+    where
+    conv ((symbol, target), (semantic, input_semantic)) = MaterialBinding symbol target semantic input_semantic
+    myAttrs = X.getAttrValue0 "symbol" &&& refAttr "target"
+    bindAttrs = X.getAttrValue0 "semantic" &&& X.getAttrValue0 "input_semantic" <<< child (X.hasName "bind_vertex_input")
+
+visual_scene :: LA.LA X.XmlTree Dict
+visual_scene = object "visual_scene" $ OVisualScene ^<< id .< child nodeRef
diff --git a/Graphics/Formats/Collada/Render.hs b/Graphics/Formats/Collada/Render.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/Formats/Collada/Render.hs
@@ -0,0 +1,227 @@
+{-# LANGUAGE GeneralizedNewtypeDeriving, ScopedTypeVariables, PatternGuards, RecursiveDo #-}
+
+module Graphics.Formats.Collada.Render 
+    ( compile )
+where
+
+import qualified Graphics.Rendering.OpenGL.GL as GL
+import qualified Graphics.Formats.Collada.Objects as O
+import qualified Data.Map as Map
+import qualified Foreign.Marshal.Array as Array
+import qualified Foreign.Storable as Storable
+import Foreign.Ptr (Ptr)
+import Data.Monoid (Monoid(..))
+import Control.Arrow (second)
+import Control.Applicative
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import Control.Monad.Trans
+import Control.Monad (when, forM_, liftM2, liftM3)
+import GHC.Prim (Any)
+import Unsafe.Coerce (unsafeCoerce)
+
+newtype DrawM a = DrawM { runDrawM :: IO a }
+    deriving (Functor, Applicative, Monad, MonadIO)
+
+wrapDrawM :: (IO a -> IO a) -> (DrawM a -> DrawM a)
+wrapDrawM f = DrawM . f . runDrawM
+
+type Bindings = Map.Map String (DrawM ())
+
+type Cache = Map.Map O.ID Any
+
+data CompileEnv = CompileEnv {
+    envDict :: O.Dict,
+    envBindings :: Bindings,
+    envLoader :: String -> IO GL.TextureObject
+}
+
+newtype CompileM a = CompileM { runCompileM :: ReaderT CompileEnv (StateT Cache IO) a }
+    deriving (Functor, Applicative, Monad, MonadIO)
+
+cached :: (O.Object -> CompileM a) -> (O.ID -> CompileM a)
+cached f ident = CompileM $ do
+    cache <- lift get
+    case Map.lookup ident cache of
+        Nothing -> mdo
+            lift . modify . Map.insert ident . unsafeCoerce $ result
+            result <- runCompileM $ f =<< findSymbol ident
+            return result
+        Just result -> return (unsafeCoerce result)
+
+lookup' :: (Ord k, Show k) => k -> Map.Map k a -> a
+lookup' k mp | Just x <- Map.lookup k mp = x
+             | otherwise                 = error $ "Couldn't find object: " ++ show k
+
+findSymbol :: O.ID -> CompileM O.Object
+findSymbol sym = CompileM $ asks (lookup' sym . envDict)
+
+findBinding :: String -> CompileM (DrawM ())
+findBinding sym = CompileM $ asks (lookup' sym . envBindings)
+
+addBindings :: Bindings -> CompileM a -> CompileM a
+addBindings bindings = CompileM . local addBinding . runCompileM
+    where
+    addBinding env = env { envBindings = envBindings env `Map.union` bindings }
+
+loadTexture :: String -> CompileM GL.TextureObject
+loadTexture s = CompileM $ liftIO . ($ s) =<< asks envLoader
+
+compile :: O.Dict -> (String -> IO (GL.TextureObject)) -> O.ID -> IO (IO ())
+compile dict loader mainid = do
+    runDrawM <$> evalStateT (runReaderT (runCompileM (compileVisualScene mainid)) initEnv) Map.empty
+    where
+    initEnv = CompileEnv { envDict = dict, envBindings = Map.empty, envLoader = loader }
+
+compileArray :: O.ID -> CompileM (Ptr GL.GLfloat)
+compileArray = cached go
+    where
+    go (O.OFloatArray xs) = liftIO $ Array.newArray xs
+    go _ = error "Not an array"
+
+floatSize = Storable.sizeOf (undefined :: GL.GLfloat)
+
+compileAccessor :: O.Accessor -> CompileM (GL.VertexArrayDescriptor GL.GLfloat)
+compileAccessor (O.Accessor arrayid components count stride offset) = do
+    ptr <- compileArray arrayid
+    let ptr' = Array.advancePtr ptr offset
+    return $ GL.VertexArrayDescriptor (fromIntegral components) GL.Float byteStride ptr'
+    where
+    byteStride = fromIntegral $ Storable.sizeOf floatSize * (stride - components)
+
+
+indexDescriptor :: GL.VertexArrayDescriptor GL.GLfloat -> Int -> Int -> IO GL.GLfloat
+indexDescriptor (GL.VertexArrayDescriptor components _ stride ptr) = \ix off ->
+    Storable.peekByteOff ptr (step * ix + floatSize * off)
+    where
+    step = fromIntegral stride + floatSize * fromIntegral components
+
+data CompiledInput = CompiledInput { ciSetupArrays :: DrawM (), ciIndex :: Int -> DrawM () }
+
+instance Monoid CompiledInput where
+    mempty = CompiledInput (return ()) (const (return ()))
+    mappend a b = CompiledInput { ciSetupArrays = ciSetupArrays a >> ciSetupArrays b
+                                , ciIndex = \z -> ciIndex a z >> ciIndex b z 
+                                }
+
+compileInput :: O.Input -> CompileM CompiledInput
+compileInput (O.Input _ semantic source) = do
+    sym <- findSymbol source
+    case sym of
+        O.OVertices inputs -> mconcat <$> mapM compileInput inputs
+        O.OSource acc -> do
+            descriptor <- compileAccessor acc
+            let sem = convertSem semantic
+            let setupArrays = liftIO $ do
+                    GL.arrayPointer sem GL.$= descriptor
+                    GL.clientState sem GL.$= GL.Enabled
+            let ind = indexDescriptor descriptor 
+            let index = case sem of
+                            GL.VertexArray -> \z -> liftIO $ GL.vertex =<< liftM3 GL.Vertex3 (ind z 0) (ind z 1) (ind z 2)
+                            GL.NormalArray -> \z -> liftIO $ GL.normal =<< liftM3 GL.Normal3 (ind z 0) (ind z 1) (ind z 2)
+                            GL.TextureCoordArray -> \z -> liftIO $ GL.texCoord =<< liftM2 GL.TexCoord2 (ind z 0) (ind z 1)
+                            x -> error $ "Don't know how to index a " ++ show x
+            return $ CompiledInput setupArrays index
+            
+                    
+        x -> error $ "Input can't use " ++ show x ++ " as a source"
+    where
+    convertSem O.SemPosition = GL.VertexArray
+    convertSem O.SemNormal   = GL.NormalArray
+    convertSem O.SemTexCoord = GL.TextureCoordArray
+    conversion sem = error $ "Unknown semantic: " ++ show sem
+
+compilePrimitive :: O.Primitive -> CompileM (DrawM ())
+compilePrimitive (O.PrimTriangles material inputs indices) = do
+    mat <- findBinding material
+    case inputs of
+        [inp] -> do  -- fast single-input
+            compiled <- compileInput inp 
+            liftIO $ do
+                let numindices = fromIntegral (length indices)
+                ixarray :: Ptr GL.GLuint <- liftIO . Array.newArray $ map fromIntegral indices
+                return . wrapDrawM (GL.preservingClientAttrib [GL.AllClientAttributes]) $ do
+                    mat
+                    ciSetupArrays compiled
+                    liftIO $ GL.drawElements GL.Triangles numindices GL.UnsignedInt ixarray
+        
+        inps -> do   -- slow multi-input  (should copy to a new vertex array instead)
+            compiled <- Map.fromListWith mappend <$> mapM (\inp@(O.Input i _ _) -> ((,) i) <$> compileInput inp) inps
+            let (maxE,example) = Map.findMax compiled
+            return . (mat >>) . wrapDrawM (GL.renderPrimitive GL.Triangles) . forM_ (zip (cycle [0..maxE]) indices) $ \(inpix,ix) -> do
+                ciIndex (Map.findWithDefault mempty inpix compiled) ix
+            
+
+compileGeometry :: O.ID -> CompileM (DrawM ())
+compileGeometry = cached go
+    where
+    go (O.OGeometry (O.Mesh prims)) = do
+        cprims <- mapM compilePrimitive prims
+        return $ sequence_ cprims
+    go _ = error "Not a geometry"
+
+compileNode :: O.Node -> CompileM (DrawM ())
+compileNode (O.Node (O.Matrix matrix) instances) = do
+    mat :: GL.GLmatrix GL.GLfloat <- liftIO $ GL.newMatrix GL.RowMajor matrix 
+    instances' <- mapM compileNodeInstance instances
+    return . wrapDrawM GL.preservingMatrix $ liftIO (GL.multMatrix mat) >> sequence_ instances'
+
+compileNodeInstance :: O.NodeInstance -> CompileM (DrawM ())
+compileNodeInstance (O.NINode ref) = compileNodeRef ref
+compileNodeInstance (O.NIGeometry geom materials) = do
+    materials' <- Map.unions <$> mapM compileMaterialBinding materials
+    addBindings materials' $ compileGeometry geom
+
+compileNodeRef :: O.NodeRef -> CompileM (DrawM ())
+compileNodeRef (O.NRNode node) = compileNode node
+compileNodeRef (O.NRInstance nodeid) = compileNodeObject nodeid
+
+compileNodeObject :: O.ID -> CompileM (DrawM ())
+compileNodeObject = cached go
+    where
+    go (O.ONode node) = compileNode node
+    go _ = error "Not a node"
+
+compileVisualScene :: O.ID -> CompileM (DrawM ())
+compileVisualScene = cached go
+    where
+    go (O.OVisualScene noderefs) = do
+        sequence_ <$> mapM compileNodeRef noderefs
+    go _ = error "Not a visual scene"
+
+compileImage :: O.ID -> CompileM GL.TextureObject
+compileImage = cached go
+    where
+    go (O.OImage path) = loadTexture path
+    go _ = error "not an image"
+
+compileEffect :: O.ID -> CompileM (DrawM ())
+compileEffect = cached go
+    where
+    go (O.OEffect (O.TechLambert cot)) = lambert cot
+    go (O.OEffect (O.TechConstant cot alpha)) = go (O.OEffect (O.TechLambert cot)) -- XXX Hax
+    go (O.OMaterial ident) = compileEffect ident
+    go x = error $ "Not an effect: " ++ show x
+    
+    lambert (O.COTColor r g b a) = return . liftIO $ do
+        GL.texture GL.Texture2D GL.$= GL.Disabled
+        GL.colorMaterial GL.$= Just (GL.Front, GL.Diffuse)
+        GL.color $ GL.Color4 r g b a
+    lambert (O.COTTexture source _texcoord) = do
+        texobj <- compileParameter source
+        return . liftIO $ do
+            GL.colorMaterial GL.$= Just (GL.Front, GL.Diffuse)
+            GL.texture GL.Texture2D GL.$= GL.Enabled
+            GL.textureBinding GL.Texture2D GL.$= Just texobj
+
+compileParameter :: O.ID -> CompileM GL.TextureObject
+compileParameter = cached go
+    where
+    go (O.OParam (O.ParamSurface2D img)) = compileImage img
+    go (O.OParam (O.ParamSampler2D surf)) = compileParameter surf
+    go _ = error "Not a param"
+
+compileMaterialBinding :: O.MaterialBinding -> CompileM Bindings
+compileMaterialBinding (O.MaterialBinding sym target _ _) = do
+    targetE <- compileEffect target
+    return $ Map.singleton sym targetE
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c)2010, Luke Palmer
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Luke Palmer nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
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/graphics-formats-collada.cabal b/graphics-formats-collada.cabal
new file mode 100644
--- /dev/null
+++ b/graphics-formats-collada.cabal
@@ -0,0 +1,74 @@
+-- graphics-formats-collada.cabal auto-generated by cabal init. For
+-- additional options, see
+-- http://www.haskell.org/cabal/release/cabal-latest/doc/users-guide/authors.html#pkg-descr.
+-- The name of the package.
+Name:                graphics-formats-collada
+
+-- The package version. See the Haskell package versioning policy
+-- (http://www.haskell.org/haskellwiki/Package_versioning_policy) for
+-- standards guiding when and how versions should be incremented.
+Version:             0.1.0
+
+-- A short (one-line) description of the package.
+Synopsis:            Load 3D geometry in the COLLADA format
+
+-- A longer description of the package.
+Description:
+    Early in development.  Should be able to load anything that Google SketchUp
+    produces -- other than that, all bets are off.
+
+-- URL for the project homepage or repository.
+Homepage:            http://github.com/luqui/collada
+
+-- The license under which the package is released.
+License:             BSD3
+
+-- The file containing the license text.
+License-file:        LICENSE
+
+-- The package author(s).
+Author:              Luke Palmer
+
+-- An email address to which users can send suggestions, bug reports,
+-- and patches.
+Maintainer:          lrpalmer@gmail.com
+
+-- A copyright notice.
+-- Copyright:           
+
+Category:            Graphics
+
+Build-type:          Simple
+
+-- Extra files to be distributed with the package, such as examples or
+-- a README.
+Extra-source-files:  sample.hs
+
+-- Constraint on the version of Cabal needed to build this package.
+Cabal-version:       >=1.6
+
+
+Library
+  -- Modules exported by the library.
+  Exposed-modules:     
+    Graphics.Formats.Collada
+    Graphics.Formats.Collada.Objects
+    Graphics.Formats.Collada.Render
+  
+  -- Packages needed in order to build this package.
+  Build-depends: 
+    base == 4.*,
+    containers,
+    transformers == 0.1.*,
+    ghc-prim == 0.1.*,
+    hxt == 8.5.*,
+    OpenGL == 2.4.*, 
+    stb-image == 0.2.*,
+    bitmap-opengl == 0.0.*
+
+  -- Modules not exported by this package.
+  -- Other-modules:       
+  
+  -- Extra tools (e.g. alex, hsc2hs, ...) needed to build the source.
+  -- Build-tools:         
+  
diff --git a/sample.hs b/sample.hs
new file mode 100644
--- /dev/null
+++ b/sample.hs
@@ -0,0 +1,73 @@
+{-# LANGUAGE TypeFamilies #-}
+
+import qualified Graphics.Formats.Collada as Collada
+import qualified Graphics.UI.GLUT as GLUT
+import qualified Graphics.Rendering.OpenGL.GL as GL
+import qualified Graphics.Rendering.OpenGL.GLU as GLU
+import System.IO
+import Control.Applicative
+import Data.VectorSpace
+import Data.IORef
+
+instance AdditiveGroup GL.GLdouble where
+    zeroV = 0
+    (^+^) = (+)
+    negateV = negate
+
+instance VectorSpace GL.GLdouble where
+    type Scalar GL.GLdouble = GL.GLdouble
+    (*^) = (*)
+
+instance InnerSpace GL.GLdouble where
+    (<.>) = (*)
+
+main = do
+    hSetBuffering stdout NoBuffering
+
+    GLUT.initialDisplayMode GL.$= [GLUT.RGBAMode, GLUT.DoubleBuffered, GLUT.WithDepthBuffer]
+
+    GLUT.getArgsAndInitialize
+    GLUT.createWindow "Hello!"
+
+    putStrLn "Loading"
+    action <- Collada.load Collada.defaultConfig =<< getContents
+    putStrLn "Done"
+
+    GL.lighting GL.$= GL.Enabled
+    GL.light (GL.Light 0) GL.$= GL.Enabled
+    GL.position (GL.Light 0) GL.$= GL.Vertex4 0 0 0 1
+    GL.depthFunc GL.$= Nothing
+    GL.depthFunc GL.$= Just GL.Lequal
+    GL.depthMask GL.$= GL.Enabled
+
+    GLUT.displayCallback GLUT.$= (do
+        GL.clearColor GL.$= GL.Color4 0 0 0 0
+        GL.clear [GL.ColorBuffer, GL.DepthBuffer]
+        GL.preservingMatrix $ do
+            GL.matrixMode GL.$= GL.Projection
+            GL.loadIdentity
+            GLU.perspective 45 1 1 10000
+            GL.matrixMode GL.$= GL.Modelview 0
+            GL.loadIdentity
+            GLU.lookAt (uncurry3 GL.Vertex3 eye) (uncurry3 GL.Vertex3 object) (uncurry3 GL.Vector3 up)
+            GL.renderPrimitive GL.Lines $ do
+                vertex (-200) 0 0
+                vertex 200 0 0
+                vertex 0 (-200) 0
+                vertex 0 200 0
+                vertex 0 0 (-200)
+                vertex 0 0 200
+            action
+        GLUT.swapBuffers)
+    GLUT.mainLoop
+
+    where
+    eye = (200, 200, 200)
+    object = (0, 0, 0)
+    up = normalized $ (object ^-^ eye) `cross` ((object ^-^ eye) `cross` (0,0,-1))
+    cross (bx,by,bz) (cx,cy,cz) = (by*cz - cy*bz, bz*cx - bx*cz, bx*cy - by*cx)
+
+    uncurry3 f (x,y,z) = f x y z
+
+    vertex :: GL.GLfloat -> GL.GLfloat -> GL.GLfloat -> IO ()
+    vertex x y z = GL.vertex $ GL.Vertex3 x y z