diff --git a/Biobase/Primary/Nuc/Conversion.hs b/Biobase/Primary/Nuc/Conversion.hs
--- a/Biobase/Primary/Nuc/Conversion.hs
+++ b/Biobase/Primary/Nuc/Conversion.hs
@@ -9,8 +9,11 @@
 
 module Biobase.Primary.Nuc.Conversion where
 
+import           Control.Lens (iso, from)
 import qualified Data.Vector.Unboxed as VU
 
+import           Biobase.Types.Sequence (Transcribe(..))
+
 import           Biobase.Primary.Letter (Letter(..), Primary)
 import qualified Biobase.Primary.Nuc.DNA as D
 import qualified Biobase.Primary.Nuc.RNA as R
@@ -84,67 +87,93 @@
 
 
 
--- * Reverse-complement of characters.
+-- ** Transcription between RNA and DNA. Both on the individual sequence level,
+-- and on the level of primary sequence data.
 
--- | Produce the complement of a RNA or DNA sequence. Does intentionally
--- not work for XNA sequences as it is not possible to uniquely translate
--- @A@ into either @U@ or @T@.
+instance Transcribe (Letter R.RNA) where
+  type TranscribeTo (Letter R.RNA) = Letter D.DNA
+  transcribe = iso rnaTdna dnaTrna
+  {-# Inline transcribe #-}
 
-class Complement s t where
-    complement :: s -> t
+instance Transcribe (Letter D.DNA) where
+  type TranscribeTo (Letter D.DNA) = Letter R.RNA
+  transcribe = from transcribe
+  {-# Inline transcribe #-}
 
--- | To 'transcribe' a DNA sequence into RNA we reverse the complement of
--- the sequence.
+instance Transcribe (Primary R.RNA) where
+  type TranscribeTo (Primary R.RNA) = Primary D.DNA
+  transcribe = iso (VU.map rnaTdna) (VU.map dnaTrna)
+  {-# Inline transcribe #-}
 
-transcribe :: Primary D.DNA -> Primary R.RNA
-transcribe = VU.reverse . complement
+instance Transcribe (Primary D.DNA) where
+  type TranscribeTo (Primary D.DNA) = Primary R.RNA
+  transcribe = iso (VU.map dnaTrna) (VU.map rnaTdna)
+  {-# Inline transcribe #-}
 
-instance Complement (Letter R.RNA) (Letter R.RNA) where
-    complement = \case
-      R.A -> R.U
-      R.C -> R.G
-      R.G -> R.C
-      R.U -> R.A
-      R.N -> R.N
 
-instance Complement (Letter D.DNA) (Letter D.DNA) where
-    complement = \case
-      D.A -> D.T
-      D.C -> D.G
-      D.G -> D.C
-      D.T -> D.A
-      D.N -> D.N
-
-instance Complement (Letter D.DNA) (Letter R.RNA) where
-    complement = \case
-      D.A -> R.U
-      D.C -> R.G
-      D.G -> R.C
-      D.T -> R.A
-      D.N -> R.N
-
-instance Complement (Letter R.RNA) (Letter D.DNA) where
-    complement = \case
-      R.A -> D.T
-      R.C -> D.G
-      R.G -> D.C
-      R.U -> D.A
-      R.N -> D.N
-
-#if __GLASGOW_HASKELL__ >= 710
-instance {-# OVERLAPPING #-}
-#else
-instance
-#endif
-  ( Complement s t, VU.Unbox s, VU.Unbox t)
-  => Complement (VU.Vector s) (VU.Vector t)
-  where complement = VU.map complement
+-- TODO to be removed soon
 
-#if __GLASGOW_HASKELL__ >= 710
-instance {-# Overlappable #-}
-#else
-instance
-#endif
-  ( Complement s t, Functor f) => Complement (f s) (f t)
-  where complement = fmap complement
+---- * Reverse-complement of characters.
+--
+---- | Produce the complement of a RNA or DNA sequence. Does intentionally
+---- not work for XNA sequences as it is not possible to uniquely translate
+---- @A@ into either @U@ or @T@.
+--
+--class Complement s t where
+--    complement :: s -> t
+--
+---- | To 'transcribe' a DNA sequence into RNA we reverse the complement of
+---- the sequence.
+--
+--transcribe :: Primary D.DNA -> Primary R.RNA
+--transcribe = VU.reverse . complement
+--
+--instance Complement (Letter R.RNA) (Letter R.RNA) where
+--    complement = \case
+--      R.A -> R.U
+--      R.C -> R.G
+--      R.G -> R.C
+--      R.U -> R.A
+--      R.N -> R.N
+--
+--instance Complement (Letter D.DNA) (Letter D.DNA) where
+--    complement = \case
+--      D.A -> D.T
+--      D.C -> D.G
+--      D.G -> D.C
+--      D.T -> D.A
+--      D.N -> D.N
+--
+--instance Complement (Letter D.DNA) (Letter R.RNA) where
+--    complement = \case
+--      D.A -> R.U
+--      D.C -> R.G
+--      D.G -> R.C
+--      D.T -> R.A
+--      D.N -> R.N
+--
+--instance Complement (Letter R.RNA) (Letter D.DNA) where
+--    complement = \case
+--      R.A -> D.T
+--      R.C -> D.G
+--      R.G -> D.C
+--      R.U -> D.A
+--      R.N -> D.N
+--
+-- #if __GLASGOW_HASKELL__ >= 710
+-- instance {-# OVERLAPPING #-}
+-- #else
+-- instance
+-- #endif
+--   ( Complement s t, VU.Unbox s, VU.Unbox t)
+--   => Complement (VU.Vector s) (VU.Vector t)
+--   where complement = VU.map complement
+-- 
+-- #if __GLASGOW_HASKELL__ >= 710
+-- instance {-# Overlappable #-}
+-- #else
+-- instance
+-- #endif
+--   ( Complement s t, Functor f) => Complement (f s) (f t)
+--   where complement = fmap complement
 
diff --git a/Biobase/Primary/Nuc/DNA.hs b/Biobase/Primary/Nuc/DNA.hs
--- a/Biobase/Primary/Nuc/DNA.hs
+++ b/Biobase/Primary/Nuc/DNA.hs
@@ -1,6 +1,8 @@
 
 module Biobase.Primary.Nuc.DNA where
 
+import           Control.Category ((>>>))
+import           Control.Lens (Iso', iso)
 import           Data.Aeson
 import           Data.Char (toUpper)
 import           Data.Ix (Ix(..))
@@ -14,7 +16,6 @@
 import qualified Data.Vector.Generic as VG
 import qualified Data.Vector.Generic.Mutable as VGM
 import qualified Data.Vector.Unboxed as VU
-import           Control.Category ((>>>))
 
 import           Biobase.Primary.Bounds
 import           Biobase.Primary.Letter
@@ -70,6 +71,13 @@
   T -> 'T'
   N -> 'N'
 {-# INLINE dnaChar #-}
+
+-- | An isomorphism from 'Char' to 'Letter DNA'. This assumes that the
+-- underlying @Char@s actually represent a DNA sequence. This allows typesafe
+-- modification of DNA sequences since only @[A,C,G,T,N]@ are allowed.
+
+cdna ∷ Iso' Char (Letter DNA)
+cdna = iso charDNA dnaChar
 
 instance Show (Letter DNA) where
     show c = [dnaChar c]
diff --git a/Biobase/Primary/Nuc/RNA.hs b/Biobase/Primary/Nuc/RNA.hs
--- a/Biobase/Primary/Nuc/RNA.hs
+++ b/Biobase/Primary/Nuc/RNA.hs
@@ -1,12 +1,15 @@
 
 module Biobase.Primary.Nuc.RNA where
 
+import           Control.Category ((>>>))
+import           Control.Lens (Iso', iso)
 import           Data.Aeson
 import           Data.Char (toUpper)
 import           Data.Ix (Ix(..))
 import           Data.Primitive.Types
 import           Data.String
 import           Data.Tuple (swap)
+import qualified Data.ByteString.Builder as BB
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.ByteString.Lazy.Char8 as BSL
 import qualified Data.Text as T
@@ -14,8 +17,6 @@
 import qualified Data.Vector.Generic as VG
 import qualified Data.Vector.Generic.Mutable as VGM
 import qualified Data.Vector.Unboxed as VU
-import           Control.Category ((>>>))
-import qualified Data.ByteString.Builder as BB
 
 import           Biobase.Primary.Bounds
 import           Biobase.Primary.Letter
@@ -84,6 +85,13 @@
   U -> 'U'
   N -> 'N'
 {-# INLINE rnaChar #-}            
+
+-- | An isomorphism from 'Char' to 'Letter RNA'. This assumes that the
+-- underlying @Char@s actually represent an RNA sequence. This allows typesafe
+-- modification of RNA sequences since only @[A,C,G,U,N]@ are allowed.
+
+crna ∷ Iso' Char (Letter RNA)
+crna = iso charRNA rnaChar
 
 instance Show (Letter RNA) where
     show c = [rnaChar c]
diff --git a/Biobase/Secondary.hs b/Biobase/Secondary.hs
--- a/Biobase/Secondary.hs
+++ b/Biobase/Secondary.hs
@@ -1,19 +1,19 @@
 
 module Biobase.Secondary
-  ( module Biobase.Secondary.Basepair
-  , module Biobase.Secondary.Constraint
+--  ( module Biobase.Secondary.Basepair
+  ( module Biobase.Secondary.Constraint
   , module Biobase.Secondary.Diagrams
   , module Biobase.Secondary.Isostericity
   , module Biobase.Secondary.Pseudoknots
   , module Biobase.Secondary.Structure
-  , module Biobase.Secondary.Vienna
+--  , module Biobase.Secondary.Vienna
   ) where
 
-import Biobase.Secondary.Basepair
+--import Biobase.Secondary.Basepair
 import Biobase.Secondary.Constraint
 import Biobase.Secondary.Diagrams
 import Biobase.Secondary.Isostericity
 import Biobase.Secondary.Pseudoknots
 import Biobase.Secondary.Structure
-import Biobase.Secondary.Vienna
+--import Biobase.Secondary.Vienna
 
diff --git a/Biobase/Secondary/Basepair.hs b/Biobase/Secondary/Basepair.hs
--- a/Biobase/Secondary/Basepair.hs
+++ b/Biobase/Secondary/Basepair.hs
@@ -1,12 +1,11 @@
 
-{-# LANGUAGE FunctionalDependencies #-}
-
--- {-# LANGUAGE OverlappingInstances #-}
-
 -- | Secondary structure: define basepairs as Int-tuples, the three edges, a
 -- nucleotide can use for pairing and the cis/trans isomerism. Both edges and
 -- cis/trans come with a tag for "unknown".
 --
+-- Since we often want to make "pairedness" explicit, we have a newtype for
+-- this as well.
+--
 -- TODO set ext-annotations to be (isomerism,edge,edge) and have a asString
 -- instance to read "cWW" "tSH" and other notation.
 
@@ -18,8 +17,9 @@
 import           Data.Ix (Ix(..))
 import           Data.List as L
 import           Data.Primitive.Types
-import           Data.Serialize
+import           Data.Serialize (Serialize)
 import           Data.Tuple (swap)
+import           Data.Vector.Fusion.Stream.Monadic (map,Step(..))
 import           Data.Vector.Unboxed.Deriving
 import           GHC.Base (remInt,quotInt)
 import           GHC.Generics
@@ -28,10 +28,93 @@
 import qualified Data.Vector.Unboxed as VU
 import           Text.Read
 
+import           Data.PrimitiveArray hiding (Complement(..),map)
+
 import           Biobase.Primary
+import           Biobase.Primary.Nuc.RNA
+import           Biobase.Primary.Nuc
 
 
 
+-- * Newtype for efficient basepair encoding.
+
+-- | Encode a base pair as a single @Int@.
+
+newtype Basepair = BP { getBP :: Int }
+  deriving (Eq,Ord,Ix,Generic)
+
+derivingUnbox "Basepair"
+  [t| Basepair -> Int |] [| getBP |] [| BP |]
+
+instance Binary    Basepair
+instance Serialize Basepair
+instance FromJSON  Basepair
+instance ToJSON    Basepair
+
+deriving instance Index Basepair
+
+instance IndexStream z => IndexStream (z:.Basepair) where
+  streamUp (ls:.BP l) (hs:.BP h) = flatten mk step $ streamUp ls hs
+    where mk z = return (z,l)
+          step (z,k)
+            | k > h     = return $ Done
+            | otherwise = return $ Yield (z:.BP k) (z,k+1)
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+  {-# Inline streamUp #-}
+  streamDown (ls:.BP l) (hs:.BP h) = flatten mk step $ streamDown ls hs
+    where mk z = return (z,h)
+          step (z,k)
+            | k < l     = return $ Done
+            | otherwise = return $ Yield (z:.BP k) (z,k-1)
+          {-# Inline [0] mk   #-}
+          {-# Inline [0] step #-}
+  {-# Inline streamDown #-}
+
+instance IndexStream Basepair
+
+pattern AA   = BP  0
+pattern AC   = BP  1
+pattern AG   = BP  2
+pattern AU   = BP  3
+pattern CA   = BP  4
+pattern CC   = BP  5
+pattern CG   = BP  6
+pattern CU   = BP  7
+pattern GA   = BP  8
+pattern GC   = BP  9
+pattern GG   = BP 10
+pattern GU   = BP 11
+pattern UA   = BP 12
+pattern UC   = BP 13
+pattern UG   = BP 14
+pattern UU   = BP 15
+pattern NS   = BP 16
+pattern NoBP = BP 17
+
+{-
+class MkBasepair a where
+  mkBasepair :: a -> Basepair
+  fromBasepair :: Basepair -> a
+
+-- | If we get a "legal" base pair, we just create it, all other
+-- combinations yield 'NoBP'. Non-standard base pairs have to be created
+-- explicitly using @NS@. When going back to @a@, non-standard and no pair
+-- yield @(N,N)@.
+
+instance MkBasepair (Letter RNA,Letter RNA) where
+  mkBasepair (l,r)
+    | l >= A && l <= U && r >= A && r <= U
+    = BP $ 4 * getLetter l + getLetter r
+    | otherwise = NoBP
+  fromBasepair k
+    | k == NoBP || k == NS = (N,N)
+    | otherwise = let (l,r) = getBP k `divMod` 4 in (Letter l, Letter r)
+  {-# Inline mkBasepair #-}
+  {-# Inline fromBasepair #-}
+-}
+
+
 -- * Newtypes for extended secondary structures
 
 -- ** Encode which of three edges is engaged in base pairing
@@ -51,41 +134,7 @@
 instance FromJSON  Edge
 instance ToJSON    Edge
 
--- TODO Index instances!
 
-{-
-instance (Shape sh,Show sh) => Shape (sh :. Edge) where
-  rank (sh:._) = rank sh + 1
-  zeroDim = zeroDim:.Edge 0
-  unitDim = unitDim:.Edge 1 -- TODO does this one make sense?
-  intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2
-  addDim (sh1:.Edge n1) (sh2:.Edge n2) = addDim sh1 sh2 :. Edge (n1+n2) -- TODO will not necessarily yield a valid Edge
-  size (sh1:.Edge n) = size sh1 * n
-  sizeIsValid (sh1:.Edge n) = sizeIsValid (sh1:.n)
-  toIndex (sh1:.Edge sh2) (sh1':.Edge sh2') = toIndex (sh1:.sh2) (sh1':.sh2')
-  fromIndex (ds:.Edge d) n = fromIndex ds (n `quotInt` d) :. Edge r where
-                              r | rank ds == 0 = n
-                                | otherwise    = n `remInt` d
-  inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i<n2 && inShapeRange sh1 sh2 idx
-  listOfShape (sh:.Edge n) = n : listOfShape sh
-  shapeOfList xx = case xx of
-    []   -> error "empty list in shapeOfList/Primary"
-    x:xs -> shapeOfList xs :. Edge x
-  deepSeq (sh:.n) x = deepSeq sh (n `seq` x)
-  {-# INLINE rank #-}
-  {-# INLINE zeroDim #-}
-  {-# INLINE unitDim #-}
-  {-# INLINE intersectDim #-}
-  {-# INLINE addDim #-}
-  {-# INLINE size #-}
-  {-# INLINE sizeIsValid #-}
-  {-# INLINE toIndex #-}
-  {-# INLINE fromIndex #-}
-  {-# INLINE inShapeRange #-}
-  {-# INLINE listOfShape #-}
-  {-# INLINE shapeOfList #-}
-  {-# INLINE deepSeq #-}
--}
 
 -- | Human-readable Show instance.
 
@@ -131,42 +180,7 @@
 instance FromJSON  CTisomerism
 instance ToJSON    CTisomerism
 
--- TODO Index instances
 
-{-
-instance (Shape sh,Show sh) => Shape (sh :. CTisomerism) where
-  rank (sh:._) = rank sh + 1
-  zeroDim = zeroDim:.CT 0
-  unitDim = unitDim:.CT 1 -- TODO does this one make sense?
-  intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2
-  addDim (sh1:.CT n1) (sh2:.CT n2) = addDim sh1 sh2 :. CT (n1+n2) -- TODO will not necessarily yield a valid CT
-  size (sh1:.CT n) = size sh1 * n
-  sizeIsValid (sh1:.CT n) = sizeIsValid (sh1:.n)
-  toIndex (sh1:.CT sh2) (sh1':.CT sh2') = toIndex (sh1:.sh2) (sh1':.sh2')
-  fromIndex (ds:.CT d) n = fromIndex ds (n `quotInt` d) :. CT r where
-                              r | rank ds == 0 = n
-                                | otherwise    = n `remInt` d
-  inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i<n2 && inShapeRange sh1 sh2 idx
-  listOfShape (sh:.CT n) = n : listOfShape sh
-  shapeOfList xx = case xx of
-    []   -> error "empty list in shapeOfList/Primary"
-    x:xs -> shapeOfList xs :. CT x
-  deepSeq (sh:.n) x = deepSeq sh (n `seq` x)
-  {-# INLINE rank #-}
-  {-# INLINE zeroDim #-}
-  {-# INLINE unitDim #-}
-  {-# INLINE intersectDim #-}
-  {-# INLINE addDim #-}
-  {-# INLINE size #-}
-  {-# INLINE sizeIsValid #-}
-  {-# INLINE toIndex #-}
-  {-# INLINE fromIndex #-}
-  {-# INLINE inShapeRange #-}
-  {-# INLINE listOfShape #-}
-  {-# INLINE shapeOfList #-}
-  {-# INLINE deepSeq #-}
--}
-
 -- | Human-readable Show instance.
 
 instance Show CTisomerism where
@@ -241,72 +255,4 @@
 pattern TWH = (Trn,W,H)
 pattern TWS = (Trn,W,S)
 pattern TWW = (Trn,W,W)
-
-
-
--- * tuple-like selection
---
--- the 'lens' library provides combinators that should make this
--- superfluous.
-
--- | Selection of nucleotides and/or type classes independent of which type we
--- are looking at.
-
-class BaseSelect a b | a -> b where
-  -- |  select first index or nucleotide
-  baseL :: a -> b
-  -- | select second index or nucleotide
-  baseR :: a -> b
-  -- | select both nucleotides as pair
-  baseP :: a -> (b,b)
-  -- | select basepair type if existing or return default cWW
-  baseT :: a -> ExtPairAnnotation
-  -- | update first index or nucleotide
-  updL :: b -> a -> a
-  -- | update second index or nucleotide
-  updR :: b -> a -> a
-  -- | update complete pair
-  updP :: (b,b) -> a -> a
-  -- | update basepair type, error if not possible due to type a
-  updT :: ExtPairAnnotation -> a -> a
-
--- | extended pairtype annotation given
-
-instance BaseSelect ((a,a),ExtPairAnnotation) a where
-  baseL ((a,_),_) = a
-  baseR ((_,b),_) = b
-  baseP (lr   ,_) = lr
-  baseT (_,t) = t
-  updL n ((_,y),t) = ((n,y),t)
-  updR n ((x,_),t) = ((x,n),t)
-  updP n (_,t)     = (n,t)
-  updT n (xy,_) = (xy,n)
-  {-# INLINE baseL #-}
-  {-# INLINE baseR #-}
-  {-# INLINE baseP #-}
-  {-# INLINE baseT #-}
-  {-# INLINE updL #-}
-  {-# INLINE updR #-}
-  {-# INLINE updP #-}
-  {-# INLINE updT #-}
-
--- | simple cis/wc-wc basepairs
-
-instance BaseSelect (a,a) a where
-  baseL (a,_) = a
-  baseR (_,a) = a
-  baseP = id
-  baseT _ = CWW
-  updL n (_,y) = (n,y)
-  updR n (x,_) = (x,n)
-  updP n _     = n
-  updT n xy = if n==CWW then xy else error $ "updT on standard pairs can not update to: " ++ show n
-  {-# INLINE baseL #-}
-  {-# INLINE baseR #-}
-  {-# INLINE baseP #-}
-  {-# INLINE baseT #-}
-  {-# INLINE updL #-}
-  {-# INLINE updR #-}
-  {-# INLINE updP #-}
-  {-# INLINE updT #-}
 
diff --git a/Biobase/Secondary/Convert.hs b/Biobase/Secondary/Convert.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/Secondary/Convert.hs
@@ -0,0 +1,91 @@
+
+-- | This module gives functionality to convert between different variants
+-- of secondary structure elements.
+
+module Biobase.Secondary.Convert where
+
+import           Biobase.Primary.Letter
+import           Biobase.Primary.Nuc.RNA
+import           Biobase.Secondary.Basepair
+import           Biobase.Secondary.Vienna (ViennaPair(..))
+import qualified Biobase.Secondary.Vienna as SV
+import qualified Biobase.Secondary.Basepair as SB
+
+
+
+-- | @basepairConvert@ converts between different secondary structure base
+-- pair representations. In general, the conversion is lossy, in particular
+-- when "downsizing", say to @ViennaPair@.
+
+class BasepairConvert a b where
+  basepairConvert :: a -> b
+
+
+
+-- ** @(RNA,RNA) <-> Basepair@
+
+instance BasepairConvert (Letter RNA,Letter RNA) Basepair where
+  basepairConvert (l,r)
+    | l >= A && l <= U && r >= A && r <= U
+    = BP $ 4 * getLetter l + getLetter r
+    | otherwise = NoBP
+  {-# Inline basepairConvert #-}
+
+instance BasepairConvert Basepair (Letter RNA, Letter RNA) where
+  basepairConvert k
+    | k == NoBP || k == NS = (N,N)
+    | otherwise = let (l,r) = getBP k `divMod` 4 in (Letter l, Letter r)
+  {-# Inline basepairConvert #-}
+
+
+
+-- ** @(RNA,RNA) <-> ViennaPair@
+
+instance BasepairConvert (Letter RNA, Letter RNA) ViennaPair where
+  basepairConvert = \case
+    (C,G) -> SV.CG
+    (G,C) -> SV.GC
+    (G,U) -> SV.GU
+    (U,G) -> SV.UG
+    (A,U) -> SV.AU
+    (U,A) -> SV.UA
+    _     -> SV.NS
+  {-# Inline basepairConvert #-}
+
+instance BasepairConvert ViennaPair (Letter RNA, Letter RNA) where
+  basepairConvert = \case
+    SV.CG -> (C,G)
+    SV.GC -> (G,C)
+    SV.GU -> (G,U)
+    SV.UG -> (U,G)
+    SV.AU -> (A,U)
+    SV.UA -> (U,A)
+    SV.NS -> (N,N)
+  {-# Inline basepairConvert #-}
+
+
+
+-- ** @Basepair <-> ViennaPair@
+
+instance BasepairConvert Basepair ViennaPair where
+  basepairConvert = \case
+    SB.AU -> SV.AU
+    SB.CG -> SV.CG
+    SB.GC -> SV.GC
+    SB.GU -> SV.GU
+    SB.UA -> SV.UA
+    SB.UG -> SV.UG
+    _     -> SV.NS
+  {-# Inline basepairConvert #-}
+
+instance BasepairConvert ViennaPair Basepair where
+  basepairConvert = \case
+    SV.AU -> SB.AU
+    SV.CG -> SB.CG
+    SV.GC -> SB.GC
+    SV.GU -> SB.GU
+    SV.UA -> SB.UA
+    SV.UG -> SB.UG
+    _     -> SB.NS
+  {-# Inline basepairConvert #-}
+
diff --git a/Biobase/Secondary/Diagrams.hs b/Biobase/Secondary/Diagrams.hs
--- a/Biobase/Secondary/Diagrams.hs
+++ b/Biobase/Secondary/Diagrams.hs
@@ -30,6 +30,8 @@
 -- | RNA secondary structure with 1-diagrams. Each nucleotide is paired with at
 -- most one other nucleotide. A nucleotide with index @k@ in @[0..len-1]@ is
 -- paired if @unD1S VU.! k >=0 0@ Unpaired status is @-1@.
+--
+-- TODO Provide @iso@ between @D1Secondary@ and @RNAss@.
 
 newtype D1Secondary = D1S {unD1S :: VU.Vector Int}
   deriving (Read,Show,Eq,Generic,NFData)
diff --git a/Biobase/Secondary/Isostericity.hs b/Biobase/Secondary/Isostericity.hs
--- a/Biobase/Secondary/Isostericity.hs
+++ b/Biobase/Secondary/Isostericity.hs
@@ -16,6 +16,7 @@
 import           Data.FileEmbed (embedFile)
 import           Data.Function (on)
 import           Data.List
+import           Data.Tuple.Select
 import qualified Data.ByteString.Char8 as BS
 import qualified Data.Map as M
 import           Text.CSV
@@ -58,11 +59,10 @@
     | Just cs <- M.lookup (p,CWW) defaultIsostericityMap
     = cs
     | otherwise = []
-  inClass x = map (baseP.fst) -- remove extended information
-            . filter ((CWW==).baseT.fst) -- keep only cWW pairs (baseT-ype)
-            . filter ((x `elem`).snd) -- select based on class
+  inClass x = map (sel1 . fst)            -- remove extended information
+            . filter ((CWW==). snd . fst) -- keep only cWW pairs (baseT-ype)
+            . filter ((x `elem`).snd)     -- select based on class
             $ M.assocs defaultIsostericityMap
-
 
 
 -- ** default data
diff --git a/Biobase/Secondary/New.hs b/Biobase/Secondary/New.hs
new file mode 100644
--- /dev/null
+++ b/Biobase/Secondary/New.hs
@@ -0,0 +1,101 @@
+
+-- | New parsers and structures for secondary structures. The structures here a strict.
+--
+-- TODO Parser should check if a @#Vienna Secondary Structure@ or @#Extended Secondary Structure@ precedes the entries.
+
+module Biobase.Secondary.New where
+
+import Control.Applicative
+import Control.Lens
+import Control.Monad.Except
+import Data.Attoparsec.ByteString.Char8
+import Data.ByteString.Char8 (ByteString,pack)
+import Data.Functor
+import Data.Tree
+import Data.Vector (Vector, fromList)
+import GHC.Generics (Generic)
+
+
+
+-- | A completely closed sub-structure. An unpaired region @.@ is closed. A
+-- paired region @(r)@ is closed, where @r@ contains arbitrarily many unpaired
+-- and paired elements.
+--
+-- TODO Should be extended with @Extended@, but this requires knowing which of
+-- the ends overlap with paired: left, right, or both.
+
+data SubStructure (t ∷ k) a
+  = Unpaired { _label ∷ !a }
+  | Paired   { _label ∷ !a, _subStructures ∷ !(Vector (SubStructure t a)) }
+  deriving (Show, Read, Functor, Traversable, Foldable, Generic, Eq, Ord)
+makeLenses ''SubStructure
+makePrisms ''SubStructure
+
+-- | A full structure is composed of a number of sub-structures. The empty
+-- structure is a full structure.
+
+newtype FullStructure (t ∷ k) a
+  = FullStructure { _fullStructure ∷ Vector (SubStructure t a) }
+  deriving (Show, Read, Functor, Traversable, Foldable, Generic, Eq, Ord)
+makeLenses ''FullStructure
+
+
+
+-- ** Parses a ViennaRNA secondary structure string.
+
+pUnpaired ∷ Parser (SubStructure () ())
+pUnpaired = Unpaired () <$ char '.'
+{-# Inlinable pUnpaired #-}
+
+pPaired ∷ Parser (SubStructure () ())
+pPaired = Paired () <$ char '(' <*> (fromList <$> many pSubStructure) <* char ')'
+{-# Inlinable pPaired #-}
+
+pSubStructure ∷ Parser (SubStructure () ())
+pSubStructure = pUnpaired <|> pPaired
+{-# Inlinable pSubStructure #-}
+
+pFullStructure ∷ Parser (FullStructure () ())
+pFullStructure = FullStructure <$> fromList <$> many pSubStructure <* endOfInput
+{-# Inlinable pFullStructure #-}
+
+newtype StructureParseError = StructureParseError String
+  deriving (Show)
+
+parseVienna ∷ MonadError StructureParseError m ⇒ ByteString → m (FullStructure () ())
+parseVienna = either (throwError . StructureParseError) return . parseOnly pFullStructure
+{-# Inlinable parseVienna #-}
+
+
+
+-- ** Transform into a @Tree@.
+
+-- | Transform a 'FullStructure' into a 'Tree'.
+--
+-- Given a full structure generated like this:
+-- @
+-- s = either (error . show) id $ parseVienna $ pack ".()(())."
+-- @
+--
+-- a tree of just the base paired can be created with
+-- @
+-- toTree (preview (_Paired._1)) () s
+-- @
+
+toTree
+  ∷ (SubStructure t a → Maybe b)
+  -- ^ how to handle substructure elements? @Nothing@ means discard this
+  -- substructure and all children.
+  → b
+  -- ^ The root label
+  → FullStructure (t ∷ k) a
+  -- ^ The @FullStructure@ to transform into a @Tree@.
+  → Tree b
+toTree f r (FullStructure ts) = Node r $ fmap go ts ^.. traverse . _Just
+  where
+    go u@Unpaired{} = (`Node` []) <$> f u
+    go p@Paired{}   = case f p of
+      Nothing  → Nothing
+      Just lbl → Just $ Node lbl $ (fmap go $ p^.subStructures) ^.. traverse . _Just
+{-# Inlinable toTree #-}
+
diff --git a/Biobase/Secondary/Vienna.hs b/Biobase/Secondary/Vienna.hs
--- a/Biobase/Secondary/Vienna.hs
+++ b/Biobase/Secondary/Vienna.hs
@@ -75,52 +75,6 @@
 
 
 
-{-
-instance (Shape sh,Show sh) => Shape (sh :. ViennaPair) where
-  rank (sh:._) = rank sh + 1
-  zeroDim = zeroDim:.ViennaPair 0
-  unitDim = unitDim:.ViennaPair 1 -- TODO does this one make sense?
-  intersectDim (sh1:.n1) (sh2:.n2) = intersectDim sh1 sh2 :. min n1 n2
-  addDim (sh1:.ViennaPair n1) (sh2:.ViennaPair n2) = addDim sh1 sh2 :. ViennaPair (n1+n2) -- TODO will not necessarily yield a valid ViennaPair
-  size (sh1:.ViennaPair n) = size sh1 * n
-  sizeIsValid (sh1:.ViennaPair n) = sizeIsValid (sh1:.n)
-  toIndex (sh1:.ViennaPair sh2) (sh1':.ViennaPair sh2') = toIndex (sh1:.sh2) (sh1':.sh2')
-  fromIndex (ds:.ViennaPair d) n = fromIndex ds (n `quotInt` d) :. ViennaPair r where
-                              r | rank ds == 0 = n
-                                | otherwise    = n `remInt` d
-  inShapeRange (sh1:.n1) (sh2:.n2) (idx:.i) = i>=n1 && i<n2 && inShapeRange sh1 sh2 idx
-  listOfShape (sh:.ViennaPair n) = n : listOfShape sh
-  shapeOfList xx = case xx of
-    []   -> error "empty list in shapeOfList/Primary"
-    x:xs -> shapeOfList xs :. ViennaPair x
-  deepSeq (sh:.n) x = deepSeq sh (n `seq` x)
-  {-# INLINE rank #-}
-  {-# INLINE zeroDim #-}
-  {-# INLINE unitDim #-}
-  {-# INLINE intersectDim #-}
-  {-# INLINE addDim #-}
-  {-# INLINE size #-}
-  {-# INLINE sizeIsValid #-}
-  {-# INLINE toIndex #-}
-  {-# INLINE fromIndex #-}
-  {-# INLINE inShapeRange #-}
-  {-# INLINE listOfShape #-}
-  {-# INLINE shapeOfList #-}
-  {-# INLINE deepSeq #-}
-
-instance (Eq sh, Shape sh, Show sh, ExtShape sh) => ExtShape (sh :. ViennaPair) where
-  subDim (sh1:.ViennaPair n1) (sh2:.ViennaPair n2) = subDim sh1 sh2 :. (ViennaPair $ n1-n2)
-  rangeList (sh1:.ViennaPair n1) (sh2:.ViennaPair n2) = [sh:.ViennaPair n | sh <- rangeList sh1 sh2, n <- [n1 .. (n1+n2)]]
-  rangeStream (fs:.ViennaPair f) (ts:.ViennaPair t) = VM.flatten mk step Unknown $ rangeStream fs ts where
-    mk sh = return (sh :. f)
-    step (sh :. k)
-      | k>t       = return $ VM.Done
-      | otherwise = return $ VM.Yield (sh :. ViennaPair k) (sh :. k +1)
-    {-# INLINE [1] mk #-}
-    {-# INLINE [1] step #-}
-  {-# INLINE rangeStream #-}
--}
-
 pattern    NP = ViennaPair 0 :: ViennaPair
 pattern    CG = ViennaPair 1 :: ViennaPair
 pattern    GC = ViennaPair 2 :: ViennaPair
@@ -128,9 +82,11 @@
 pattern    UG = ViennaPair 4 :: ViennaPair
 pattern    AU = ViennaPair 5 :: ViennaPair
 pattern    UA = ViennaPair 6 :: ViennaPair
+-- | Non-standard base pair
 pattern    NS = ViennaPair 7 :: ViennaPair
 pattern Undef = ViennaPair 8 :: ViennaPair
 
+{-
 class MkViennaPair a where
   mkViennaPair :: a -> ViennaPair
   fromViennaPair :: ViennaPair -> a
@@ -154,6 +110,7 @@
     UA -> (U,A)
     _  -> error "non-standard pairs can't be backcasted"
   {-# INLINE fromViennaPair #-}
+-}
 
 isViennaPair :: Letter RNA -> Letter RNA -> Bool
 isViennaPair l r =  l==C && r==G
diff --git a/BiobaseXNA.cabal b/BiobaseXNA.cabal
--- a/BiobaseXNA.cabal
+++ b/BiobaseXNA.cabal
@@ -1,12 +1,12 @@
 name:           BiobaseXNA
-version:        0.9.3.1
+version:        0.10.0.0
 author:         Christian Hoener zu Siederdissen
 maintainer:     choener@bioinf.uni-leipzig.de
 homepage:       https://github.com/choener/BiobaseXNA
 bug-reports:    https://github.com/choener/BiobaseXNA/issues
 copyright:      Christian Hoener zu Siederdissen, 2011 - 2017
 category:       Bioinformatics
-synopsis:       Efficient RNA/DNA representations
+synopsis:       Efficient RNA/DNA/Protein Primary/Secondary Structure
 license:        GPL-3
 license-file:   LICENSE
 build-type:     Simple
@@ -48,7 +48,8 @@
 
 library
   build-depends: base                     >= 4.7      &&  < 5.0
-               , aeson                    >= 0.8
+               , aeson                    >= 1.0
+               , attoparsec               >= 0.13
                , binary                   >= 0.7
                , bytes                    >= 0.15
                , bytestring               >= 0.10
@@ -60,6 +61,7 @@
                , file-embed               >= 0.0.8
                , hashable                 >= 1.2
                , lens                     >= 4.0
+               , mtl                      >= 2.0
                , primitive                >= 0.5
                , QuickCheck               >= 2.7
                , split                    >= 0.2
@@ -70,6 +72,8 @@
                , vector-th-unbox          >= 0.2
                --
                , bimaps                   == 0.1.0.*
+               , BiobaseTypes             == 0.1.3.*
+               , ForestStructures         == 0.0.0.*
                , PrimitiveArray           == 0.8.0.*
   exposed-modules:
     Biobase.Primary
@@ -87,8 +91,10 @@
     Biobase.Primary.Trans
     Biobase.Primary.Unknown
     Biobase.Secondary
+    Biobase.Secondary.New
     Biobase.Secondary.Basepair
     Biobase.Secondary.Constraint
+    Biobase.Secondary.Convert
     Biobase.Secondary.Diagrams
     Biobase.Secondary.Isostericity
     Biobase.Secondary.Pseudoknots
@@ -101,13 +107,19 @@
                     , FlexibleInstances
                     , GeneralizedNewtypeDeriving
                     , LambdaCase
+                    , PolyKinds
+                    , DeriveFunctor
+                    , DeriveTraversable
+                    , DeriveGeneric
                     , MultiParamTypeClasses
                     , PatternSynonyms
                     , ScopedTypeVariables
+                    , StandaloneDeriving
                     , TemplateHaskell
                     , TypeFamilies
                     , TypeOperators
                     , UndecidableInstances
+                    , UnicodeSyntax
                     , ViewPatterns
   default-language:
     Haskell2010
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,3 +1,8 @@
+0.10.0.0
+--------
+
+- redesigned Biobase.Secondary.Basepair
+
 0.9.3.1
 -------