diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,26 @@
+Copyright (c) 2015, Stuart Popejoy
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. 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.
+
+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/fadno-braids.cabal b/fadno-braids.cabal
new file mode 100644
--- /dev/null
+++ b/fadno-braids.cabal
@@ -0,0 +1,32 @@
+name:                fadno-braids
+category:            Data, Math, Algebra
+version:             0.0.2
+synopsis:            Braid representations in Haskell
+description:  Braids represented as Haskell types with support for generation and transformations.
+homepage:            http://github.com/slpopejoy/
+license:             BSD2
+license-file:        LICENSE
+author:              Stuart Popejoy
+maintainer:          spopejoy@panix.com
+build-type:          Simple
+cabal-version:       >=1.10
+source-repository head
+  type:     git
+  location: https://github.com/slpopejoy/fadno-braids.git
+
+library
+  exposed-modules:
+                  Fadno.Braids
+                  Fadno.Braids.Internal
+                  Fadno.Braids.Graphics
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       base >=4.8 && <4.9
+                     , containers
+                     , lens == 4.13.*
+                     , diagrams == 1.3.*
+                     , diagrams-lib == 1.3.*
+                     , diagrams-rasterific == 1.3.*
+                     , transformers-compat == 0.4.*
+  hs-source-dirs: src
+  default-language:    Haskell2010
diff --git a/src/Fadno/Braids.hs b/src/Fadno/Braids.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Braids.hs
@@ -0,0 +1,215 @@
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+-- | Braids represented as Haskell types with support for generation and transformations.
+--
+-- = Braid Typeclass
+--
+-- `Braid` is a typeclass over the braid rep itself and its value type. Since a goal of this library is to use braids for non-mathematical purposes (ie music composition), a Braid can be indexed over any `Integral` type, to support braids representing pitch values in a register for instance.
+--
+-- = Generators
+--
+-- All braids are represented using Artin generators as `Gen`, with `Polarity` defining the "power" of a generator as `O`ver or `U`nder.
+--
+-- Generator indexes are usually 0-indexed, which differs from the 1-indexed generators in the literature. However, again these braids can represent other ranges of numbers as branch indexes.
+--
+-- = Braid instances
+--
+-- `Artin` creates canonical, "one-at-a-time", generator braids.
+--
+-- @
+-- Artin [Gen 0 O,Gen 1 U]
+-- @
+--
+-- `MultiGen` creates "compressed", "many-at-a-time" braids of `Step`s, which
+-- prevent invalid adjacent generators.
+--
+-- @
+-- MultiGen [Step (Gen 1 U) [Gen 0 U],Step (Gen 1 O) []]
+-- @
+--
+-- `DimBraid` is for creating "padded" braids, since generators cannot express the absence of a cross.
+--
+-- = Birman\/Ko\/Lee generators.
+--
+-- `bandGen` creates Birman\/Ko\/Lee-style band generators.
+--
+-- = Transformations\/Moves
+--
+-- In addition to operations like `merge` etc, the type `Move` represents Reidemeister-type isotopy moves. `makeTree` unfolds a potentially-infinite tree representing all possible applications of a move.
+--
+-- = Graphics
+--
+-- `renderBraid`, `renderBraids` and `renderStrand` allow drawings of braids, admitting extra functions for colorizing etc.
+--
+-- @
+-- renderBraid 60 [colorStrands] "braid.png" $ bandGen 0 5
+-- @
+--
+-- <<http://i.imgur.com/JsK2D1p.png>>
+--
+--
+module Fadno.Braids
+    (
+    -- * Braid Types
+     module Fadno.Braids.Internal
+    -- * Braid find\/merge\/clear
+     ,find,find',merge,mergeAt,mergeAt',clear,clearMerge
+    -- * Isotopy\/Reidemeister moves
+      ,reidemeister2,reidemeister3,findMoves,applyMove,moves,makeTree
+    -- * Band generators
+     ,bandGen
+    -- * Braid Graphics
+    ,module Fadno.Braids.Graphics
+    ) where
+import Control.Lens hiding (op,(#),Empty)
+import Fadno.Braids.Internal
+import Fadno.Braids.Graphics
+import Data.Tree
+
+
+
+
+
+
+-- | Birman, Ko, Lee "band generators" (sigma-s-t)
+bandGen :: Integral a => a -> a -> Artin a
+bandGen s t | s >= t = error "invalid, s >= t"
+            | otherwise = Artin $
+                          map (`Gen` O) (reverse [s + 1 .. t - 1]) ++
+                          [Gen s O] ++
+                          map (`Gen` U) [s + 1 .. t - 1]
+
+
+-- | Merge one braid into another at offsets.
+mergeAt :: (Integral a, Braid b a) => Int -> a -> b a -> b a -> MultiGen a
+mergeAt x y ba bb = mergeAt' x y (toGens ba) (toGens bb)
+
+-- | Matrix version.
+mergeAt' :: forall a . (Integral a) => Int -> a -> [[Gen a]] -> [[Gen a]] -> MultiGen a
+mergeAt' x y ba bb = MultiGen $ loop (offset ba) bb
+    where loop :: [[Gen a]] -> [[Gen a]] -> [Step a]
+          loop [] [] = []
+          loop (a:as) [] = gensToStep a:loop as []
+          loop [] (b:bs) = gensToStep b:loop [] bs
+          loop (a:as) (b:bs) = foldl (flip insertS) (gensToStep a) b:loop as bs
+          offset gens = replicate x [] ++ offsetGenVals y gens
+
+offsetGenVals :: Integral a => a -> [[Gen a]] -> [[Gen a]]
+offsetGenVals y = map (map (fmap (+y)))
+
+normalGenVals :: Integral a => [[Gen a]] -> [[Gen a]]
+normalGenVals gs = offsetGenVals (- (minimum . map _gPos $ concat gs)) gs
+
+-- | Rectangular gen eraser.
+clear :: Integral a => Int -> a -> Int -> a -> [[Gen a]] -> [[Gen a]]
+clear x y w h = clrx 0 where
+    clrx _ [] = []
+    clrx xi (s:ss) = (if xi >= x && xi < x + w then clry s else s):clrx (succ xi) ss
+    clry [] = []
+    clry (g@(Gen i _):gs) | i >= y && i < y + h = clry gs
+                          | otherwise = g:clry gs
+
+
+-- | Merge one braid into another.
+merge :: forall b a . (Integral a, Braid b a) => b a -> b a -> MultiGen a
+merge = mergeAt 0 0
+
+_bands :: MultiGen Int
+_bands = mergeAt 5 5 (bandGen 0 4) (bandGen 0 9)
+
+
+_testpath :: FilePath
+_testpath = "output/test.png"
+
+-- renderBraid :: Braid b a => Int -> [BraidDrawF a] -> FilePath -> b a -> IO ()
+
+_drawLoops,_drawStrands :: (Show a, Integral a, Braid b a) => b a -> IO ()
+_drawLoops = renderBraid 400 [colorLoops] _testpath
+_drawStrands = renderBraid 400 [colorStrands] _testpath
+
+
+
+
+-- | Reidemeister move 2, [s1,s1^-1] === flat
+reidemeister2 :: Integral a => Move Artin a
+reidemeister2 = Move (Artin [Gen 0 O,Gen 0 U]) (Artin [])
+
+-- | Reidemeister move 3, [s1,s2,s1^-1] === [s2^-1,s1,s2], and inverse polarity.
+-- Rule: a pattern of [(i,p),(i',p),(i,^p)] moves to [(i',^p),(i,p),(i',p)],
+-- where i' = i `op` i where op is plus or minus; with the reversed lists too.
+reidemeister3 :: Integral a => [Move Artin a]
+reidemeister3 = [ mk (zipWith Gen is ps) | ps <- [[U,U,O],[O,O,U]], is <- [[0,1,0],[1,0,1]]]
+    where mk gs = Move (Artin gs) $
+                        Artin $ over (traverse.gPos)
+                                  (\i -> if i == 0 then 1 else 0) (reverse gs)
+
+_drawReid3s :: IO ()
+_drawReid3s = renderBraids 80 [colorStrands] "output/reid3.png" $
+             map (\(Move a b) -> [a,b]) (reidemeister3 :: [Move Artin Int])
+
+
+-- drawMove (last reidemeister3) bands
+_drawMove :: (Integral i, Braid a i, Braid b i) => Move a i -> b i -> IO ()
+_drawMove m b = renderBraids 80 [colorStrands] "output/move.png"
+               [toMultiGen b:map toMultiGen [view _1 m, view _2 m],
+                --[toMultiGen b],
+                map (\l -> applyMove m l b) (findMoves m b)]
+
+
+
+
+-- | Find all locations of a sub-braid within a braid.
+find :: (Integral i, Braid a i, Braid b i) => a i -> b i -> [Loc i]
+find ba = find' (normalGenVals $ toGens ba) (stepCount ba) (strandCount ba)
+
+-- | Find all locations of a sub-braid within a braid, matrix version.
+find' :: (Integral i, Braid b i) => [[Gen i]] -> Int -> i -> b i -> [Loc i]
+find' ba w h bb = [ Loc x y | x <- [0 .. stepCount bb] ,
+                    y <- [minIndex bb .. maxIndex bb] ,
+                    test x y ]
+    where gba = normalGenVals ba
+          gbb = toGens bb
+          test x y = gbb == toGens (clearMerge gba x y w h gbb)
+
+-- | clear generators and merge. TODO: doesn't clear adjacent gens.
+clearMerge :: Integral a =>
+     [[Gen a]] -> Int -> a -> Int -> a -> [[Gen a]] -> MultiGen a
+clearMerge ba x y w h = mergeAt' x y ba . clear x y w h
+
+-- | Locates all move location in a braid.
+findMoves :: (Integral i, Braid a i, Braid b i) => Move a i -> b i -> [Loc i]
+findMoves m@(Move m1 _) = find' (toGens m1) (moveW m) (moveH m)
+
+
+-- | Apply a move at a location.
+applyMove :: (Integral i, Braid a i, Braid b i) => Move a i -> Loc i -> b i -> MultiGen i
+applyMove m@(Move _ m2) (Loc x y)  =
+    clearMerge (toGens m2) x y (moveW m) (moveH m) . toGens
+
+-- | Test a collection of moves against a braid and pair results with location.
+moves :: (Integral i, Braid a i, Braid b i) => [Move a i] -> b i -> [(Move a i,[Loc i])]
+moves mvs target = filter (not . null . snd) $ map (\m -> (m, findMoves m target)) mvs
+
+
+-- | Unfold a tree of all possible move applications on a braid.
+-- A permutation is the permuted braid + the [(move,loc)]s that got us there.
+-- Thus the root is (original braid, []); children are [(b1,(move,loc))].
+makeTree :: (Integral i, Braid a i, Braid b i) =>
+            [Move a i] -> b i -> Tree (MultiGen i,[(Move a i,Loc i)])
+makeTree mvs org = unfoldTree go (toMultiGen org,[]) where
+    go n@(seed,path) = (n,concatMap (gen seed path) $ moves mvs seed)
+    gen target path (mv,locs) = map (\l -> (applyMove mv l target,(mv,l):path)) locs
+
+
+-- let t = makeTree reidemeister3 _bands
+-- let t = makeTree (reidemeister3 ++ map inverse reidemeister3) _bands
+-- renderBraids 100 [colorStrands] "allmoves.png" $ nub $ map (return.fst) $ flatten t
+
+zipTail :: (a -> a -> c) -> [a] -> [c]
+zipTail f = zipWith f <*> tail
diff --git a/src/Fadno/Braids/Graphics.hs b/src/Fadno/Braids/Graphics.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Braids/Graphics.hs
@@ -0,0 +1,168 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+-- | Diagrams for braids.
+module Fadno.Braids.Graphics
+    (
+     renderBraid, BraidDrawF,
+     renderStrand, StrandDrawF,
+     colorStrands,colorLoops,
+     gridStrand,renderBraids
+    ) where
+
+import Fadno.Braids.Internal
+import Diagrams.Prelude hiding (Index,index,width,height,over,lw,Loop)
+import Diagrams.Backend.Rasterific
+import qualified Data.List as L
+import Data.Maybe
+
+
+--
+-- Braid Drawing
+--
+
+_aBraid :: Artin Integer
+_aBraid = Artin [Gen 0 O,Gen 5 U,Gen 3 O, Gen 2 U,Gen 4 O]
+_aStrand :: Strand Integer
+_aStrand = head $ strands _aBraid
+
+_testpath :: FilePath
+_testpath = "output/test.png"
+
+_testRenderB :: IO ()
+_testRenderB = renderBraid 40 [colorStrands] _testpath _aBraid
+_testRenderS :: IO ()
+_testRenderS = renderStrand 40 [] _testpath crimson _aStrand
+
+_testRendRast :: Diagram B -> IO ()
+_testRendRast = renderRast _testpath 1000
+
+-- | Draw rows and columns of braids with specified stepWidth and draw decorators.
+renderBraids :: Braid b a => Int -> [BraidDrawF a] -> FilePath -> [[b a]] -> IO ()
+renderBraids stepWidth drawFs fpath bs =
+    renderRast fpath
+               (stepWidth * maxWidth * maxCols)
+               (reflectY $ bg white $ frame 0.2 $
+                vcat $ map (hcat . map drawB) bs)
+    where
+      maxCols = maximum $ fmap length bs
+      maxWidth = maximum $ fmap stepCount (concat bs)
+      drawB = frame 0.8 . (`drawBraid` drawFs)
+
+-- | Draw a braid with specified stepWidth and draw decorators.
+renderBraid :: Braid b a => Int -> [BraidDrawF a] -> FilePath -> b a -> IO ()
+renderBraid stepWidth drawFs fpath b =
+    renderRast fpath (stepWidth * stepCount b) (reflectY $ bg white $ frame 0.4 $ drawBraid b drawFs)
+
+-- | Draw a strand with specified stepWidth, color, and draw decorators.
+renderStrand :: Integral a => Int -> [StrandDrawF a] -> FilePath -> Colour Double -> Strand a -> IO ()
+renderStrand sw drawFs fp color s@(Strand ss _l) =
+    renderRast fp (sw * (length ss + 1))
+                   (reflectY $ bg white $ frame 0.4 $
+                    runFs drawFs $ lwO 5 $ lc color $
+                    drawStrand s)
+        where runFs = foldl1 (.) . map ($ s)
+
+renderRast :: FilePath -> Int -> Diagram B -> IO ()
+renderRast fpath imgWidth = renderRasterific fpath (mkWidth (fromIntegral imgWidth))
+
+colors :: (Ord a, Floating a) => [Colour a]
+colors = cycle [aqua, orange, deeppink, blueviolet, crimson, darkgreen, darkkhaki]
+
+type Strand' a = [(a,Polarity,a)]
+
+toStrand' :: Strand a -> Strand' a
+toStrand' (Strand [] _) = []
+toStrand' (Strand ss l) = zipWith (\(a,p) n -> (a,p,n)) ss (tail (map fst ss) ++ [l])
+
+drawStrand :: Integral a => Strand a -> Diagram B
+drawStrand s = foldMap (cap . fromVertices) $ foldl rs [[firstp (head ss)]] $
+                  zip [(0 :: Int)..] ss
+    where
+      ss = toStrand' s
+      cap = lineCap LineCapButt
+      firstp (y,_,_) = p2 (0,fromIntegral y)
+      rs [] _ = error "No Pants!"
+      rs (ps:pss) (x,(y,p,y')) | p == U = [pt 1,pt 0.6]:(pt 0.4:ps):pss
+                            | otherwise       = (pt 1:ps):pss
+          where pt = warpPt x y y'
+
+warpPt :: Integral a => Int -> a -> a -> Double -> P2 Double
+warpPt x y y' k = p2 (fromIntegral x + k, fromIntegral y `delt` k)
+    where delt | y > y' = (-)
+               | y < y' = (+)
+               | otherwise = const
+
+
+-- | A function to affect strand presentation in a braid.
+type BraidDrawF a = [Strand a] -> [Diagram B] -> [Diagram B]
+-- | A function to affect strand presentation in a single-strand image.
+type StrandDrawF a = Strand a -> Diagram B -> Diagram B
+
+-- | Color a braid's strands separately.
+colorStrands :: BraidDrawF a
+colorStrands _ = zipWith lc colors
+
+drawBraid :: Integral a => Braid b a => b a -> [BraidDrawF a] -> Diagram B
+drawBraid b fs = mconcat $ runFs fs $ map (lwO 10 . drawStrand) ss
+    where runFs = foldl1 (.) . map ($ ss)
+          ss = strands b
+
+-- | Color a braid's loops, such that looped strands have the same color.
+colorLoops :: forall a . (Eq a,Show a) => BraidDrawF a
+colorLoops ss = zipWith bs ss
+    where loops = toLoops ss
+          bs :: Strand a -> Diagram B -> Diagram B
+          bs s = lc (colors !! seqidx)
+              where seqidx = fromMaybe (error "invalid braid, strand not in seqs") $
+                             L.findIndex (elem s . _lStrands) loops
+
+{-
+labelIndex :: BraidDrawF
+labelIndex (Braid _ _ _ idx _) = zipWith f (zip idx [0..]) where
+    f :: (Int,Int) -> Diagram B -> Diagram B
+    f (v,i) = (<> alignedText 1 0.5 (show v) #
+                  fontSize (local 0.35) #
+                  moveTo (p2 (-0.3,fromIntegral i)))
+
+labelStrand :: StrandDrawF
+labelStrand (Strand _ idx) dia = foldl f dia (zip idx [(0 :: Int)..])
+    where f d (v,i) = d <> alignedText 1 0.5 (show v) #
+                      fontSize (local 0.35) #
+                      moveTo (p2 (-0.3,fromIntegral i))
+-}
+
+-- | Draw a grid behind a single strand.
+gridStrand :: Integral a => StrandDrawF a
+gridStrand s dia = (foldMap yl [0..fromIntegral yd] <>
+                                 foldMap xl [0..xd])
+                                 # lc lightgrey `beneath` dia
+    where yl,xl :: Int -> Diagram B
+          yl i = fromVertices [dp2 (0::Int,i), dp2 (xd,i)]
+          xl i = fromVertices [dp2 (i,0::Int), dp2 (i,yd)]
+          yd = maximum s - minimum s
+          xd = length (_sWeaves s)
+
+dp2 :: (Integral a, Integral a1, Num n) => (a, a1) -> P2 n
+dp2 (a,b) = p2 (fromIntegral a, fromIntegral b)
+
+{-
+strandVertex :: StrandDrawF
+strandVertex (Strand ss _) dia = foldMap f (zip ss [(0 :: Int)..]) <>
+                                 lastDot (last ss) # lwO 2 <> dia
+    where f ((v,w),i) | weft w /= UNDER = vdot i v
+                      | otherwise = mempty
+          vdot :: Int -> Int -> Diagram B
+          vdot i v = moveTo (dp2 (i,v)) $ fc black $ circle 0.1
+          lastDot (v,w) = vdot (length ss) (warpf (warp w) v 1)
+
+drawTerraceCol :: Int -> StrandDrawF
+drawTerraceCol col (Strand ss idx) dia =
+    dia <> mconcat (zipWith lc colors $ map (lwO 2 . step) $
+           terracedCol False (length idx) (ss !! col))
+    where step :: StrandStep -> Diagram B
+          step (y,w) | weft w == UNDER = fromVertices [dp2(col,y),pt 0.4] <>
+                                             fromVertices [pt 0.6, pt 1]
+                         | otherwise       = fromVertices [dp2(col,y),pt 1]
+                         where pt = warpPt col y w
+
+-}
diff --git a/src/Fadno/Braids/Internal.hs b/src/Fadno/Braids/Internal.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Braids/Internal.hs
@@ -0,0 +1,360 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TypeFamilies #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Fadno.Braids.Internal
+    (
+     -- * Generators
+     Gen(..),gPos,gPol
+     ,Polarity(..),power,complement
+     -- * Representations
+     ,Braid(..)
+     ,Artin(..),aGens
+     ,MultiGen(..),Step(..),mSteps
+    ,insertWithS,insertS,lookupS,deleteS,stepGens,stepToGens,gensToStep
+    ,DimBraid(..),dim,dBraid,dSteps,dStrands
+     -- * Strands, loops, weaves
+    ,Weave,ToWeaves(..)
+    ,Strand(..),strand,strand',strands,sWeaves,sLast
+    ,Loop(..),toLoops,lStrands
+     -- * Moves/isotopy
+    ,Move(..),inverse,moveH,moveW,Loc(..),lx,ly
+    ) where
+
+import Control.Lens hiding (Empty)
+import Numeric.Natural
+import Control.Arrow
+
+-- | Braid generator "power", as (i + 1) "over/under" i.
+-- O[ver] == power 1 (i + 1 "over" i)
+-- U[nder] = power -1 (i + 1 "under" i)
+data Polarity = U | O deriving (Eq,Show,Enum,Ord)
+
+
+-- | Polarity to signum or "power" in literature.
+power :: Integral a => Polarity -> a
+power O = 1
+power U = -1
+
+-- | Flip polarity.
+complement :: Polarity -> Polarity
+complement O = U
+complement U = O
+
+
+
+
+-- | Braid generator pairing position (absolute or relative)
+-- and polarity.
+data Gen a = Gen { _gPos :: a, _gPol :: Polarity }
+    deriving (Eq,Functor,Ord)
+instance (Show a) => Show (Gen a) where
+    show (Gen a pol) = "Gen " ++ show a ++ " " ++ show pol
+makeLenses ''Gen
+
+
+-- | Braid as "Artin generators" (one-at-a-time).
+newtype Artin a = Artin { _aGens :: [Gen a] }
+    deriving (Eq,Show,Monoid,Functor)
+instance Foldable Artin where
+    foldMap f = foldMap f . map _gPos . _aGens
+makeLenses ''Artin
+
+-- | Braid "step" of many-at-a-time generators.
+-- Absolute-head-offset-tail structure disallows
+-- invalid adjacent generators.
+-- Example: 'Step (Gen 1 U) [Gen 0 O]' translates to [s1,s3^-1].
+data Step a =
+    Empty |
+    Step {
+      -- | Absolute-indexed "top" generator
+      _sHead :: Gen a
+      -- | (offset + 2)-indexed tail generators.
+    , _sOffsets :: [Gen Natural]
+    } deriving (Eq)
+makeLenses ''Step
+instance Show a => Show (Step a) where
+    show Empty = "Empty"
+    show (Step h os) = "Step (" ++ show h ++ ") " ++ show os
+
+
+
+-- | Insert a gen at absolute index into a 'Step'.
+-- Ignores invalid indices, uses function with new, old value
+-- for update.
+insertWithS :: forall a . Integral a => (Polarity -> Polarity -> Polarity) -> Gen a -> Step a -> Step a
+insertWithS _ g Empty = Step g []
+insertWithS f (Gen k p) s@(Step (Gen hi hp) sgs)
+    | invalid hi = s
+    | k < hi = Step (Gen k p) (Gen (fromIntegral $ hi - k - 2) hp:sgs)
+    | k == hi = set (sHead.gPol) (f p hp) s
+    | otherwise = set sOffsets (ins hi sgs) s
+    where invalid i = k + 1 == i || i + 1 == k
+          ins :: a -> [Gen Natural] -> [Gen Natural]
+          ins i [] = [Gen (fromIntegral $ k - i - 2) p]
+          ins i gss@(g@(Gen gi gp):gs)
+              | invalid i' = gss
+              | k < i' = Gen (fromIntegral $ k - i - 2) p:
+                         Gen (fromIntegral $ i' - k - 2) gp:gs
+              | k == i' = set gPol (f p gp) g:gs
+              | otherwise = g:ins i' gs
+              where i' = i + fromIntegral gi + 2
+
+-- | Insert a gen at absolute index into a 'Step'.
+-- Ignores invalid indices, overwrites on update.
+insertS :: Integral a => Gen a -> Step a -> Step a
+insertS = insertWithS const
+
+-- | Lookup by absolute index in a 'Step'.
+lookupS :: Integral a => a -> Step a -> Maybe Polarity
+lookupS k = lkp . stepToGens where
+    lkp [] = Nothing
+    lkp (Gen a p:gs) | k == a = Just p
+                     | otherwise = lkp gs
+
+-- | Delete/clear a gen at absolute index.
+deleteS :: Integral a => a -> Step a -> Step a
+deleteS a = gensToStep . del . stepToGens where
+    del [] = []
+    del (g@(Gen i _):gs) | a == i = gs
+                         | otherwise = g:del gs
+
+
+
+-- | translate 'Step' to absolute-indexed gens.
+stepToGens :: Integral a => Step a -> [Gen a]
+stepToGens Empty = []
+stepToGens (Step h gs) = reverse $ foldl conv [h] gs
+    where conv rs@(Gen p' _:_) (Gen p e) = Gen (fromIntegral p + p' + 2) e:rs
+          conv _ _ = error "c'est impossible"
+
+-- | translate absolute-indexed gens to 'Step'.
+-- Drops invalid values.
+gensToStep :: (Integral a) => [Gen a] -> Step a
+gensToStep = foldl (flip insertS) Empty
+
+-- | Iso for valid constructions.
+stepGens :: Integral a => Iso' (Step a) [Gen a]
+stepGens = iso stepToGens gensToStep
+
+
+invertS :: Integral a => a -> Step a -> Step a
+invertS maxV = foldl (flip insertS) Empty . invGens . stepToGens
+    where invGens = over (traverse.gPos) (maxV -)
+
+
+
+
+
+type instance Index (Step a) = a
+type instance IxValue (Step a) = Polarity
+instance Integral a => Ixed (Step a) where
+  ix k f m = case lookupS k m of
+     Just v  -> f v <&> \v' -> insertS (Gen k v') m
+     Nothing -> pure m
+  {-# INLINE ix #-}
+
+instance Integral a => Monoid (Step a) where
+    mempty = Empty
+    a `mappend` b = foldl ins a (stepToGens b)
+        where ins s g = insertWithS (flip const) g s
+
+
+
+
+-- | Steps of many-at-a-time generators.
+newtype MultiGen a = MultiGen { _mSteps :: [Step a] }
+    deriving (Eq,Monoid)
+instance (Show a) => Show (MultiGen a) where show (MultiGen s) = "MultiGen " ++ show s
+makeLenses ''MultiGen
+
+
+-- | Braid with explicit dimensions (mainly for empty steps/strands)
+data DimBraid b a =
+    DimBraid { _dBraid :: b a, _dSteps :: Int, _dStrands :: a }
+    deriving (Eq,Show)
+instance (Monoid (b a), Integral a) => Monoid (DimBraid b a) where
+    mempty = DimBraid mempty 0 0
+    (DimBraid b1 x1 y1) `mappend` (DimBraid b2 x2 y2) =
+        DimBraid (b1 `mappend` b2) (max x1 x2) (y1 + y2)
+makeLenses ''DimBraid
+
+-- | Make 'DimBraid' using braid's dimensions.
+dim :: (Braid b a) => b a -> DimBraid b a
+dim b = DimBraid b (stepCount b) (strandCount b)
+
+
+
+
+-- | Braid representations.
+class (Integral b, Monoid (a b)) => Braid (a :: * -> *) b where
+
+    {-# MINIMAL toGens,minIndex,maxIndex,invert #-}
+
+    -- | "Length", number of "steps"/columns/artin generators.
+    stepCount :: a b -> Int
+    -- | "N", braid group index, number of strands/rows/"i"s.
+    strandCount :: a b -> b
+    -- | Common format is a series of "steps" of absolute-indexed generators.
+    toGens :: a b -> [[Gen b]]
+    -- | Minimum index (i) value
+    minIndex :: a b -> b
+    -- | Maximum index (i) value. Note this means values of (i+1) obtain, per generators.
+    maxIndex :: a b -> b
+    -- | Invert indices
+    invert :: a b -> a b
+    -- | convert to single-gen
+    toArtin :: a b -> Artin b
+    -- | convert to multi-gen
+    toMultiGen :: a b -> MultiGen b
+
+    strandCount a = (maxIndex a + 2) - minIndex a
+
+    stepCount = length . toGens -- inefficient
+
+    toArtin = Artin . concat . toGens
+
+    toMultiGen = MultiGen . map gensToStep . toGens
+
+
+
+
+instance Integral a => Braid (Artin) a where
+    toGens = map return . _aGens
+    stepCount = length . _aGens
+    minIndex (Artin []) = 0
+    minIndex b = minimum b
+    maxIndex (Artin []) = 0
+    maxIndex b = maximum b
+    invert b = over (aGens.traverse.gPos) (maxIndex b -) b
+    toArtin = id
+
+instance Integral a => Braid (MultiGen) a where
+    toGens = map stepToGens . _mSteps
+    stepCount = length . _mSteps
+    minIndex = minimum . map _gPos . concat . toGens
+    maxIndex = maximum . map _gPos . concat . toGens
+    invert b = over (mSteps.traverse) (invertS $ maxIndex b) b
+    toMultiGen = id
+
+instance (Integral a, Braid b a) => Braid (DimBraid b) a where
+    toGens b = gs ++ pad where
+        gs = toGens $ _dBraid b
+        pad = replicate (stepCount b - length gs) []
+    stepCount b = max (_dSteps b) (stepCount $ _dBraid b)
+    strandCount b = max (_dStrands b) (strandCount $ _dBraid b)
+    minIndex = minIndex . _dBraid
+    maxIndex b = minIndex b + strandCount b - 2
+    invert = over dBraid invert
+
+-- | Instruction to send the value "over" or "under" to the next value in
+-- a 'Strand' or 'Loop'. Newtyping is undesirable, want to keep Pair instances.
+type Weave a = (a,Polarity)
+
+-- | Extract a list of weaves.
+class ToWeaves w a where
+    toWeaves :: w -> [Weave a]
+instance ToWeaves [Weave a] a where
+    toWeaves = id
+
+-- | Concrete braid strand presentation as values delimited
+-- by polarities.
+data Strand a = Strand { _sWeaves :: [Weave a], _sLast :: a }
+              deriving (Eq,Show)
+makeLenses ''Strand
+instance ToWeaves (Strand a) a where
+    toWeaves = _sWeaves
+instance Functor Strand where
+    fmap f (Strand ss l) = Strand (map (first f) ss) (f l)
+instance Foldable Strand where
+    foldMap f (Strand ss l) = foldMap f (map fst ss ++ [l])
+instance Traversable Strand where
+    traverse f (Strand ss l) =
+        Strand <$> traverse (\(a,p)->(,) <$> f a <*> pure p) ss <*> f l
+
+
+
+
+-- | Extract a single strand from a braid.
+strand :: (Integral a, Braid b a) => a -> b a -> Strand a
+strand a = strand' a . toGens
+
+-- | Strand from gen matrix.
+strand' :: Integral a => a -> [[Gen a]] -> Strand a
+strand' a = foldl srch (Strand [] a) where
+    srch (Strand ss l) gs = case lkp l gs of
+                              Just (n,p) -> Strand (ss ++ [(l,p)]) n
+                              Nothing -> Strand (ss ++ [(l,O)]) l
+    lkp _ [] = Nothing
+    lkp l (Gen i p:gs) | l == i = Just (succ l,complement p)
+                         | l == succ i = Just (pred l,p)
+                         | otherwise = lkp l gs
+
+-- | Extract all strands from a braid.
+strands :: (Integral a, Braid b a) => b a -> [Strand a]
+strands b = map (`strand'` toGens b) [minIndex b..succ $ maxIndex b]
+
+-- | Capture strands into a loop, where '_sLast' of one strand
+-- is the first value of the next.
+-- Foldable instance ignores "last" values of strands (since they will equal the next head).
+newtype Loop a = Loop { _lStrands :: [Strand a] }
+            deriving (Eq,Show,Monoid,Functor)
+makeLenses ''Loop
+
+instance Foldable Loop where
+    foldMap f = foldMap f . toListOf (lStrands.traverse.sWeaves.traverse._1)
+instance ToWeaves (Loop a) a where
+    toWeaves = toListOf (lStrands.traverse.sWeaves.traverse)
+
+
+
+
+-- | Find loops in strands.
+toLoops :: (Eq a,Show a) => [Strand a] -> [Loop a]
+toLoops [] = []
+toLoops sa = reverse $
+             over (traverse.lStrands) (\s -> last s:init s) $
+             recurL [] sa where
+    shead = fst . head . _sWeaves
+    findTail s = (==shead (head s)) . _sLast
+    recurL ls [] = ls
+    recurL ls (a:as) = recurS [a] as
+        where recurS s ss =
+                  case filter (findTail s) ss of
+                    [] -> recurL (Loop s:ls) ss
+                    [t] -> recurS (t:s) (filter (not . findTail s) ss)
+                    ts -> error $ "More than one strand found with same tail: " ++ show ts
+
+
+-- | A la Reidemeister.
+data Move b i = Move (b i) (b i)
+    deriving (Eq,Show)
+instance Field1 (Move b i) (Move b i) (b i) (b i) where
+    _1 f (Move a b) = (`Move` b) <$> f a
+instance Field2 (Move b i) (Move b i) (b i) (b i) where
+    _2 f (Move a b) = Move a <$> f b
+
+-- | Flip a move
+inverse :: Move b i -> Move b i
+inverse (Move a b) = Move b a
+
+-- | Move "height" or strand count
+moveH :: Braid a i => Move a i -> i
+moveH (Move m1 m2) = max (strandCount m1) $ strandCount m2
+-- | Move "width" or step count
+moveW :: Braid a i => Move a i -> Int
+moveW (Move m1 m2) = max (stepCount m1) $ stepCount m2
+
+-- | Coordinate in braid.
+data Loc a = Loc { _lx :: Int, _ly :: a } deriving (Eq,Show,Ord)
+makeLenses ''Loc
+instance Field1 (Loc a) (Loc a) Int Int where
+    _1 f (Loc a b) = (`Loc` b) <$> f a
+instance Field2 (Loc a) (Loc a) a a where
+    _2 f (Loc a b) = Loc a <$> f b