diff --git a/Data/StackPrism.hs b/Data/StackPrism.hs
new file mode 100644
--- /dev/null
+++ b/Data/StackPrism.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveFunctor #-}
+
+module Data.StackPrism (
+
+  -- * Stack prisms
+  StackPrism, stackPrism, forward, backward, 
+  (:-)(..)
+
+  ) where
+
+
+import Control.Applicative
+import Data.Profunctor (Choice(..))
+import Data.Profunctor.Unsafe
+import Data.Functor.Identity
+import Data.Monoid (First(..))
+import Data.Tagged
+
+-- | A stack prism is a bidirectional isomorphism that is partial in the backward direction.
+-- These prisms are compatible with the @lens@ library.
+--
+-- This can be used to express constructor-deconstructor pairs. For example:
+--
+-- > nil :: StackPrism t ([a] :- t)
+-- > nil = stackPrism f g
+-- >   where
+-- >     f        t  = [] :- t
+-- >     g ([] :- t) = Just t
+-- >     g _         = Nothing
+-- >
+-- > cons :: StackPrism (a :- [a] :- t) ([a] :- t)
+-- > cons = stackPrism f g
+-- >   where
+-- >     f (x :- xs  :- t) = (x : xs) :- t
+-- >     g ((x : xs) :- t) = Just (x :- xs :- t)
+-- >     g _               = Nothing
+--
+-- Here ':-' can be read as \'cons\', forming a stack of values. For example,
+-- @nil@ pushes @[]@ onto the stack; or, in the backward direction, tries to
+-- remove @[]@ from the stack. Representing constructor-destructor pairs as
+-- stack manipulators allows them to be composed more easily.
+--
+-- Modules "Data.StackPrism.Generic" and "Data.StackPrism.TH" offer generic ways of deriving @StackPrism@s for custom datatypes.
+
+type StackPrism a b = forall p f. (Choice p, Applicative f) => p a (f a) -> p b (f b)
+
+-- | Construct a prism.
+stackPrism :: (a -> b) -> (b -> Maybe a) -> StackPrism a b
+stackPrism f g = dimap (\b -> maybe (Left b) Right (g b)) (either pure (fmap f)) . right'
+
+-- | Apply a prism in forward direction.
+forward :: StackPrism a b -> a -> b
+forward l = runIdentity #. unTagged #. l .# Tagged .# Identity
+
+-- | Apply a prism in backward direction.
+backward :: StackPrism a b -> b -> Maybe a
+backward l = getFirst #. getConst #. l (Const #. First #. Just)
+
+
+-- | Heterogenous stack with a head and a tail. Or: an infix way to write @(,)@.
+data h :- t = h :- t
+  deriving (Eq, Show, Functor)
+infixr 5 :-
diff --git a/Data/StackPrism/Generic.hs b/Data/StackPrism/Generic.hs
new file mode 100644
--- /dev/null
+++ b/Data/StackPrism/Generic.hs
@@ -0,0 +1,106 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Data.StackPrism.Generic (StackPrisms, mkPrismList, PrismList(..), StackPrismLhs) where
+
+import Data.StackPrism
+import GHC.Generics
+
+
+-- | Derive a list of stack prisms, one for each constructor in the 'Generic' datatype @a@. The list is wrapped in the unary constructor @PrismList@. Within that constructor, the prisms are separated by the right-associative binary infix constructor @:&@. Finally, the individual prisms are wrapped in the unary constructor @I@. These constructors are all exported by this module, but no documentation is generated for them by Hackage.
+--
+-- As an example, here is how to define the prisms @nil@ and @cons@ for @[a]@, which is an instance of @Generic@:
+--
+-- > nil  :: StackPrism              t  ([a] :- t)
+-- > cons :: StackPrism (a :- [a] :- t) ([a] :- t)
+-- > PrismList (P nil :& P cons) = mkPrismList :: StackPrisms [a]
+mkPrismList :: (Generic a, MkPrismList (Rep a)) => StackPrisms a
+mkPrismList = mkPrismList' to (Just . from)
+
+type StackPrisms a = PrismList (Rep a) a
+
+data family PrismList (f :: * -> *) (a :: *)
+
+class MkPrismList (f :: * -> *) where
+  mkPrismList' :: (f p -> a) -> (a -> Maybe (f q)) -> PrismList f a
+
+data instance PrismList (M1 D c f) a = PrismList (PrismList f a)
+
+instance MkPrismList f => MkPrismList (M1 D c f) where
+  mkPrismList' f' g' = PrismList (mkPrismList' (f' . M1) (fmap unM1 . g'))
+
+
+infixr :&
+
+data instance PrismList (f :+: g) a = PrismList f a :& PrismList g a
+
+instance (MkPrismList f, MkPrismList g) => MkPrismList (f :+: g) where
+  mkPrismList' f' g' = f f' g' :& g f' g'
+    where
+      f :: forall a p q. ((f :+: g) p -> a) -> (a -> Maybe ((f :+: g) q)) -> PrismList f a
+      f _f' _g' = mkPrismList' (\fp -> _f' (L1 fp)) (matchL _g')
+      g :: forall a p q. ((f :+: g) p -> a) -> (a -> Maybe ((f :+: g) q)) -> PrismList g a
+      g _f' _g' = mkPrismList' (\gp -> _f' (R1 gp)) (matchR _g')
+
+      matchL :: (a -> Maybe ((f :+: g) q)) -> a -> Maybe (f q)
+      matchL _g' a = case _g' a of
+        Just (L1 f'') -> Just f''
+        _ -> Nothing
+
+      matchR :: (a -> Maybe ((f :+: g) q)) -> a -> Maybe (g q)
+      matchR _g' a = case _g' a of
+        Just (R1 g'') -> Just g''
+        _ -> Nothing
+
+
+data instance PrismList (M1 C c f) a = P (forall t. StackPrism (StackPrismLhs f t) (a :- t))
+
+instance MkStackPrism f => MkPrismList (M1 C c f) where
+  mkPrismList' f' g' = P (stackPrism (f f') (g g'))
+    where
+      f :: forall a p t. (M1 C c f p -> a) -> StackPrismLhs f t -> a :- t
+      f _f' lhs = mapHead (_f' . M1) (mkR lhs)
+      g :: forall a p t. (a -> Maybe (M1 C c f p)) -> (a :- t) -> Maybe (StackPrismLhs f t)
+      g _g' (a :- t) = fmap (mkL . (:- t) . unM1) (_g' a)
+
+
+-- Deriving types and conversions for single constructors
+
+type family StackPrismLhs (f :: * -> *) (t :: *) :: *
+
+class MkStackPrism (f :: * -> *) where
+  mkR :: forall p t. StackPrismLhs f t -> (f p :- t)
+  mkL :: forall p t. (f p :- t) -> StackPrismLhs f t
+
+type instance StackPrismLhs U1 t = t
+instance MkStackPrism U1 where
+  mkR t         = U1 :- t
+  mkL (U1 :- t) = t
+
+type instance StackPrismLhs (K1 i a) t = a :- t
+instance MkStackPrism (K1 i a) where
+  mkR (h :- t) = K1 h :- t
+  mkL (K1 h :- t) = h :- t
+
+type instance StackPrismLhs (M1 i c f) t = StackPrismLhs f t
+instance MkStackPrism f => MkStackPrism (M1 i c f) where
+  mkR = mapHead M1 . mkR
+  mkL = mkL . mapHead unM1
+
+type instance StackPrismLhs (f :*: g) t = StackPrismLhs f (StackPrismLhs g t)
+instance (MkStackPrism f, MkStackPrism g) => MkStackPrism (f :*: g) where
+  mkR t = (hf :*: hg) :- tg
+    where
+      hf :- tf = mkR t
+      hg :- tg = mkR tf
+  mkL ((hf :*: hg) :- t) = mkL (hf :- mkL (hg :- t))
+
+
+
+mapHead :: (a -> b) -> (a :- t) -> (b :- t)
+mapHead f (h :- t) = f h :- t
diff --git a/Data/StackPrism/TH.hs b/Data/StackPrism/TH.hs
new file mode 100644
--- /dev/null
+++ b/Data/StackPrism/TH.hs
@@ -0,0 +1,126 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Data.StackPrism.TH (deriveStackPrisms, deriveStackPrismsWith, deriveStackPrismsFor) where
+
+import Data.StackPrism
+import Language.Haskell.TH
+import Control.Applicative
+import Control.Monad
+
+-- | Derive stack prisms for a given datatype.
+--
+-- For example:
+--
+-- > deriveStackPrisms ''Maybe
+--
+-- will create
+--
+-- > _Just :: StackPrism (a :- t) (Maybe a :- t)
+-- > _Nothing :: StackPrism t (Nothing :- t)
+--
+-- together with their implementations.
+deriveStackPrisms :: Name -> Q [Dec]
+deriveStackPrisms = deriveStackPrismsWith ('_':)
+
+-- | Derive stack prisms given a function that derives variable names from constructor names.
+deriveStackPrismsWith :: (String -> String) -> Name -> Q [Dec]
+deriveStackPrismsWith nameFun = deriveStackPrismsWith' (const nameFun)
+
+-- | Derive stack prisms given a list of variable names, one for each constructor.
+deriveStackPrismsFor :: [String] -> Name -> Q [Dec]
+deriveStackPrismsFor names = deriveStackPrismsWith' (\i _ -> names !! i)
+
+deriveStackPrismsWith' :: (Int -> String -> String) -> Name -> Q [Dec]
+deriveStackPrismsWith' nameFun name = do
+  info <- reify name
+  routers <-
+    case info of
+      TyConI (DataD _ _ tyArgs cons _)   ->
+        mapM (deriveStackPrism name tyArgs (length cons /= 1)) cons
+      TyConI (NewtypeD _ _ tyArgs con _) ->
+        (:[]) <$> deriveStackPrism name tyArgs False con
+      _ ->
+        fail $ show name ++ " is not a datatype."
+  return $ concat 
+    [ [ SigD nm typeF
+      , ValD (VarP nm) (NormalB router) []
+      ] 
+    | (i, (conNm, typeF, router)) <- zip [0..] routers
+    , let nm = mkName (nameFun i (nameBase conNm))
+    ]
+
+deriveStackPrism :: Name -> [TyVarBndr] -> Bool -> Con -> Q (Name, Type, Exp)
+deriveStackPrism resNm tyArgs matchWildcard con =
+  case con of
+    NormalC name tys -> go name (map snd tys)
+    RecC name tys -> go name (map (\(_,_,ty) -> ty) tys)
+    InfixC (_, tyl) name (_, tyr) -> go name [tyl, tyr]
+    _ -> fail $ "Unsupported constructor " ++ show (conName con)
+  where
+    go name tys = do
+      stackPrismE <- [| stackPrism |]
+      stackPrismCon <- deriveConstructor name tys
+      stackPrismDes <- deriveDestructor matchWildcard name tys
+      tNm <- newName "t"
+      let t = VarT tNm
+      let fromType = foldr (-:) t tys
+      let toType = foldl (\t' (PlainTV ty) -> AppT t' (VarT ty)) (ConT resNm) tyArgs -: t
+      return 
+        $ ( name
+          , ForallT (PlainTV tNm:tyArgs) [] $ ConT (mkName "StackPrism") `AppT` fromType `AppT` toType
+          , stackPrismE `AppE` stackPrismCon `AppE` stackPrismDes
+          )
+
+(-:) :: Type -> Type -> Type
+l -: r = ConT (mkName ":-") `AppT` l `AppT` r
+
+deriveConstructor :: Name -> [Type] -> Q Exp
+deriveConstructor name tys = do
+  -- Introduce some names
+  t          <- newName "t"
+  fieldNames <- replicateM (length tys) (newName "a")
+
+  let cons = mkName ":-"
+  let pat = foldr (\f fs -> UInfixP (VarP f) cons fs) (VarP t) fieldNames
+  let applyCon = foldl (\f x -> f `AppE` VarE x) (ConE name) fieldNames
+  let body = UInfixE applyCon (ConE cons) (VarE t)
+
+  return $ LamE [pat] body
+
+
+deriveDestructor :: Bool -> Name -> [Type] -> Q Exp
+deriveDestructor matchWildcard name tys = do
+  -- Introduce some names
+  r          <- newName "r"
+  fieldNames <- replicateM (length tys) (newName "a")
+
+  -- Figure out the names of some constructors
+  ConE just  <- [| Just |]
+  ConE cons  <- [| (:-) |]
+  nothing    <- [| Nothing |]
+
+  let conPat   = ConP name (map VarP fieldNames)
+  let okBody   = ConE just `AppE`
+                  foldr
+                    (\h t -> UInfixE (VarE h) (ConE cons) t)
+                    (VarE r)
+                    fieldNames
+  let okCase   = Match (UInfixP conPat cons (VarP r)) (NormalB okBody) []
+  let failCase = Match WildP (NormalB nothing) []
+  let allCases =
+        if matchWildcard
+              then [okCase, failCase]
+              else [okCase]
+
+  return $ LamCaseE allCases
+
+
+-- Retrieve the name of a constructor.
+conName :: Con -> Name
+conName con =
+  case con of
+    NormalC name _  -> name
+    RecC name _     -> name
+    InfixC _ name _ -> name
+    ForallC _ _ con' -> conName con'
diff --git a/ExampleGeneric.hs b/ExampleGeneric.hs
new file mode 100644
--- /dev/null
+++ b/ExampleGeneric.hs
@@ -0,0 +1,41 @@
+{-# LANGUAGE TypeOperators #-}
+{-# LANGUAGE DeriveGeneric #-}
+
+module Example where
+
+import Data.StackPrism
+import Data.StackPrism.Generic
+
+import GHC.Generics
+
+
+data Person = Person
+  { name     :: String
+  , gender   :: Gender
+  , age      :: Int
+  , location :: Coords
+  } deriving (Eq, Show, Generic)
+
+data Gender = Male | Female
+  deriving (Eq, Show, Generic)
+
+data Coords = Coords { lat :: Float, lng :: Float }
+  deriving (Eq, Show, Generic)
+
+-- The types in the first type parameter match those of the corresponding constructor's fields.
+person :: StackPrism (String :- Gender :- Int :- Coords :- t) (Person :- t)
+male   :: StackPrism t (Gender :- t)
+female :: StackPrism t (Gender :- t)
+coords :: StackPrism (Float :- Float :- t) (Coords :- t)
+
+PrismList (P person)           = mkPrismList :: StackPrisms Person
+PrismList (P male :& P female) = mkPrismList :: StackPrisms Gender
+PrismList (P coords)           = mkPrismList :: StackPrisms Coords
+
+
+false, true :: StackPrism t (Bool :- t)
+PrismList (P false :& P true) = mkPrismList :: StackPrisms Bool
+
+nil  :: StackPrism              t  ([a] :- t)
+cons :: StackPrism (a :- [a] :- t) ([a] :- t)
+PrismList (P nil :& P cons) = mkPrismList :: StackPrisms [a] 
diff --git a/ExampleTH.hs b/ExampleTH.hs
new file mode 100644
--- /dev/null
+++ b/ExampleTH.hs
@@ -0,0 +1,24 @@
+{-# LANGUAGE TemplateHaskell #-}
+
+module Example where
+
+import Data.StackPrism
+import Data.StackPrism.TH
+
+
+data Person = Person
+  { name     :: String
+  , gender   :: Gender
+  , age      :: Int
+  , location :: Coords
+  } deriving (Eq, Show)
+
+data Gender = Male | Female
+  deriving (Eq, Show)
+
+data Coords = Coords { lat :: Float, lng :: Float }
+  deriving (Eq, Show)
+
+deriveStackPrisms ''Person
+deriveStackPrisms ''Gender
+deriveStackPrisms ''Coords
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,24 @@
+Copyright (c) 2013, Martijn van Steenbergen
+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 the author nor the
+      names of his contributors may be used to endorse or promote products
+      derived from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``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 <copyright holder> 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/stack-prism.cabal b/stack-prism.cabal
new file mode 100644
--- /dev/null
+++ b/stack-prism.cabal
@@ -0,0 +1,37 @@
+Name:           stack-prism
+Version:        0.1
+Synopsis:       Stack prisms
+Description:    Haskell lens prisms that use stack types
+
+
+Author:         Martijn van Steenbergen, Sjoerd Visscher
+Maintainer:     martijn@van.steenbergen.nl
+Stability:      Experimental
+Copyright:      Some Rights Reserved (CC) 2014 Martijn van Steenbergen
+Homepage:       https://github.com/MedeaMelana/stack-prism
+Bug-reports:    https://github.com/MedeaMelana/stack-prism/issues
+
+
+Cabal-Version:  >= 1.6
+License:        BSD3
+License-file:   LICENSE
+Category:       Data
+Build-type:     Simple
+
+extra-source-files:
+  ExampleGeneric.hs
+  ExampleTH.hs
+
+Library
+  Exposed-Modules:  Data.StackPrism,
+                    Data.StackPrism.TH,
+                    Data.StackPrism.Generic
+  Build-Depends:    base >= 3.0 && < 5,
+                    profunctors >= 4.0 && < 5,
+                    tagged >= 0.4.4 && < 1,
+                    transformers >= 0.2 && < 0.5,
+                    template-haskell >= 2.8 && < 2.10
+
+Source-Repository head
+  Type:         git
+  Location:     https://github.com/MedeaMelana/stack-prism