diff --git a/Music/Theory/Array.hs b/Music/Theory/Array.hs
deleted file mode 100644
--- a/Music/Theory/Array.hs
+++ /dev/null
@@ -1,90 +0,0 @@
-module Music.Theory.Array where
-
-import Data.List {- base -}
-import qualified Data.Array as A {- array -}
-
-import qualified Music.Theory.List as T {- hmt -}
-
--- * Association List (List Array)
-
-larray_bounds :: Ord k => [(k,v)] -> (k,k)
-larray_bounds = T.minmax . map fst
-
-larray :: A.Ix k => [(k,v)] -> A.Array k v
-larray a = A.array (larray_bounds a) a
-
--- * List Table
-
--- | Append a sequence of /nil/ (or default) values to each row of /tbl/
--- so to make it regular (ie. all rows of equal length).
-make_regular :: t -> [[t]] -> [[t]]
-make_regular k tbl =
-    let z = maximum (map length tbl)
-    in map (T.pad_right k z) tbl
-
--- * Matrix Indices
-
--- | Matrix dimensions are written (rows,columns).
-type Dimensions i = (i,i)
-
--- | Matrix indices are written (row,column) & are here _zero_ indexed.
-type Ix i = (i,i)
-
--- | Translate 'Ix' by row and column delta.
---
--- > ix_translate (1,2) (3,4) == (4,6)
-ix_translate :: Num t => (t,t) -> Ix t -> Ix t
-ix_translate (dr,dc) (r,c) = (r + dr,c + dc)
-
--- | Modulo 'Ix' by 'Dimensions'.
---
--- > ix_modulo (4,4) (3,7) == (3,3)
-ix_modulo :: Integral t => Dimensions t -> Ix t -> Ix t
-ix_modulo (nr,nc) (r,c) = (r `mod` nr,c `mod` nc)
-
--- | Given number of columns and row index, list row indices.
---
--- > row_indices 3 1 == [(1,0),(1,1),(1,2)]
-row_indices :: (Enum t, Num t) => t -> t -> [Ix t]
-row_indices nc r = map (\c -> (r,c)) [0 .. nc - 1]
-
--- | Given number of rows and column index, list column indices.
---
--- > column_indices 3 1 == [(0,1),(1,1),(2,1)]
-column_indices :: (Enum t, Num t) => t -> t -> [Ix t]
-column_indices nr c = map (\r -> (r,c)) [0 .. nr - 1]
-
--- | All zero-indexed matrix indices, in row order.  This is the order
--- given by 'sort'.
---
--- > matrix_indices (2,3) == [(0,0),(0,1),(0,2),(1,0),(1,1),(1,2)]
--- > sort (matrix_indices (2,3)) == matrix_indices (2,3)
-matrix_indices :: (Enum t, Num t) => Dimensions t -> [Ix t]
-matrix_indices (nr,nc) = concatMap (row_indices nc) [0 .. nr - 1 ]
-
--- | Corner indices of given 'Dimensions', in row order.
---
--- > matrix_corner_indices (2,3) == [(0,0),(0,2),(1,0),(1,2)]
-matrix_corner_indices :: Num t => Dimensions t -> [Ix t]
-matrix_corner_indices (nr,nc) = [(0,0),(0,nc - 1),(nr - 1,0),(nr - 1,nc - 1)]
-
--- | Parallelogram corner indices, given as rectangular 'Dimensions' with an
--- offset for the lower indices.
---
--- > parallelogram_corner_indices ((2,3),2) == [(0,0),(0,2),(1,2),(1,4)]
-parallelogram_corner_indices :: Num t => (Dimensions t,t) -> [Ix t]
-parallelogram_corner_indices ((nr,nc),o) = [(0,0),(0,nc - 1),(nr - 1,o),(nr - 1,nc + o - 1)]
-
--- | Apply 'ix_modulo' and 'ix_translate' for all 'matrix_indices',
--- ie. all translations of a 'shape' in row order.  The resulting 'Ix'
--- sets are not sorted and may have duplicates.
---
--- > concat (all_ix_translations (2,3) [(0,0)]) == matrix_indices (2,3)
-all_ix_translations :: Integral t => Dimensions t -> [Ix t] -> [[Ix t]]
-all_ix_translations dm ix =
-    let f z = ix_modulo dm . ix_translate z
-    in map (\dx -> map (f dx) ix) (matrix_indices dm)
-
--- | Sort sets into row order and remove duplicates.
-all_ix_translations_uniq :: Integral t => Dimensions t -> [Ix t] -> [[Ix t]]
-all_ix_translations_uniq dm = nub . map sort . all_ix_translations dm
diff --git a/Music/Theory/Array/CSV.hs b/Music/Theory/Array/CSV.hs
deleted file mode 100644
--- a/Music/Theory/Array/CSV.hs
+++ /dev/null
@@ -1,189 +0,0 @@
--- | Regular matrix array data, CSV, column & row indexing.
-module Music.Theory.Array.CSV where
-
-import qualified Data.Array as A {- array -}
-import Data.List {- base -}
-
-import qualified Text.CSV.Lazy.String as C {- lazy-csv -}
-
-import qualified Music.Theory.Array.Cell_Ref as T {- hmt -}
-import qualified Music.Theory.IO as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Tuple as T {- hmt -}
-
--- * TABLE
-
--- | When reading a CSV file is the first row a header?
-type CSV_Has_Header = Bool
-
--- | Alias for 'Char', allow characters other than @,@ as delimiter.
-type CSV_Delimiter = Char
-
--- | Alias for 'Bool', allow linebreaks in fields.
-type CSV_Allow_Linebreaks = Bool
-
--- | When writing a CSV file should the delimiters be aligned,
--- ie. should columns be padded with spaces, and if so at which side
--- of the data?
-data CSV_Align_Columns = CSV_No_Align | CSV_Align_Left | CSV_Align_Right
-
--- | CSV options.
-type CSV_Opt = (CSV_Has_Header,CSV_Delimiter,CSV_Allow_Linebreaks,CSV_Align_Columns)
-
--- | Default CSV options, no header, comma delimiter, no linebreaks, no alignment.
-def_csv_opt :: CSV_Opt
-def_csv_opt = (False,',',False,CSV_No_Align)
-
--- | Plain list representation of a two-dimensional table of /a/ in
--- row-order.  Tables are regular, ie. all rows have equal numbers of
--- columns.
-type Table a = [[a]]
-
--- | CSV table, ie. a 'Table' with 'Maybe' a header.
-type CSV_Table a = (Maybe [String],Table a)
-
--- | Read 'CSV_Table' from @CSV@ file.
-csv_table_read :: CSV_Opt -> (String -> a) -> FilePath -> IO (CSV_Table a)
-csv_table_read (hdr,delim,brk,_) f fn = do
-  s <- T.read_file_utf8 fn
-  let t = C.csvTable (C.parseDSV brk delim s)
-      p = C.fromCSVTable t
-      (h,d) = if hdr then (Just (head p),tail p) else (Nothing,p)
-  return (h,map (map f) d)
-
--- | Read 'Table' only with 'def_csv_opt'.
-csv_table_read_def :: (String -> a) -> FilePath -> IO (Table a)
-csv_table_read_def f = fmap snd . csv_table_read def_csv_opt f
-
--- | Read and process @CSV@ 'CSV_Table'.
-csv_table_with :: CSV_Opt -> (String -> a) -> FilePath -> (CSV_Table a -> b) -> IO b
-csv_table_with opt f fn g = fmap g (csv_table_read opt f fn)
-
--- | Align table according to 'CSV_Align_Columns'.
---
--- > csv_table_align CSV_No_Align [["a","row","and"],["then","another","one"]]
-csv_table_align :: CSV_Align_Columns -> Table String -> Table String
-csv_table_align align tbl =
-    let c = transpose tbl
-        n = map (maximum . map length) c
-        ext k s = let pd = replicate (k - length s) ' '
-                  in case align of
-                       CSV_No_Align -> s
-                       CSV_Align_Left -> pd ++ s
-                       CSV_Align_Right -> s ++ pd
-    in transpose (zipWith (map . ext) n c)
-
--- | Pretty-print 'CSV_Table'.
-csv_table_pp :: (a -> String) -> CSV_Opt -> CSV_Table a -> String
-csv_table_pp f (_,delim,brk,align) (hdr,tbl) =
-  let tbl' = csv_table_align align (T.mcons hdr (map (map f) tbl))
-      (_,t) = C.toCSVTable tbl'
-  in C.ppDSVTable brk delim t
-
--- | 'T.write_file_utf8' of 'csv_table_pp'.
-csv_table_write :: (a -> String) -> CSV_Opt -> FilePath -> CSV_Table a -> IO ()
-csv_table_write f opt fn csv = T.write_file_utf8 fn (csv_table_pp f opt csv)
-
--- | Write 'Table' only (no header) with 'def_csv_opt'.
-csv_table_write_def :: (a -> String) -> FilePath -> Table a -> IO ()
-csv_table_write_def f fn tbl = csv_table_write f def_csv_opt fn (Nothing,tbl)
-
--- | @0@-indexed (row,column) cell lookup.
-table_lookup :: Table a -> (Int,Int) -> a
-table_lookup t (r,c) = (t !! r) !! c
-
--- | Row data.
-table_row :: Table a -> T.Row_Ref -> [a]
-table_row t r = t !! T.row_index r
-
--- | Column data.
-table_column :: Table a -> T.Column_Ref -> [a]
-table_column t c = transpose t !! T.column_index c
-
--- | Lookup value across columns.
-table_column_lookup :: Eq a => Table a -> (T.Column_Ref,T.Column_Ref) -> a -> Maybe a
-table_column_lookup t (c1,c2) e =
-    let a = zip (table_column t c1) (table_column t c2)
-    in lookup e a
-
--- | Table cell lookup.
-table_cell :: Table a -> T.Cell_Ref -> a
-table_cell t (c,r) =
-    let (r',c') = (T.row_index r,T.column_index c)
-    in table_lookup t (r',c')
-
--- | @0@-indexed (row,column) cell lookup over column range.
-table_lookup_row_segment :: Table a -> (Int,(Int,Int)) -> [a]
-table_lookup_row_segment t (r,(c0,c1)) =
-    let r' = t !! r
-    in take (c1 - c0 + 1) (drop c0 r')
-
--- | Range of cells from row.
-table_row_segment :: Table a -> (T.Row_Ref,T.Column_Range) -> [a]
-table_row_segment t (r,c) =
-    let (r',c') = (T.row_index r,T.column_indices c)
-    in table_lookup_row_segment t (r',c')
-
--- * Array
-
--- | Translate 'Table' to 'Array'.  It is assumed that the 'Table' is
--- regular, ie. all rows have an equal number of columns.
---
--- > let a = table_to_array [[0,1,3],[2,4,5]]
--- > in (bounds a,indices a,elems a)
---
--- > > (((A,1),(C,2))
--- > > ,[(A,1),(A,2),(B,1),(B,2),(C,1),(C,2)]
--- > > ,[0,2,1,4,3,5])
-table_to_array :: Table a -> A.Array T.Cell_Ref a
-table_to_array t =
-    let nr = length t
-        nc = length (t !! 0)
-        bnd = (T.cell_ref_minima,(toEnum (nc - 1),nr))
-        asc = zip (T.cell_range_row_order bnd) (concat t)
-    in A.array bnd asc
-
--- | 'table_to_array' of 'csv_table_read'.
-csv_array_read :: CSV_Opt -> (String -> a) -> FilePath -> IO (A.Array T.Cell_Ref a)
-csv_array_read opt f fn = fmap (table_to_array . snd) (csv_table_read opt f fn)
-
--- * Irregular
-
-csv_field_str :: C.CSVField -> String
-csv_field_str f =
-    case f of
-      C.CSVField _ _ _ _ s _ -> s
-      C.CSVFieldError _ _ _ _ _ -> error "csv_field_str"
-
-csv_error_recover :: C.CSVError -> C.CSVRow
-csv_error_recover e =
-    case e of
-      C.IncorrectRow _ _ _ f -> f
-      C.BlankLine _ _ _ _ -> []
-      _ -> error "csv_error_recover: not recoverable"
-
-csv_row_recover :: Either [C.CSVError] C.CSVRow -> C.CSVRow
-csv_row_recover r =
-    case r of
-      Left [e] -> csv_error_recover e
-      Left _ -> error "csv_row_recover: multiple errors"
-      Right r' -> r'
-
--- | Read irregular @CSV@ file, ie. rows may have any number of columns, including no columns.
-csv_load_irregular :: (String -> a) -> FilePath -> IO [[a]]
-csv_load_irregular f fn = do
-  s <- T.read_file_utf8 fn
-  return (map (map (f . csv_field_str) . csv_row_recover) (C.parseCSV s))
-
--- * Tuples
-
-type P5_Parser t1 t2 t3 t4 t5 = (String -> t1,String -> t2,String -> t3,String -> t4,String -> t5)
-type P5_Writer t1 t2 t3 t4 t5 = (t1 -> String,t2 -> String,t3 -> String,t4 -> String,t5 -> String)
-
-csv_table_read_p5 :: P5_Parser t1 t2 t3 t4 t5 -> CSV_Opt -> FilePath -> IO (Maybe [String],[(t1,t2,t3,t4,t5)])
-csv_table_read_p5 f opt fn = do
-  (hdr,dat) <- csv_table_read opt id fn
-  return (hdr,map (T.p5_from_list f) dat)
-
-csv_table_write_p5 :: P5_Writer t1 t2 t3 t4 t5 -> CSV_Opt -> FilePath -> (Maybe [String],[(t1,t2,t3,t4,t5)]) -> IO ()
-csv_table_write_p5 f opt fn (hdr,dat) = csv_table_write id opt fn (hdr,map (T.p5_to_list f) dat)
diff --git a/Music/Theory/Array/CSV/Midi/MND.hs b/Music/Theory/Array/CSV/Midi/MND.hs
deleted file mode 100644
--- a/Music/Theory/Array/CSV/Midi/MND.hs
+++ /dev/null
@@ -1,203 +0,0 @@
--- | Functions for reading midi note data (MND) from CSV files.
--- This is /not/ a generic text midi notation.
--- The defined commands are @on@ and @off@, but others may be present.
--- Non-integral note number and key velocity data are allowed.
-module Music.Theory.Array.CSV.Midi.MND where
-
-import Data.List.Split {- split -}
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Data.Word {- base -}
-
-import qualified Music.Theory.Array.CSV as T {- hmt -}
-import qualified Music.Theory.Math as T {- hmt -}
-import qualified Music.Theory.Read as T {- hmt -}
-import qualified Music.Theory.Time.Seq as T {- hmt -}
-
--- | If /r/ is whole to /k/ places then show as integer, else as float to /k/ places.
-data_value_pp :: Real t => Int -> t -> String
-data_value_pp k r =
-    if T.whole_to_precision k r
-    then show (T.real_floor_int r)
-    else T.real_pp k r
-
--- | Channel values are 4-bit (0-15).
-type Channel = Word8
-
--- | The required header field.
-csv_mnd_hdr :: [String]
-csv_mnd_hdr = ["time","on/off","note","velocity","channel","param"]
-
-type Param = (String,Double)
-
-param_parse :: String -> [Param]
-param_parse str =
-    let f x = case splitOn "=" x of
-                [lhs,rhs] -> (lhs,read rhs)
-                _ -> error ("param_parse: " ++ x)
-    in if null str then [] else map f (splitOn ";" str)
-
-param_pp :: Int -> [Param] -> String
-param_pp k =
-    let f (lhs,rhs) = concat [lhs,"=",T.real_pp k rhs]
-    in intercalate ";" . map f
-
--- | Midi note data, the type parameters are to allow for fractional note & velocity values.
--- The command is a string, @on@ and @off@ are standard, other commands may be present.
---
--- > unwords csv_mnd_hdr == "time on/off note velocity channel param"
-type MND t n = (t,String,n,n,Channel,[Param])
-
-csv_mnd_parse :: (Read t,Real t,Read n,Real n) => T.CSV_Table String -> [MND t n]
-csv_mnd_parse (hdr,dat) =
-    let err x = error ("csv_mnd_read: " ++ x)
-        f m = case m of
-                [st,msg,mnn,vel,ch,pm] ->
-                    (T.reads_exact_err "time:real" st
-                    ,msg
-                    ,T.reads_exact_err "note:real" mnn
-                    ,T.reads_exact_err "velocity:real" vel
-                    ,T.reads_exact_err "channel:int" ch
-                    ,param_parse pm)
-                _ -> err "entry?"
-    in case hdr of
-         Just hdr' -> if hdr' == csv_mnd_hdr then map f dat else err "header?"
-         Nothing -> err "no header?"
-
-load_csv :: FilePath -> IO (T.CSV_Table String)
-load_csv = T.csv_table_read (True,',',False,T.CSV_No_Align) id
-
--- | Midi note data.
---
--- > let fn = "/home/rohan/cvs/uc/uc-26/daily-practice/2014-08-13.1.csv"
--- > m <- csv_mnd_read fn :: IO [MND Double Double]
--- > length m == 17655
--- > csv_mnd_write 4 "/tmp/t.csv" m
-csv_mnd_read :: (Read t,Real t,Read n,Real n) => FilePath -> IO [MND t n]
-csv_mnd_read = fmap csv_mnd_parse . load_csv
-
--- | Writer.
-csv_mnd_write :: (Real t,Real n) => Int -> FilePath -> [MND t n] -> IO ()
-csv_mnd_write r_prec nm =
-    let un_node (st,msg,mnn,vel,ch,pm) =
-            [T.real_pp r_prec st
-            ,msg
-            ,data_value_pp r_prec mnn
-            ,data_value_pp r_prec vel
-            ,show ch
-            ,param_pp r_prec pm]
-        with_hdr dat = (Just csv_mnd_hdr,dat)
-    in T.csv_table_write id T.def_csv_opt nm . with_hdr . map un_node
-
--- * MND Seq forms
-
--- | (p0=midi-note,p1=velocity,channel,param)
-type Event n = (n,n,Channel,[Param])
-
--- | Translate from 'Tseq' form to 'Wseq' form.
-midi_tseq_to_midi_wseq :: (Num t,Eq n) => T.Tseq t (T.Begin_End (Event n)) -> T.Wseq t (Event n)
-midi_tseq_to_midi_wseq = T.tseq_begin_end_to_wseq (\(n0,_,c0,_) (n1,_,c1,_) -> c0 == c1 && n0 == n1)
-
-midi_wseq_to_midi_tseq :: (Num t,Ord t) => T.Wseq t x -> T.Tseq t (T.Begin_End x)
-midi_wseq_to_midi_tseq = T.wseq_begin_end
-
--- | Ignores non on/off messages.
-mnd_to_tseq :: Num n => [MND t n] -> T.Tseq t (T.Begin_End (Event n))
-mnd_to_tseq =
-    let mk_node (st,msg,mnn,vel,ch,pm) =
-            case msg of
-              "on" -> Just (st,T.Begin (mnn,vel,ch,pm))
-              "off" -> Just (st,T.End (mnn,0,ch,pm))
-              _ -> Nothing
-    in mapMaybe mk_node
-
--- | 'Tseq' form of 'csv_mnd_read', channel information is retained, off-velocity is zero.
-csv_mnd_read_tseq :: (Read t,Real t,Read n,Real n) => FilePath -> IO (T.Tseq t (T.Begin_End (Event n)))
-csv_mnd_read_tseq = fmap mnd_to_tseq . csv_mnd_read
-
--- | 'Tseq' form of 'csv_mnd_write', data is .
-csv_mnd_write_tseq :: (Real t,Real n) => Int -> FilePath -> T.Tseq t (T.Begin_End (Event n)) -> IO ()
-csv_mnd_write_tseq r_prec nm sq =
-    let f (t,e) = case e of
-                    T.Begin (n,v,c,p) -> (t,"on",n,v,c,p)
-                    T.End (n,_,c,p) -> (t,"off",n,0,c,p)
-    in csv_mnd_write r_prec nm (map f sq)
-
--- * MNDD (simplifies cases where overlaps on the same channel are allowed).
-
--- | Message should be @note@ for note data.
-csv_mndd_hdr :: [String]
-csv_mndd_hdr = ["time","duration","message","note","velocity","channel","param"]
-
--- > unwords csv_mndd_hdr == "time duration message note velocity channel param"
-type MNDD t n = (t,t,String,n,n,Channel,[Param])
-
-csv_mndd_parse :: (Read t,Real t,Read n,Real n) => T.CSV_Table String -> [MNDD t n]
-csv_mndd_parse (hdr,dat) =
-    let err x = error ("csv_mndd_read: " ++ x)
-        f m =
-            case m of
-              [st,du,msg,mnn,vel,ch,pm] ->
-                  (T.reads_exact_err "time" st
-                  ,T.reads_exact_err "duration" du
-                  ,msg
-                  ,T.reads_exact_err "note" mnn
-                  ,T.reads_exact_err "velocity" vel
-                  ,T.reads_exact_err "channel" ch
-                  ,param_parse pm)
-              _ -> err "entry?"
-    in case hdr of
-         Just hdr' -> if hdr' == csv_mndd_hdr then map f dat else err "header?"
-         Nothing -> err "no header?"
-
--- | Midi note/duration data.
-csv_mndd_read :: (Read t,Real t,Read n,Real n) => FilePath -> IO [MNDD t n]
-csv_mndd_read = fmap csv_mndd_parse . load_csv
-
--- | Writer.
-csv_mndd_write :: (Real t,Real n) => Int -> FilePath -> [MNDD t n] -> IO ()
-csv_mndd_write r_prec nm =
-    let un_node (st,du,msg,mnn,vel,ch,pm) =
-            [T.real_pp r_prec st,T.real_pp r_prec du,msg
-            ,data_value_pp r_prec mnn,data_value_pp r_prec vel
-            ,show ch
-            ,param_pp r_prec pm]
-        with_hdr dat = (Just csv_mndd_hdr,dat)
-    in T.csv_table_write id T.def_csv_opt nm . with_hdr . map un_node
-
--- * MNDD Seq forms
-
--- | Ignores non note messages.
-mndd_to_wseq :: [MNDD t n] -> T.Wseq t (Event n)
-mndd_to_wseq =
-    let mk_node (st,du,msg,mnn,vel,ch,pm) =
-            case msg of
-              "note" -> Just ((st,du),(mnn,vel,ch,pm))
-              _ -> Nothing
-    in mapMaybe mk_node
-
--- | 'Wseq' form of 'csv_mndd_read'.
-csv_mndd_read_wseq :: (Read t,Real t,Read n,Real n) => FilePath -> IO (T.Wseq t (Event n))
-csv_mndd_read_wseq = fmap mndd_to_wseq . csv_mndd_read
-
--- | 'Wseq' form of 'csv_mndd_write'.
-csv_mndd_write_wseq :: (Real t,Real n) => Int -> FilePath -> T.Wseq t (Event n) -> IO ()
-csv_mndd_write_wseq r_prec nm =
-    let f ((st,du),(mnn,vel,ch,pm)) = (st,du,"note",mnn,vel,ch,pm)
-    in csv_mndd_write r_prec nm . map f
-
--- * Composite
-
--- | Parse either MND or MNDD data to Wseq, CSV type is decided by header.
-csv_midi_parse_wseq :: (Read t,Real t,Read n,Real n) => T.CSV_Table String -> T.Wseq t (Event n)
-csv_midi_parse_wseq (hdr,dat) = do
-  case hdr of
-    Just hdr' -> if hdr' == csv_mnd_hdr
-                 then midi_tseq_to_midi_wseq (mnd_to_tseq (csv_mnd_parse (hdr,dat)))
-                 else if hdr' == csv_mndd_hdr
-                      then mndd_to_wseq (csv_mndd_parse (hdr,dat))
-                      else error "csv_midi_read_wseq: not MND or MNDD"
-    _ -> error "csv_midi_read_wseq: header?"
-
-csv_midi_read_wseq :: (Read t,Real t,Read n,Real n) => FilePath -> IO (T.Wseq t (Event n))
-csv_midi_read_wseq = fmap csv_midi_parse_wseq . load_csv
diff --git a/Music/Theory/Array/Cell_Ref.hs b/Music/Theory/Array/Cell_Ref.hs
deleted file mode 100644
--- a/Music/Theory/Array/Cell_Ref.hs
+++ /dev/null
@@ -1,228 +0,0 @@
--- | Cell references & indexing.
-module Music.Theory.Array.Cell_Ref where
-
-import qualified Data.Array as A {- array -}
-import Data.Char {- base -}
-import Data.Function {- base -}
-import Data.Maybe {- base -}
-import Data.String {- base -}
-
--- | @A@ indexed case-insensitive column references.  The column
--- following @Z@ is @AA@.
-data Column_Ref = Column_Ref {column_ref_string :: String}
-
-instance IsString Column_Ref where fromString = Column_Ref
-instance Read Column_Ref where readsPrec _ s = [(Column_Ref s,[])]
-instance Show Column_Ref where show = column_ref_string
-instance Eq Column_Ref where (==) = (==) `on` column_index
-instance Ord Column_Ref where compare = compare `on` column_index
-
-instance Enum Column_Ref where
-    fromEnum = column_index
-    toEnum = column_ref
-
-instance A.Ix Column_Ref where
-    range = column_range
-    index = interior_column_index
-    inRange = column_in_range
-    rangeSize = column_range_size
-
--- | Inclusive range of column references.
-type Column_Range = (Column_Ref,Column_Ref)
-
--- | @1@-indexed row reference.
-type Row_Ref = Int
-
--- | Zero index of 'Row_Ref'.
-row_index :: Row_Ref -> Int
-row_index r = r - 1
-
--- | Inclusive range of row references.
-type Row_Range = (Row_Ref,Row_Ref)
-
--- | Cell reference, column then row.
-type Cell_Ref = (Column_Ref,Row_Ref)
-
--- | Inclusive range of cell references.
-type Cell_Range = (Cell_Ref,Cell_Ref)
-
--- | Case folding letter to index function.  Only valid for ASCII letters.
---
--- > map letter_index ['A' .. 'Z'] == [0 .. 25]
--- > map letter_index ['a','d' .. 'm'] == [0,3 .. 12]
-letter_index :: Char -> Int
-letter_index c = fromEnum (toUpper c) - fromEnum 'A'
-
--- | Inverse of 'letter_index'.
---
--- > map index_letter [0,3 .. 12] == ['A','D' .. 'M']
-index_letter :: Int -> Char
-index_letter i = toEnum (i + fromEnum 'A')
-
--- | Translate column reference to @0@-index.
---
--- > :set -XOverloadedStrings
--- > map column_index ["A","c","z","ac","XYZ"] == [0,2,25,28,17575]
-column_index :: Column_Ref -> Int
-column_index (Column_Ref c) =
-    let m = iterate (* 26) 1
-        i = reverse (map letter_index c)
-    in sum (zipWith (*) m (zipWith (+) [0..] i))
-
--- | Column reference to interior index within specified range.  Type
--- specialised 'Data.Ix.index'.
---
--- > map (Data.Ix.index ('A','Z')) ['A','C','Z'] == [0,2,25]
--- > map (interior_column_index ("A","Z")) ["A","C","Z"] == [0,2,25]
---
--- > map (Data.Ix.index ('B','C')) ['B','C'] == [0,1]
--- > map (interior_column_index ("B","C")) ["B","C"] == [0,1]
-interior_column_index :: Column_Range -> Column_Ref -> Int
-interior_column_index (l,r) c =
-    let n = column_index c
-        l' = column_index l
-        r' = column_index r
-    in if n > r'
-       then error (show ("interior_column_index",l,r,c))
-       else n - l'
-
--- | Inverse of 'column_index'.
---
--- > let c = ["A","Z","AA","AZ","BA","BZ","CA"]
--- > in map column_ref [0,25,26,51,52,77,78] == c
---
--- > column_ref (0+25+1+25+1+25+1) == "CA"
-column_ref :: Int -> Column_Ref
-column_ref =
-    let rec n = case n `quotRem` 26 of
-                  (0,r) -> [index_letter r]
-                  (q,r) -> index_letter (q - 1) : rec r
-    in Column_Ref . rec
-
--- | Type specialised 'pred'.
---
--- > column_ref_pred "DF" == "DE"
-column_ref_pred :: Column_Ref -> Column_Ref
-column_ref_pred = pred
-
--- | Type specialised 'succ'.
---
--- > column_ref_succ "DE" == "DF"
-column_ref_succ :: Column_Ref -> Column_Ref
-column_ref_succ = succ
-
--- | Bimap of 'column_index'.
---
--- > column_indices ("b","p") == (1,15)
--- > column_indices ("B","IT") == (1,253)
-column_indices :: Column_Range -> (Int,Int)
-column_indices =
-    let bimap f (i,j) = (f i,f j)
-    in bimap column_index
-
--- | Type specialised 'Data.Ix.range'.
---
--- > column_range ("L","R") == ["L","M","N","O","P","Q","R"]
--- > Data.Ix.range ('L','R') == "LMNOPQR"
-column_range :: Column_Range -> [Column_Ref]
-column_range rng =
-    let (l,r) = column_indices rng
-    in map column_ref [l .. r]
-
--- | Type specialised 'Data.Ix.inRange'.
---
--- > map (column_in_range ("L","R")) ["A","N","Z"] == [False,True,False]
--- > map (column_in_range ("L","R")) ["L","N","R"] == [True,True,True]
---
--- > map (Data.Ix.inRange ('L','R')) ['A','N','Z'] == [False,True,False]
--- > map (Data.Ix.inRange ('L','R')) ['L','N','R'] == [True,True,True]
-column_in_range :: Column_Range -> Column_Ref -> Bool
-column_in_range rng c =
-    let (l,r) = column_indices rng
-        k = column_index c
-    in k >= l && k <= r
-
--- | Type specialised 'Data.Ix.rangeSize'.
---
--- > map column_range_size [("A","Z"),("AA","ZZ")] == [26,26 * 26]
--- > Data.Ix.rangeSize ('A','Z') == 26
-column_range_size :: Column_Range -> Int
-column_range_size = (+ 1) . negate . uncurry (-) . column_indices
-
--- | Type specialised 'Data.Ix.range'.
-row_range :: Row_Range -> [Row_Ref]
-row_range = A.range
-
--- | The standard uppermost leftmost cell reference, @A1@.
---
--- > Just cell_ref_minima == parse_cell_ref "A1"
-cell_ref_minima :: Cell_Ref
-cell_ref_minima = (Column_Ref "A",1)
-
--- | Cell reference parser for standard notation of (column,row).
---
--- > parse_cell_ref "CC348" == Just ("CC",348)
-parse_cell_ref :: String -> Maybe Cell_Ref
-parse_cell_ref s =
-    case span isUpper s of
-      ([],_) -> Nothing
-      (c,r) -> case span isDigit r of
-                 (n,[]) -> Just (Column_Ref c,read n)
-                 _ -> Nothing
-
-is_cell_ref :: String -> Bool
-is_cell_ref = isJust . parse_cell_ref
-
-parse_cell_ref_err :: String -> Cell_Ref
-parse_cell_ref_err = fromMaybe (error "parse_cell_ref") . parse_cell_ref
-
--- | Cell reference pretty printer.
---
--- > cell_ref_pp ("CC",348) == "CC348"
-cell_ref_pp :: Cell_Ref -> String
-cell_ref_pp (Column_Ref c,r) = c ++ show r
-
--- | Translate cell reference to @0@-indexed pair.
---
--- > cell_index ("CC",348) == (80,347)
--- > Data.Ix.index (("AA",1),("ZZ",999)) ("CC",348) == 54293
-cell_index :: Cell_Ref -> (Int,Int)
-cell_index (c,r) = (column_index c,row_index r)
-
--- | Inverse of cell_index.
---
--- > index_to_cell (80,347) == (Column_Ref "CC",348)
--- > index_to_cell (4,5) == (Column_Ref "E",6)
-index_to_cell :: (Int,Int) -> Cell_Ref
-index_to_cell (c,r) = (column_ref c,r + 1)
-
-parse_cell_index :: String -> (Int,Int)
-parse_cell_index = cell_index . parse_cell_ref_err
-
--- | Type specialised 'Data.Ix.range', cells are in column-order.
---
--- > cell_range (("AA",1),("AC",1)) == [("AA",1),("AB",1),("AC",1)]
---
--- > let r = [("AA",1),("AA",2),("AB",1),("AB",2),("AC",1),("AC",2)]
--- > in cell_range (("AA",1),("AC",2)) == r
---
--- > Data.Ix.range (('A',1),('C',1)) == [('A',1),('B',1),('C',1)]
---
--- > let r = [('A',1),('A',2),('B',1),('B',2),('C',1),('C',2)]
--- > in Data.Ix.range (('A',1),('C',2)) == r
-cell_range :: Cell_Range -> [Cell_Ref]
-cell_range ((c1,r1),(c2,r2)) =
-    [(c,r) |
-     c <- column_range (c1,c2)
-    ,r <- row_range (r1,r2)]
-
--- | Variant of 'cell_range' in row-order.
---
--- > let r = [(AA,1),(AB,1),(AC,1),(AA,2),(AB,2),(AC,2)]
--- > in cell_range_row_order (("AA",1),("AC",2)) == r
-cell_range_row_order ::  Cell_Range -> [Cell_Ref]
-cell_range_row_order ((c1,r1),(c2,r2)) =
-    [(c,r) |
-     r <- row_range (r1,r2)
-    ,c <- column_range (c1,c2)]
-
diff --git a/Music/Theory/Array/Csv/Midi/Cli.hs b/Music/Theory/Array/Csv/Midi/Cli.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Csv/Midi/Cli.hs
@@ -0,0 +1,47 @@
+module Music.Theory.Array.Csv.Midi.Cli where
+
+import qualified Music.Theory.Array.Csv.Midi.Mnd as T {- hmt -}
+import qualified Music.Theory.Time.Seq as T {- hmt -}
+
+usage :: [String]
+usage =
+  ["concat {r} -o output-file input-file..."
+  ,"mnd-to-mndd {i|r} precision:int input-file output-file"
+  ,"mndd-transpose precision:int n:int input-file output-file"]
+
+read_wseq_i :: FilePath -> IO (T.Wseq Double (T.Event Int))
+read_wseq_i = T.csv_midi_read_wseq
+
+read_wseq_r :: FilePath -> IO (T.Wseq Double (T.Event Double))
+read_wseq_r = T.csv_midi_read_wseq
+
+mnd_to_mndd_i :: Int -> FilePath -> FilePath -> IO ()
+mnd_to_mndd_i p i_fn o_fn = do
+  m <- read_wseq_i i_fn
+  T.csv_mndd_write_wseq p o_fn m
+
+mndd_transpose_r :: Int -> Double -> FilePath -> FilePath -> IO ()
+mndd_transpose_r p k i_fn o_fn = do
+  m <- read_wseq_r i_fn
+  let f (t,(mnn,vel,ch,pr)) = (t,(mnn + k,vel,ch,pr))
+  T.csv_mndd_write_wseq p o_fn (map f m)
+
+csv_midi_concat_r :: FilePath -> [FilePath] -> IO ()
+csv_midi_concat_r o_fn i_fn = do
+  i <- mapM read_wseq_r i_fn
+  T.csv_mndd_write_wseq 4 o_fn (T.wseq_concat i)
+
+csv_midi_cli :: [String] -> IO ()
+csv_midi_cli arg =
+  case arg of
+    "concat":"r":"-o":o_fn:i_fn -> csv_midi_concat_r o_fn i_fn
+    ["mnd-to-mndd","i",p,i_fn,o_fn] -> mnd_to_mndd_i (read p) i_fn o_fn
+    ["mndd-transpose","r",p,k,i_fn,o_fn] -> mndd_transpose_r (read p) (read k) i_fn o_fn
+    _ -> putStrLn (unlines usage)
+
+{-
+fn = "/home/rohan/uc/invisible/heliotrope/csv/rough/00.csv"
+mnd_to_mndd_i 4 fn "/tmp/t-mndd.csv"
+mndd_transpose_r 4 (-12) fn "/tmp/t-trs.csv"
+-}
+
diff --git a/Music/Theory/Array/Csv/Midi/Mnd.hs b/Music/Theory/Array/Csv/Midi/Mnd.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Csv/Midi/Mnd.hs
@@ -0,0 +1,270 @@
+{- | Functions for reading midi note data (Mnd) from Csv files.
+
+This is /not/ a generic text midi notation.
+The required columns are documented at `Mnd` and `Mndd`.
+The defined commands are @on@ and @off@, but others may be present.
+Non-integral note number and key velocity data are allowed.
+-}
+module Music.Theory.Array.Csv.Midi.Mnd where
+
+import Data.Function {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import Data.List.Split {- split -}
+
+import qualified Music.Theory.Array.Csv as T {- hmt-base -}
+import qualified Music.Theory.Math as T {- hmt-base -}
+import qualified Music.Theory.Read as T {- hmt-base -}
+import qualified Music.Theory.Show as T {- hmt-base -}
+
+import qualified Music.Theory.Time.Seq as T {- hmt -}
+
+-- * Param ; Sound.SC3.Server.Param
+
+type Param = [(String,Double)]
+
+param_parse :: (Char,Char) -> String -> Param
+param_parse (c1,c2) str =
+    let f x = case splitOn [c2] x of
+                [lhs,rhs] -> (lhs,read rhs)
+                _ -> error ("param_parse: " ++ x)
+    in if null str then [] else map f (splitOn [c1] str)
+
+param_pp :: (Char,Char) -> Int -> Param -> String
+param_pp (c1,c2) k =
+    let f (lhs,rhs) = concat [lhs,[c2],T.double_pp k rhs]
+    in intercalate [c1] . map f
+
+-- * Mnd
+
+-- | If /r/ is whole to /k/ places then show as integer, else as float to /k/ places.
+data_value_pp :: Real t => Int -> t -> String
+data_value_pp k r =
+    if T.whole_to_precision k r
+    then show (T.real_floor_int r)
+    else T.real_pp k r
+
+-- | Channel values are 4-bit (0-15).
+type Channel = Int
+
+-- | The required header (column names) field.
+csv_mnd_hdr :: [String]
+csv_mnd_hdr = ["time","on/off","note","velocity","channel","param"]
+
+{- | Midi note data, the type parameters are to allow for fractional note & velocity values.
+
+The command is a string, @on@ and @off@ are standard, other commands may be present.
+note and velocity data is (0-127), channel is (0-15), param are ;-separated key:string=value:float.
+
+> unwords csv_mnd_hdr == "time on/off note velocity channel param"
+
+> all_notes_off = zipWith (\t k -> (t,"off",k,0,0,[])) [0.0,0.01 ..] [0 .. 127]
+> csv_mnd_write 4 "/home/rohan/sw/hmt/data/csv/mnd/all-notes-off.csv" all_notes_off
+-}
+type Mnd t n = (t,String,n,n,Channel,Param)
+
+csv_mnd_parse_f :: (Read t,Real t,Read n,Real n) => (n -> m) -> T.Csv_Table String -> [Mnd t m]
+csv_mnd_parse_f cnv (hdr,dat) =
+    let err x = error ("csv_mnd_read: " ++ x)
+        f m = case m of
+                [st,msg,mnn,vel,ch,pm] ->
+                    (T.reads_exact_err "time:real" st
+                    ,msg
+                    ,cnv (T.reads_exact_err "note:real" mnn)
+                    ,cnv (T.reads_exact_err "velocity:real" vel)
+                    ,T.reads_exact_err "channel:int" ch
+                    ,param_parse (';','=') pm)
+                _ -> err "entry?"
+    in case hdr of
+         Just hdr' -> if hdr' == csv_mnd_hdr then map f dat else err "header?"
+         Nothing -> err "no header?"
+
+csv_mnd_parse :: (Read t,Real t,Read n,Real n) => T.Csv_Table String -> [Mnd t n]
+csv_mnd_parse = csv_mnd_parse_f id
+
+load_csv :: FilePath -> IO (T.Csv_Table String)
+load_csv = T.csv_table_read (True,',',False,T.Csv_No_Align) id
+
+-- | Midi note data.
+--
+-- > let fn = "/home/rohan/cvs/uc/uc-26/daily-practice/2014-08-13.1.csv"
+-- > let fn = "/home/rohan/sw/hmt/data/csv/mnd/1080-C01.csv"
+-- > m <- csv_mnd_read fn :: IO [Mnd Double Int]
+-- > length m -- 1800 17655
+-- > csv_mnd_write 4 "/tmp/t.csv" m
+csv_mnd_read :: (Read t,Real t,Read n,Real n) => FilePath -> IO [Mnd t n]
+csv_mnd_read = fmap csv_mnd_parse . load_csv
+
+-- | Writer.
+csv_mnd_write :: (Real t,Real n) => Int -> FilePath -> [Mnd t n] -> IO ()
+csv_mnd_write r_prec nm =
+    let un_node (st,msg,mnn,vel,ch,pm) =
+            [T.real_pp r_prec st
+            ,msg
+            ,data_value_pp r_prec mnn
+            ,data_value_pp r_prec vel
+            ,show ch
+            ,param_pp (';','=') r_prec pm]
+        with_hdr dat = (Just csv_mnd_hdr,dat)
+    in T.csv_table_write id T.def_csv_opt nm . with_hdr . map un_node
+
+-- * Mnd Seq forms
+
+-- | (p0=midi-note,p1=velocity,channel,param)
+type Event n = (n,n,Channel,Param)
+
+-- | mnn = midi-note-number
+event_mnn :: Event t -> t
+event_mnn (mnn,_,_,_) = mnn
+
+-- | ch = channel
+event_ch :: Event t -> Channel
+event_ch (_,_,ch,_) = ch
+
+-- | Are events equal at mnn field?
+event_eq_mnn :: Eq t => Event t -> Event t -> Bool
+event_eq_mnn = (==) `on` event_mnn
+
+-- | Are events equal at mnn and ch fields?
+event_eq_ol :: Eq t => Event t -> Event t -> Bool
+event_eq_ol = (==) `on` (\(mnn,_,ch,_) -> (mnn,ch))
+
+-- | Apply (mnn-f,vel-f,ch-f,param-f) to Event.
+event_map :: (t -> u,t -> u,Channel -> Channel,Param -> Param) -> Event t -> Event u
+event_map (f1,f2,f3,f4) (mnn,vel,ch,param) = (f1 mnn,f2 vel,f3 ch,f4 param)
+
+-- | Apply /f/ at mnn and vel fields.
+event_cast :: (t -> u) -> Event t -> Event u
+event_cast f = event_map (f,f,id,id)
+
+-- | Add /x/ to mnn field.
+event_transpose :: Num a => a -> Event a -> Event a
+event_transpose x = event_map ((+) x,id,id,id)
+
+-- | Translate from 'Tseq' form to 'Wseq' form.
+midi_tseq_to_midi_wseq :: (Num t,Eq n) => T.Tseq t (T.Begin_End (Event n)) -> T.Wseq t (Event n)
+midi_tseq_to_midi_wseq = T.tseq_begin_end_to_wseq (\(n0,_,c0,_) (n1,_,c1,_) -> c0 == c1 && n0 == n1)
+
+midi_wseq_to_midi_tseq :: (Num t,Ord t) => T.Wseq t x -> T.Tseq t (T.Begin_End x)
+midi_wseq_to_midi_tseq = T.wseq_begin_end
+
+-- | Ignores non on/off messages.
+mnd_to_tseq :: Num n => [Mnd t n] -> T.Tseq t (T.Begin_End (Event n))
+mnd_to_tseq =
+    let mk_node (st,msg,mnn,vel,ch,pm) =
+            case msg of
+              "on" -> Just (st,T.Begin (mnn,vel,ch,pm))
+              "off" -> Just (st,T.End (mnn,0,ch,pm))
+              _ -> Nothing
+    in mapMaybe mk_node
+
+-- | 'Tseq' form of 'csv_mnd_read', channel information is retained, off-velocity is zero.
+csv_mnd_read_tseq :: (Read t,Real t,Read n,Real n) => FilePath -> IO (T.Tseq t (T.Begin_End (Event n)))
+csv_mnd_read_tseq = fmap mnd_to_tseq . csv_mnd_read
+
+-- | 'Tseq' form of 'csv_mnd_write', data is .
+csv_mnd_write_tseq :: (Real t,Real n) => Int -> FilePath -> T.Tseq t (T.Begin_End (Event n)) -> IO ()
+csv_mnd_write_tseq r_prec nm sq =
+    let f (t,e) = case e of
+                    T.Begin (n,v,c,p) -> (t,"on",n,v,c,p)
+                    T.End (n,_,c,p) -> (t,"off",n,0,c,p)
+    in csv_mnd_write r_prec nm (map f sq)
+
+-- * Mndd (simplifies cases where overlaps on the same channel are allowed).
+
+-- | Message should be @note@ for note data.
+csv_mndd_hdr :: [String]
+csv_mndd_hdr = ["time","duration","message","note","velocity","channel","param"]
+
+-- | Midi note/duration data.
+-- The type parameters are to allow for fractional note & velocity values.
+-- The command is a string, @note@ is standard, other commands may be present.
+--
+-- > unwords csv_mndd_hdr == "time duration message note velocity channel param"
+type Mndd t n = (t,t,String,n,n,Channel,Param)
+
+-- | Compare sequence is: start-time,channel-number,note-number,velocity,duration,param.
+mndd_compare :: (Ord t,Ord n) => Mndd t n -> Mndd t n -> Ordering
+mndd_compare x1 x2 =
+  case (x1,x2) of
+    ((t1,d1,"note",n1,v1,c1,p1),(t2,d2,"note",n2,v2,c2,p2)) ->
+      compare (t1,c1,n1,v1,d1,p1) (t2,c2,n2,v2,d2,p2)
+    _ -> compare x1 x2
+
+csv_mndd_parse_f :: (Read t,Real t,Read n,Real n) => (n -> m) -> T.Csv_Table String -> [Mndd t m]
+csv_mndd_parse_f cnv (hdr,dat) =
+    let err x = error ("csv_mndd_read: " ++ x)
+        f m =
+            case m of
+              [st,du,msg,mnn,vel,ch,pm] ->
+                  (T.reads_exact_err "time" st
+                  ,T.reads_exact_err "duration" du
+                  ,msg
+                  ,cnv (T.reads_exact_err "note" mnn)
+                  ,cnv (T.reads_exact_err "velocity" vel)
+                  ,T.reads_exact_err "channel" ch
+                  ,param_parse (';','=') pm)
+              _ -> err "entry?"
+    in case hdr of
+         Just hdr' -> if hdr' == csv_mndd_hdr then map f dat else err "header?"
+         Nothing -> err "no header?"
+
+-- | Pars midi note/duration data from Csv table.
+csv_mndd_parse :: (Read t,Real t,Read n,Real n) => T.Csv_Table String -> [Mndd t n]
+csv_mndd_parse = csv_mndd_parse_f id
+
+-- | 'csv_mndd_parse' of 'load_csv'
+csv_mndd_read :: (Read t,Real t,Read n,Real n) => FilePath -> IO [Mndd t n]
+csv_mndd_read = fmap csv_mndd_parse . load_csv
+
+-- | Writer.
+csv_mndd_write :: (Real t,Real n) => Int -> FilePath -> [Mndd t n] -> IO ()
+csv_mndd_write r_prec nm =
+    let un_node (st,du,msg,mnn,vel,ch,pm) =
+            [T.real_pp r_prec st,T.real_pp r_prec du,msg
+            ,data_value_pp r_prec mnn,data_value_pp r_prec vel
+            ,show ch
+            ,param_pp (';','=') r_prec pm]
+        with_hdr dat = (Just csv_mndd_hdr,dat)
+    in T.csv_table_write id T.def_csv_opt nm . with_hdr . map un_node
+
+-- * Mndd Seq forms
+
+-- | Ignores non note messages.
+mndd_to_wseq :: [Mndd t n] -> T.Wseq t (Event n)
+mndd_to_wseq =
+    let mk_node (st,du,msg,mnn,vel,ch,pm) =
+            case msg of
+              "note" -> Just ((st,du),(mnn,vel,ch,pm))
+              _ -> Nothing
+    in mapMaybe mk_node
+
+-- | 'Wseq' form of 'csv_mndd_read'.
+csv_mndd_read_wseq :: (Read t,Real t,Read n,Real n) => FilePath -> IO (T.Wseq t (Event n))
+csv_mndd_read_wseq = fmap mndd_to_wseq . csv_mndd_read
+
+-- | 'Wseq' form of 'csv_mndd_write'.
+csv_mndd_write_wseq :: (Real t,Real n) => Int -> FilePath -> T.Wseq t (Event n) -> IO ()
+csv_mndd_write_wseq r_prec nm =
+    let f ((st,du),(mnn,vel,ch,pm)) = (st,du,"note",mnn,vel,ch,pm)
+    in csv_mndd_write r_prec nm . map f
+
+-- * Composite
+
+-- | Parse either Mnd or Mndd data to Wseq, Csv type is decided by header.
+csv_midi_parse_wseq_f :: (Read t,Real t,Read n,Real n,Num m, Eq m) => (n -> m) -> T.Csv_Table String -> T.Wseq t (Event m)
+csv_midi_parse_wseq_f cnv (hdr,dat) = do
+  case hdr of
+    Just hdr' -> if hdr' == csv_mnd_hdr
+                 then midi_tseq_to_midi_wseq (mnd_to_tseq (csv_mnd_parse_f cnv (hdr,dat)))
+                 else if hdr' == csv_mndd_hdr
+                      then mndd_to_wseq (csv_mndd_parse_f cnv (hdr,dat))
+                      else error "csv_midi_read_wseq: not Mnd or Mndd"
+    _ -> error "csv_midi_read_wseq: header?"
+
+csv_midi_parse_wseq :: (Read t,Real t,Read n,Real n) => T.Csv_Table String -> T.Wseq t (Event n)
+csv_midi_parse_wseq = csv_midi_parse_wseq_f id
+
+csv_midi_read_wseq :: (Read t,Real t,Read n,Real n) => FilePath -> IO (T.Wseq t (Event n))
+csv_midi_read_wseq = fmap csv_midi_parse_wseq . load_csv
diff --git a/Music/Theory/Array/Csv/Midi/Skini.hs b/Music/Theory/Array/Csv/Midi/Skini.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Csv/Midi/Skini.hs
@@ -0,0 +1,57 @@
+-- | Functions (partial) for reading & writing Skini data files.
+--
+-- <https://ccrma.stanford.edu/software/stk/skini.html>
+module Music.Theory.Array.Csv.Midi.Skini where
+
+import Data.List {- base -}
+
+import qualified Music.Theory.Array.Csv.Midi.Mnd as T {- hmt -}
+import qualified Music.Theory.Time.Seq as T {- hmt -}
+
+-- | Skini allows delta or absolute time-stamps.
+data Time t = Delta t | Absolute t
+
+-- | Skini data type of (message,time-stamp,channel,data-one,data-two)
+type Skini t n = (String,Time t,T.Channel,n,n)
+
+mnd_msg_to_skini_msg :: String -> String
+mnd_msg_to_skini_msg msg =
+  case msg of
+    "on" -> "NoteOn"
+    "off" -> "NoteOff"
+    _ -> error "mnd_msg_to_skini_msg"
+
+mnd_to_skini_f :: (t -> Time t) -> T.Mnd t n -> Skini t n
+mnd_to_skini_f f mnd =
+  case mnd of
+    (t,msg,d1,d2,ch,[]) -> (mnd_msg_to_skini_msg msg,f t,ch,d1,d2)
+    _ -> error "mnd_to_skini"
+
+mnd_to_skini_abs :: T.Mnd t n -> Skini t n
+mnd_to_skini_abs = mnd_to_skini_f Absolute
+
+midi_tseq_to_skini_seq :: (Num t,Eq n) => T.Tseq t (T.Begin_End (T.Event n)) -> [Skini t n]
+midi_tseq_to_skini_seq =
+  let f e =
+        case e of
+          (t,T.Begin (d1,d2,ch,[])) -> ("NoteOn",Delta t,ch,d1,d2)
+          (t,T.End (d1,d2,ch,[])) -> ("NoteOff",Delta t,ch,d1,d2)
+          _ -> error "midi_tseq_to_skini_seq"
+  in map f . T.tseq_to_iseq
+
+time_pp :: Real t => Int -> Time t -> String
+time_pp k t =
+  case t of
+    Delta x -> T.data_value_pp k x
+    Absolute x -> '=' : T.data_value_pp k x
+
+skini_pp_csv :: (Real t,Real n) => Int -> Skini t n -> String
+skini_pp_csv k (msg,t,ch,d1,d2) =
+  let f = T.data_value_pp k
+  in intercalate "," [msg,time_pp k t,show ch,f d1,f d2]
+
+-- > let fn = "/home/rohan/sw/hmt/data/csv/mnd/1080-C01.csv"
+-- > m <- T.csv_mnd_read_tseq fn :: IO (T.Tseq Double (T.Begin_End (T.Event Int)))
+-- > skini_write_csv 4 "/tmp/t.skini" (midi_tseq_to_skini_seq m)
+skini_write_csv :: (Real t,Real n) => Int -> FilePath -> [Skini t n] -> IO ()
+skini_write_csv k fn = writeFile fn . unlines . map (skini_pp_csv k)
diff --git a/Music/Theory/Array/Direction.hs b/Music/Theory/Array/Direction.hs
--- a/Music/Theory/Array/Direction.hs
+++ b/Music/Theory/Array/Direction.hs
@@ -41,7 +41,7 @@
 derive_vec (c1,r1) (c2,r2) = (c2 - c1,r2 - r1)
 
 unfold_path :: Num n => LOC n -> [VEC n] -> [LOC n]
-unfold_path l p = scanl apply_vec l p
+unfold_path = scanl apply_vec
 
 -- * DIRECTION (non-diagonal)
 
diff --git a/Music/Theory/Array/MD.hs b/Music/Theory/Array/MD.hs
deleted file mode 100644
--- a/Music/Theory/Array/MD.hs
+++ /dev/null
@@ -1,108 +0,0 @@
--- | Regular array data as markdown (MD) tables.
-module Music.Theory.Array.MD where
-
-import Data.List {- base -}
-
-import qualified Music.Theory.Array as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.String as T {- hmt -}
-
--- | Optional header row then data rows.
-type MD_Table t = (Maybe [String],[[t]])
-
--- | Join second table to right of initial table.
-md_table_join :: MD_Table a -> MD_Table a -> MD_Table a
-md_table_join (nm,c) (hdr,tbl) =
-    let hdr' = fmap (\h -> maybe h (++ h) nm) hdr
-        tbl' = map (\(i,r) -> i ++ r) (zip c tbl)
-    in (hdr',tbl')
-
--- | Add a row number column at the front of the table.
-md_number_rows :: MD_Table String -> MD_Table String
-md_number_rows (hdr,tbl) =
-    let hdr' = fmap ("#" :) hdr
-        tbl' = map (\(i,r) -> show i : r) (zip [1::Int ..] tbl)
-    in (hdr',tbl')
-
--- | Markdown table, perhaps with header.  Table is in row order.
--- Options are /pad_left/ and /eq_width/.
---
--- > let tbl = [["a","bc","def"],["ghij","klm","no","p"]]
--- > putStrLn$unlines$"": md_table_opt (True,True," · ") (Nothing,tbl)
-md_table_opt :: (Bool,Bool,String) -> MD_Table String -> [String]
-md_table_opt (pad_left,eq_width,col_sep) (hdr,t) =
-    let c = transpose (T.make_regular "" (maybe t (:t) hdr))
-        nc = length c
-        n = let k = map (maximum . map length) c
-            in if eq_width then replicate nc (maximum k) else k
-        ext k s = if pad_left then T.pad_left ' ' k s else T.pad_right ' ' k s
-        jn = intercalate col_sep
-        m = jn (map (flip replicate '-') n)
-        w = map jn (transpose (zipWith (map . ext) n c))
-        d = map T.delete_trailing_whitespace w
-    in case hdr of
-         Nothing -> T.bracket (m,m) d
-         Just _ -> case d of
-                     [] -> error "md_table"
-                     d0:d' -> d0 : T.bracket (m,m) d'
-
-md_table' :: MD_Table String -> [String]
-md_table' = md_table_opt (True,False," ")
-
--- | 'curry' of 'md_table''.
-md_table :: Maybe [String] -> [[String]] -> [String]
-md_table = curry md_table'
-
--- | Variant relying on 'Show' instances.
---
--- > md_table_show Nothing [[1..4],[5..8],[9..12]]
-md_table_show :: Show t => Maybe [String] -> [[t]] -> [String]
-md_table_show hdr = md_table hdr . map (map show)
-
--- | Variant in column order (ie. 'transpose').
---
--- > md_table_column_order [["a","bc","def"],["ghij","klm","no"]]
-md_table_column_order :: Maybe [String] -> [[String]] -> [String]
-md_table_column_order hdr = md_table hdr . transpose
-
--- | Two-tuple 'show' variant.
-md_table_p2 :: (Show a,Show b) => Maybe [String] -> ([a],[b]) -> [String]
-md_table_p2 hdr (p,q) = md_table hdr [map show p,map show q]
-
--- | Three-tuple 'show' variant.
-md_table_p3 :: (Show a,Show b,Show c) => Maybe [String] -> ([a],[b],[c]) -> [String]
-md_table_p3 hdr (p,q,r) = md_table hdr [map show p,map show q,map show r]
-
-{- | Matrix form, ie. header in both first row and first column, in
-each case displaced by one location which is empty.
-
-> let h = (map return "abc",map return "efgh")
-> let t = md_matrix "" h (map (map show) [[1,2,3,4],[2,3,4,1],[3,4,1,2]])
-
->>> putStrLn $ unlines $ md_table' t
-- - - - -
-  e f g h
-a 1 2 3 4
-b 2 3 4 1
-c 3 4 1 2
-- - - - -
-
--}
-md_matrix :: a -> ([a],[a]) -> [[a]] -> MD_Table a
-md_matrix nil (r,c) t = md_table_join (Nothing,[nil] : map return r) (Nothing,c : t)
-
--- | Variant that takes a 'show' function and a /header decoration/ function.
-md_matrix_opt :: (a -> String) -> (String -> String) -> ([a],[a]) -> [[a]] -> MD_Table String
-md_matrix_opt show_f hd_f nm t =
-    let t' = map (map show_f) t
-        nm' = T.bimap1 (map (hd_f . show_f)) nm
-    in md_matrix "" nm' t'
-
--- | MD embolden function.
-md_embolden :: String -> String
-md_embolden x = "__" ++ x ++ "__"
-
--- | 'md_matrix_opt' with 'show' and markdown /bold/ annotations for header.
--- the header cells are in bold.
-md_matrix_bold :: Show a => ([a],[a]) -> [[a]] -> MD_Table String
-md_matrix_bold = md_matrix_opt show md_embolden
diff --git a/Music/Theory/Array/Square.hs b/Music/Theory/Array/Square.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Square.hs
@@ -0,0 +1,198 @@
+-- | Square arrays, where the number of rows and columns are equal.
+module Music.Theory.Array.Square where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Data.Map as Map {- containers -}
+import qualified Data.List.Split as Split {- split -}
+
+import qualified Music.Theory.Array as T {- hmt-base -}
+import qualified Music.Theory.Array.Text as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+
+import qualified Music.Theory.Math.Oeis as T {- hmt -}
+
+-- | Square as list of lists.
+type Square t = [[t]]
+
+-- | Squares are functors
+sq_map :: (t -> t) -> Square t -> Square t
+sq_map f = map (map f)
+
+-- | 'sq_map' of '*' /n/
+sq_scale :: Num t => t -> Square t -> Square t
+sq_scale n = sq_map (* n)
+
+-- | /f/ pointwise at two squares (of equal size, un-checked)
+sq_zip :: (t -> t -> t) -> Square t -> Square t -> Square t
+sq_zip f = zipWith (zipWith f)
+
+-- | 'sq_zip' of '*'
+sq_mul :: Num t => Square t -> Square t -> Square t
+sq_mul = sq_zip (*)
+
+-- | 'sq_zip' of '+'
+sq_add :: Num t => Square t -> Square t -> Square t
+sq_add = sq_zip (+)
+
+-- | 'foldl1' of 'sq_add'
+sq_sum :: Num t => [Square t] -> Square t
+sq_sum = foldl1 sq_add
+
+-- | Predicate to determine if 'Square' is actually square.
+sq_is_square :: Square t -> Bool
+sq_is_square sq = nub (map length sq) == [length sq]
+
+-- | Square as row order list
+type Square_Linear t = [t]
+
+-- | Given degree of square, form 'Square' from 'Square_Linear'.
+sq_from_list :: Int -> Square_Linear t -> Square t
+sq_from_list = Split.chunksOf
+
+-- | True if list can form a square, ie. if 'length' is a square.
+--
+-- > sq_is_linear_square T.a126710 == True
+sq_is_linear_square :: Square_Linear t -> Bool
+sq_is_linear_square l = length l `T.elem_ordered` T.a000290
+
+-- | Calculate degree of linear square, ie. square root of 'length'.
+--
+-- > sq_linear_degree T.a126710 == 4
+sq_linear_degree :: Square_Linear t -> Int
+sq_linear_degree =
+    fromMaybe (error "sq_linear_degree") .
+    flip T.elemIndex_ordered T.a000290 .
+    length
+
+-- | Type specialised 'transpose'
+sq_transpose :: Square t -> Square t
+sq_transpose = transpose
+
+{- | Full upper-left (ul) to lower-right (lr) diagonals of a square.
+
+> sq = sq_from_list 4 T.a126710
+> sq_wr $ sq
+> sq_wr $ sq_diagonals_ul_lr sq
+> sq_wr $ sq_diagonals_ll_ur sq
+> sq_undiagonals_ul_lr (sq_diagonals_ul_lr sq) == sq
+> sq_undiagonals_ll_ur (sq_diagonals_ll_ur sq) == sq
+
+> sq_diagonal_ul_lr sq == sq_diagonals_ul_lr sq !! 0
+> sq_diagonal_ll_ur sq == sq_diagonals_ll_ur sq !! 0
+
+-}
+sq_diagonals_ul_lr :: Square t -> Square t
+sq_diagonals_ul_lr = sq_transpose . zipWith T.rotate_left [0..]
+
+-- | Full lower-left (ll) to upper-right (ur) diagonals of a square.
+sq_diagonals_ll_ur :: Square t -> Square t
+sq_diagonals_ll_ur = sq_diagonals_ul_lr . reverse
+
+-- | Inverse of 'diagonals_ul_lr'
+sq_undiagonals_ul_lr :: Square t -> Square t
+sq_undiagonals_ul_lr = zipWith T.rotate_right [0..] . sq_transpose
+
+-- | Inverse of 'diagonals_ll_ur'
+sq_undiagonals_ll_ur :: Square t -> Square t
+sq_undiagonals_ll_ur = reverse . sq_undiagonals_ul_lr
+
+-- | Main diagonal (upper-left -> lower-right)
+sq_diagonal_ul_lr :: Square t -> [t]
+sq_diagonal_ul_lr sq = zipWith (!!) sq [0 ..]
+
+-- | Main diagonal (lower-left -> upper-right)
+sq_diagonal_ll_ur :: Square t -> [t]
+sq_diagonal_ll_ur = sq_diagonal_ul_lr . reverse
+
+{- | Horizontal reflection (ie. map reverse).
+
+> sq = sq_from_list 4 T.a126710
+> sq_wr $ sq
+> sq_wr $ sq_h_reflection sq
+
+-}
+sq_h_reflection :: Square t -> Square t
+sq_h_reflection = map reverse
+
+-- | An n×n square is /normal/ if it has the elements (1 .. n×n).
+sq_is_normal :: Integral n => Square n -> Bool
+sq_is_normal sq =
+  let n = genericLength sq
+  in sort (concat sq) == [1 .. n * n]
+
+-- | Sums of (rows, columns, left-right-diagonals, right-left-diagonals)
+sq_sums :: Num n => Square n -> ([n],[n],[n],[n])
+sq_sums sq =
+  (map sum sq
+  ,map sum (sq_transpose sq)
+  ,map sum (sq_diagonals_ul_lr sq)
+  ,map sum (sq_diagonals_ll_ur sq))
+
+-- * PP
+
+sq_opt :: T.Text_Table_Opt
+sq_opt = (False,True,False," ",False)
+
+sq_pp :: Show t => Square t -> String
+sq_pp = unlines . T.table_pp_show sq_opt
+
+sq_wr :: Show t => Square t -> IO ()
+sq_wr = putStrLn . ('\n' :) . sq_pp
+
+sq_pp_m :: Show t => String -> Square (Maybe t) -> String
+sq_pp_m e = unlines . T.table_pp sq_opt . map (map (maybe e (T.pad_left '·' 2 . show)))
+
+sq_wr_m :: Show t => String -> Square (Maybe t) -> IO ()
+sq_wr_m e = putStrLn . sq_pp_m e
+
+-- * Square Map
+
+-- | (row,column) index.
+type Square_Ix = T.Ix Int
+
+-- | Map from Square_Ix to value.
+type Square_Map t = Map.Map Square_Ix t
+
+-- | 'Square' to 'Square_Map'.
+sq_to_map :: Square t -> Square_Map t
+sq_to_map =
+    let f r = zipWith (\c e -> ((r,c),e)) [0..]
+    in Map.fromList . concat . zipWith f [0..]
+
+-- | Alias for 'Map.!'
+sqm_ix :: Square_Map t -> Square_Ix -> t
+sqm_ix = (Map.!)
+
+-- | 'map' of 'sqm_ix'.
+sqm_ix_seq :: Square_Map t -> [Square_Ix] -> [t]
+sqm_ix_seq m = map (sqm_ix m)
+
+-- | Make a 'Square' of dimension /dm/ that has elements from /m/ at
+-- indicated indices, else 'Nothing'.
+sqm_to_partial_sq :: Int -> Square_Map t -> [Square_Ix] -> Square (Maybe t)
+sqm_to_partial_sq dm m ix_set =
+    let f i = if i `elem` ix_set then Just (m Map.! i) else Nothing
+    in Split.chunksOf dm (map f (T.matrix_indices (dm,dm)))
+
+-- * TRS SEQ
+
+sq_trs_op :: [(String,Square t -> Square t)]
+sq_trs_op =
+    [("≡",id)
+    ,("←",sq_h_reflection)
+    ,("↓",sq_transpose)
+    ,("(← · ↓)",sq_h_reflection . sq_transpose)
+    ,("(↓ · ← · ↓)",sq_transpose . sq_h_reflection . sq_transpose)
+    ,("(↓ · ←)",sq_transpose . sq_h_reflection)
+    ,("(← · ↓ · ←)",sq_h_reflection . sq_transpose . sq_h_reflection)
+    ,("↘",sq_diagonals_ul_lr)
+    ,("↙ = (↘ · ←)",sq_diagonals_ul_lr . sq_h_reflection)
+    ,("↗ = (← · ↙)",sq_h_reflection . sq_diagonals_ul_lr . sq_h_reflection)
+    ,("↖ = (← · ↘)",sq_h_reflection . sq_diagonals_ul_lr)
+    ]
+
+sq_trs_seq :: Square t -> [(String,Square t)]
+sq_trs_seq sq = map (\(nm,fn) -> (nm,fn sq)) sq_trs_op
+
diff --git a/Music/Theory/Bits.hs b/Music/Theory/Bits.hs
deleted file mode 100644
--- a/Music/Theory/Bits.hs
+++ /dev/null
@@ -1,38 +0,0 @@
--- | Bits functions.
-module Music.Theory.Bits where
-
-import Data.Bits {- base -}
-
-bit_pp :: Bool -> Char
-bit_pp b = if b then '1' else '0'
-
-bits_pp :: [Bool] -> String
-bits_pp = map bit_pp
-
--- | Generate /n/ place bit sequence for /x/.
-gen_bitseq :: FiniteBits b => Int -> b -> [Bool]
-gen_bitseq n x =
-    if finiteBitSize x < n
-    then error "gen_bitseq"
-    else map (testBit x) (reverse [0 .. n - 1])
-
--- | Given bit sequence (most to least significant) generate 'Bits' value.
---
--- > :set -XBinaryLiterals
--- > pack_bitseq [True,False,True,False] == 0b1010
--- > pack_bitseq [True,False,False,True,False,False] == 0b100100
--- > 0b100100 == 36
-pack_bitseq :: Bits i => [Bool] -> i
-pack_bitseq =
-    last .
-    scanl (\n (k,b) -> if b then setBit n k else n) zeroBits .
-    zip [0..] .
-    reverse
-
--- | 'bits_pp' of 'gen_bitseq'.
---
--- > :set -XBinaryLiterals
--- > 0xF0 == 0b11110000
--- > gen_bitseq_pp 8 (0xF0::Int) == "11110000"
-gen_bitseq_pp :: FiniteBits b => Int -> b -> String
-gen_bitseq_pp n = bits_pp . gen_bitseq n
diff --git a/Music/Theory/Bjorklund.hs b/Music/Theory/Bjorklund.hs
--- a/Music/Theory/Bjorklund.hs
+++ b/Music/Theory/Bjorklund.hs
@@ -9,37 +9,39 @@
 
 import qualified Music.Theory.List as T
 
-type STEP a = ((Int,Int),([[a]],[[a]]))
+-- | Bjorklund state
+type BJORKLUND_ST a = ((Int,Int),([[a]],[[a]]))
 
-left :: STEP a -> STEP a
-left ((i,j),(xs,ys)) =
+-- | Bjorklund left process
+bjorklund_left_f :: BJORKLUND_ST a -> BJORKLUND_ST a
+bjorklund_left_f ((i,j),(xs,ys)) =
     let (xs',xs'') = splitAt j xs
     in ((j,i-j),(zipWith (++) xs' ys,xs''))
 
-right :: STEP a -> STEP a
-right ((i,j),(xs,ys)) =
+-- | Bjorklund right process
+bjorklund_right_f :: BJORKLUND_ST a -> BJORKLUND_ST a
+bjorklund_right_f ((i,j),(xs,ys)) =
     let (ys',ys'') = splitAt i ys
     in ((i,j-i),(zipWith (++) xs ys',ys''))
 
-bjorklund' :: STEP a -> STEP a
-bjorklund' (n,x) =
+-- | Bjorklund process, left & recur or right & recur or halt.
+bjorklund_f :: BJORKLUND_ST a -> BJORKLUND_ST a
+bjorklund_f (n,x) =
     let (i,j) = n
     in if min i j <= 1
        then (n,x)
-       else bjorklund' (if i > j then left (n,x) else right (n,x))
+       else bjorklund_f (if i > j then bjorklund_left_f (n,x) else bjorklund_right_f (n,x))
 
 {- | Bjorklund's algorithm to construct a binary sequence of /n/ bits
 with /k/ ones such that the /k/ ones are distributed as evenly as
 possible among the (/n/ - /k/) zeroes.
 
 > bjorklund (5,9) == [True,False,True,False,True,False,True,False,True]
-> map xdot (bjorklund (5,9)) == "x.x.x.x.x"
+> map xdot_ascii (bjorklund (5,9)) == "x.x.x.x.x"
 
-> let {es = [(2,[3,5]),(3,[4,5,8]),(4,[7,9,12,15]),(5,[6,7,8,9,11,12,13,16])
->           ,(6,[7,13]),(7,[8,9,10,12,15,16,17,18]),(8,[17,19])
->           ,(9,[14,16,22,23]),(11,[12,24]),(13,[24]),(15,[34])]
->     ;es' = concatMap (\(i,j) -> map ((,) i) j) es}
-> in mapM_ (putStrLn . euler_pp') es'
+> let es = [(2,[3,5]),(3,[4,5,8]),(4,[7,9,12,15]),(5,[6,7,8,9,11,12,13,16]),(6,[7,13]),(7,[8,9,10,12,15,16,17,18]),(8,[17,19]),(9,[14,16,22,23]),(11,[12,24]),(13,[24]),(15,[34])]
+> let es' = concatMap (\(i,j) -> map ((,) i) j) es
+> mapM_ (putStrLn . euler_pp_unicode) es'
 
 > > E(2,3) [××·] (12)
 > > E(2,5) [×·×··] (23)
@@ -85,12 +87,12 @@
     let j = j' - i
         x = replicate i [True]
         y = replicate j [False]
-        (_,(x',y')) = bjorklund' ((i,j),(x,y))
+        (_,(x',y')) = bjorklund_f ((i,j),(x,y))
     in concat x' ++ concat y'
 
 -- | 'T.rotate_right' of 'bjorklund'.
 --
--- > map xdot' (bjorklund_r 2 (5,16)) == "··×··×··×··×··×·"
+-- > map xdot_unicode (bjorklund_r 2 (5,16)) == "··×··×··×··×··×·"
 bjorklund_r :: Int -> (Int, Int) -> [Bool]
 bjorklund_r n = T.rotate_right n . bjorklund
 
@@ -102,40 +104,37 @@
 
 -- | Unicode form, ie. @×·@.
 --
--- > euler_pp' (7,12) == "E(7,12) [×·××·×·××·×·] (2122122)"
-euler_pp' :: (Int, Int) -> String
-euler_pp' = euler_pp_f xdot'
+-- > euler_pp_unicode (7,12) == "E(7,12) [×·××·×·××·×·] (2122122)"
+euler_pp_unicode :: (Int, Int) -> String
+euler_pp_unicode = euler_pp_f xdot_unicode
 
 -- | ASCII form, ie. @x.@.
 --
--- > euler_pp (7,12) == "E(7,12) [x.xx.x.xx.x.] (2122122)"
-euler_pp :: (Int, Int) -> String
-euler_pp = euler_pp_f xdot
+-- > euler_pp_ascii (7,12) == "E(7,12) [x.xx.x.xx.x.] (2122122)"
+euler_pp_ascii :: (Int, Int) -> String
+euler_pp_ascii = euler_pp_f xdot_ascii
 
 -- | /xdot/ notation for pattern.
 --
--- > map xdot (bjorklund (5,9)) == "x.x.x.x.x"
-xdot :: Bool -> Char
-xdot x = if x then 'x' else '.'
+-- > map xdot_ascii (bjorklund (5,9)) == "x.x.x.x.x"
+xdot_ascii :: Bool -> Char
+xdot_ascii x = if x then 'x' else '.'
 
 -- | Unicode variant.
 --
--- > map xdot' (bjorklund (5,12)) == "×··×·×··×·×·"
--- > map xdot' (bjorklund (5,16)) == "×··×··×··×··×···"
-xdot' :: Bool -> Char
-xdot' x = if x then '×' else '·'
+-- > map xdot_unicode (bjorklund (5,12)) == "×··×·×··×·×·"
+-- > map xdot_unicode (bjorklund (5,16)) == "×··×··×··×··×···"
+xdot_unicode :: Bool -> Char
+xdot_unicode x = if x then '×' else '·'
 
 -- | The 'iseq' of a pattern is the distance between 'True' values.
 --
 -- > iseq (bjorklund (5,9)) == [2,2,2,2,1]
 iseq :: [Bool] -> [Int]
-iseq =
-    let f = split . keepDelimsL . whenElt
-    in tail . map length . f (== True)
+iseq = let f = split . keepDelimsL . whenElt in tail . map length . f (== True)
 
 -- | 'iseq' of pattern as compact string.
 --
 -- > iseq_str (bjorklund (5,9)) == "(22221)"
 iseq_str :: [Bool] -> String
-iseq_str = let f xs = "(" ++ concatMap show xs ++ ")"
-           in f . iseq
+iseq_str = let f xs = "(" ++ concatMap show xs ++ ")" in f . iseq
diff --git a/Music/Theory/Braille.hs b/Music/Theory/Braille.hs
--- a/Music/Theory/Braille.hs
+++ b/Music/Theory/Braille.hs
@@ -103,7 +103,7 @@
 --
 -- > braille_lookup_ascii 'N' == Just (0x4E,'N',[1,3,4,5],'⠝',"n")
 braille_lookup_ascii :: Char -> Maybe BRAILLE
-braille_lookup_ascii c = find ((== (toUpper c)) . braille_ascii) braille_table
+braille_lookup_ascii c = find ((== toUpper c) . braille_ascii) braille_table
 
 -- | The arrangement of the 6-dot patterns into /decades/, sequences
 -- of (1,10,3) cells.  The cell to the left of the decade is the empty
@@ -160,6 +160,7 @@
     let f n = if n `elem` d then b else w
     in map (map f) [[1,4],[2,5],[3,6]]
 
+-- | 'lines' as rows and 'Char' as cells in HTML table.
 string_html_table :: String -> String
 string_html_table s =
     let f x = "<td>" ++ [x] ++ "</td>"
diff --git a/Music/Theory/Byte.hs b/Music/Theory/Byte.hs
deleted file mode 100644
--- a/Music/Theory/Byte.hs
+++ /dev/null
@@ -1,55 +0,0 @@
--- | Byte functions.
-module Music.Theory.Byte where
-
-import qualified Data.ByteString as B {- bytestring -}
-import Data.Char {- base -}
-import Data.List.Split {- split -}
-import Data.Maybe {- base -}
-import Numeric {- base -}
-
-import qualified Music.Theory.Read as T {- hmt -}
-
--- | Given /n/ in (0,255) make two character hex string.
---
--- > mapMaybe byte_hex_pp [0x0F,0xF0,0xF0F] == ["0F","F0"]
-byte_hex_pp :: (Integral i, Show i) => i -> Maybe String
-byte_hex_pp n =
-    case showHex n "" of
-      [c] -> Just ['0',toUpper c]
-      [c,d] -> Just (map toUpper [c,d])
-      _ -> Nothing
-
--- | Erroring variant.
-byte_hex_pp_err :: (Integral i, Show i) => i -> String
-byte_hex_pp_err = fromMaybe (error "byte_hex_pp") . byte_hex_pp
-
--- | 'unwords' of 'map' of 'byte_hex_pp_err'.
---
--- > byte_seq_hex_pp [0x0F,0xF0] == "0F F0"
-byte_seq_hex_pp :: (Integral i, Show i) => [i] -> String
-byte_seq_hex_pp = unwords . map byte_hex_pp_err
-
--- | Read two character hexadecimal string.
-read_hex_byte :: (Eq t,Num t) => String -> t
-read_hex_byte s =
-    case s of
-      [_,_] -> T.reads_to_read_precise_err "readHex" readHex s
-      _ -> error "read_hex_byte"
-
-read_hex_byte_seq :: (Eq t,Num t) => String -> [t]
-read_hex_byte_seq = map read_hex_byte . words
-
--- | Load binary 'U8' sequence from file.
-load_byte_seq :: Integral i => FilePath -> IO [i]
-load_byte_seq = fmap (map fromIntegral . B.unpack) . B.readFile
-
-store_byte_seq :: Integral i => FilePath -> [i] -> IO ()
-store_byte_seq fn = B.writeFile fn . B.pack . map fromIntegral
-
--- | Load hexadecimal text 'U8' sequence from file.
-load_hex_byte_seq :: Integral i => FilePath -> IO [i]
-load_hex_byte_seq = fmap (map read_hex_byte . words) . readFile
-
--- | Store 'U8' sequence as hexadecimal text, 16 words per line.
-store_hex_byte_seq :: (Integral i,Show i) => FilePath -> [i] -> IO ()
-store_hex_byte_seq fn = writeFile fn . unlines . map unwords . chunksOf 16 . map byte_hex_pp_err
diff --git a/Music/Theory/Clef.hs b/Music/Theory/Clef.hs
--- a/Music/Theory/Clef.hs
+++ b/Music/Theory/Clef.hs
@@ -5,11 +5,11 @@
 import Music.Theory.Pitch.Name {- hmt -}
 
 -- | Clef enumeration type.
-data Clef_T = Bass | Tenor | Alto | Treble | Percussion
+data Clef_Type = Bass | Tenor | Alto | Treble | Percussion
               deriving (Eq,Ord,Show)
 
 -- | Clef with octave offset.
-data Clef i = Clef {clef_t :: Clef_T
+data Clef i = Clef {clef_t :: Clef_Type
                    ,clef_octave :: i}
               deriving (Eq,Ord,Show)
 
@@ -18,7 +18,7 @@
 --
 -- > map clef_range [Treble,Bass] == [Just (d4,g5),Just (f2,b3)]
 -- > clef_range Percussion == Nothing
-clef_range :: Clef_T -> Maybe (Pitch,Pitch)
+clef_range :: Clef_Type -> Maybe (Pitch,Pitch)
 clef_range c =
     case c of
       Bass -> Just (f2,b3)
diff --git a/Music/Theory/Combinations.hs b/Music/Theory/Combinations.hs
deleted file mode 100644
--- a/Music/Theory/Combinations.hs
+++ /dev/null
@@ -1,21 +0,0 @@
--- | Combination functions.
-module Music.Theory.Combinations where
-
-import qualified Music.Theory.Permutations as T
-
--- | Number of /k/ element combinations of a set of /n/ elements.
---
--- > (nk_combinations 6 3,nk_combinations 13 3) == (20,286)
-nk_combinations :: Integral a => a -> a -> a
-nk_combinations n k = T.nk_permutations n k `div` T.factorial k
-
--- | /k/ element subsets of /s/.
---
--- > combinations 3 [1..4] == [[1,2,3],[1,2,4],[1,3,4],[2,3,4]]
--- > length (combinations 3 [1..5]) == nk_combinations 5 3
-combinations :: Int -> [a] -> [[a]]
-combinations k s =
-    case (k,s) of
-      (0,_) -> [[]]
-      (_,[]) -> []
-      (_,e:s') -> map (e :) (combinations (k - 1) s') ++ combinations k s'
diff --git a/Music/Theory/Contour/Polansky_1992.hs b/Music/Theory/Contour/Polansky_1992.hs
--- a/Music/Theory/Contour/Polansky_1992.hs
+++ b/Music/Theory/Contour/Polansky_1992.hs
@@ -10,10 +10,11 @@
 import Data.Maybe {- base -}
 import Data.Ratio {- base -}
 
-import qualified Music.Theory.List as T
-import qualified Music.Theory.Ord as T
-import qualified Music.Theory.Permutations.List as T
-import qualified Music.Theory.Set.List as T
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Ord as T {- hmt-base -}
+
+import qualified Music.Theory.Permutations.List as T {- hmt -}
+import qualified Music.Theory.Set.List as T {- hmt -}
 
 -- * Indices
 
diff --git a/Music/Theory/DB/CSV.hs b/Music/Theory/DB/CSV.hs
deleted file mode 100644
--- a/Music/Theory/DB/CSV.hs
+++ /dev/null
@@ -1,24 +0,0 @@
--- | Keys are given in the header, empty fields are omitted from records.
-module Music.Theory.DB.CSV where
-
-import Data.Maybe {- base -}
-import qualified Text.CSV.Lazy.String as C {- lazy-csv -}
-
-import Music.Theory.DB.Common {- hmt -}
-import qualified Music.Theory.IO as T {- hmt -}
-
--- | Load 'DB' from 'FilePath'.
-db_load_utf8 :: FilePath -> IO DB'
-db_load_utf8 fn = do
-  s <- T.read_file_utf8 fn
-  let p = C.fromCSVTable (C.csvTable (C.parseCSV s))
-      (h,d) = (head p,tail p)
-      f k v = if null v then Nothing else Just (k,v)
-  return (map (catMaybes . zipWith f h) d)
-
-db_store_utf8 :: FilePath -> DB' -> IO ()
-db_store_utf8 fn db = do
-  let (hdr,tbl) = db_to_table (fromMaybe "") db
-      (_,tbl') = C.toCSVTable (hdr : tbl)
-      str = C.ppCSVTable tbl'
-  T.write_file_utf8 fn str
diff --git a/Music/Theory/DB/Common.hs b/Music/Theory/DB/Common.hs
deleted file mode 100644
--- a/Music/Theory/DB/Common.hs
+++ /dev/null
@@ -1,130 +0,0 @@
-module Music.Theory.DB.Common where
-
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Safe {- safe -}
-
-import qualified Music.Theory.List as T {- base -}
-import qualified Music.Theory.Maybe as T {- base -}
-
--- * Type
-
-type Entry k v = (k,v)
-type Record k v = [Entry k v]
-type DB k v = [Record k v]
-
-type Key = String
-type Value = String
-type Entry' = Entry Key Value
-type Record' = Record Key Value
-type DB' = DB Key Value
-
--- * Record
-
--- | The sequence of keys at 'Record'.
-record_key_seq :: Record k v -> [k]
-record_key_seq = map fst
-
--- | 'True' if 'Key' is present in 'Entity'.
-record_has_key :: Eq k => k -> Record k v -> Bool
-record_has_key k = elem k . record_key_seq
-
--- | 'T.histogram' of 'record_key_seq'.
-record_key_histogram :: Ord k => Record k v -> [(k,Int)]
-record_key_histogram = T.histogram . record_key_seq
-
--- | Duplicate keys predicate.
-record_has_duplicate_keys :: Ord k => Record k v -> Bool
-record_has_duplicate_keys = any (> 0) . map snd . record_key_histogram
-
--- | Find all associations for key using given equality function.
-record_lookup_by :: (k -> k -> Bool) -> k -> Record k v -> [v]
-record_lookup_by f k = map snd . filter (f k . fst)
-
--- | 'record_lookup_by' of '=='.
-record_lookup :: Eq k => k -> Record k v -> [v]
-record_lookup = record_lookup_by (==)
-
--- | /n/th element of 'record_lookup'.
-record_lookup_at :: Eq k => (k,Int) -> Record k v -> Maybe v
-record_lookup_at (c,n) = flip atMay n . record_lookup c
-
--- | Variant of 'record_lookup' requiring a unique key.  'Nothing' indicates
--- there is no entry, it is an 'error' if duplicate keys are present.
-record_lookup_uniq :: Eq k => k -> Record k v -> Maybe v
-record_lookup_uniq k r =
-    case record_lookup k r of
-      [] -> Nothing
-      [v] -> Just v
-      _ -> error "record_lookup_uniq: non uniq"
-
--- | 'True' if key exists and is unique.
-record_has_key_uniq :: Eq k => k -> Record k v -> Bool
-record_has_key_uniq k = isJust . record_lookup_uniq k
-
--- | Error variant.
-record_lookup_uniq_err :: Eq k => k -> Record k v -> v
-record_lookup_uniq_err k = T.from_just "record_lookup_uniq: none" . record_lookup_uniq k
-
--- | Default value variant.
-record_lookup_uniq_def :: Eq k => v -> k -> Record k v -> v
-record_lookup_uniq_def v k = fromMaybe v . record_lookup_uniq k
-
--- | Remove all associations for key using given equality function.
-record_delete_by :: (k -> k -> Bool) -> k -> Record k v -> Record k v
-record_delete_by f k = filter (not . f k . fst)
-
--- | 'record_delete_by' of '=='.
-record_delete :: Eq k => k -> Record k v -> Record k v
-record_delete = record_delete_by (==)
-
--- * DB
-
--- | Preserves order of occurence.
-db_key_set :: Ord k => DB k v -> [k]
-db_key_set = nub . map fst . concat
-
-db_lookup_by :: (k -> k -> Bool) -> (v -> v -> Bool) -> k -> v -> DB k v -> [Record k v]
-db_lookup_by k_cmp v_cmp k v =
-    let f = any (v_cmp v) . record_lookup_by k_cmp k
-    in filter f
-
-db_lookup :: (Eq k,Eq v) => k -> v -> DB k v -> [Record k v]
-db_lookup = db_lookup_by (==) (==)
-
-db_has_duplicate_keys :: Ord k => DB k v -> Bool
-db_has_duplicate_keys = any id . map record_has_duplicate_keys
-
-db_key_histogram :: Ord k => DB k v -> [(k,Int)]
-db_key_histogram db =
-    let h = concatMap record_key_histogram db
-        f k = (k,maximum (record_lookup k h))
-    in map f (db_key_set db)
-
-db_to_table :: Ord k => (Maybe v -> e) -> DB k v -> ([k],[[e]])
-db_to_table f db =
-    let kh = db_key_histogram db
-        hdr = concatMap (\(k,n) -> replicate n k) kh
-        ix = concatMap (\(k,n) -> zip (repeat k) [0 .. n - 1]) kh
-    in (hdr,map (\r -> map (\i -> f (record_lookup_at i r)) ix) db)
-
--- * Collating duplicate keys.
-
-record_collate' :: Eq k => (k,[v]) -> Record k v -> Record k [v]
-record_collate' (k,v) r =
-    case r of
-      [] -> [(k,reverse v)]
-      (k',v'):r' ->
-          if k == k'
-          then record_collate' (k,v' : v) r'
-          else (k,reverse v) : record_collate' (k',[v']) r'
-
--- | Collate adjacent entries of existing sequence with equal key.
-record_collate :: Eq k => Record k v -> Record k [v]
-record_collate r =
-    case r of
-      [] -> error "record_collate: nil"
-      (k,v):r' -> record_collate' (k,[v]) r'
-
-record_uncollate :: Record k [v] -> Record k v
-record_uncollate = concatMap (\(k,v) -> zip (repeat k) v)
diff --git a/Music/Theory/DB/JSON.hs b/Music/Theory/DB/JSON.hs
deleted file mode 100644
--- a/Music/Theory/DB/JSON.hs
+++ /dev/null
@@ -1,67 +0,0 @@
--- | JSON string association database.
--- JSON objects do no allow multiple keys.
--- Here multiple keys are read & written as arrays.
-module Music.Theory.DB.JSON where
-
-import qualified Data.Aeson as A {- aeson -}
-import qualified Data.ByteString.Lazy as B {- bytestring -}
-import qualified Data.Map as M {- containers -}
-
-import qualified Music.Theory.DB.Common as DB
-
--- | Load 'DB' from 'FilePath'.
-db_load_utf8 :: FilePath -> IO DB.DB'
-db_load_utf8 fn = do
-  b <- B.readFile fn
-  case A.decode b of
-    Just m ->
-        let f = DB.record_uncollate .
-                map (fmap maybe_list_to_list) .
-                M.toList
-        in return (map f m)
-    Nothing -> return []
-
--- | Store 'DB' to 'FilePath'.
---
--- > let fn = "/home/rohan/ut/www-spr/data/db.js"
--- > db <- db_load_utf8 fn
--- > length db == 1334
--- > db_store_utf8 "/tmp/sp.js" db
-db_store_utf8 :: FilePath -> DB.DB' -> IO ()
-db_store_utf8 fn db = do
-  let db' = let f = map (fmap list_to_maybe_list) . DB.record_collate
-            in map f db
-      b = A.encode (map M.fromList db')
-  B.writeFile fn b
-
--- * Maybe List of String
-
-data Maybe_List_Of_String = S String | L [String] deriving (Eq,Show)
-
-maybe_list_to_list :: Maybe_List_Of_String -> [String]
-maybe_list_to_list m =
-    case m of
-      S s -> [s]
-      L l -> l
-
-list_to_maybe_list :: [String] -> Maybe_List_Of_String
-list_to_maybe_list l =
-    case l of
-      [s] -> S s
-      _ -> L l
-
--- > A.toJSON (S "x")
--- > A.toJSON (L ["x","y"])
-instance A.ToJSON Maybe_List_Of_String where
-    toJSON (S s) = A.toJSON s
-    toJSON (L l) = A.toJSON l
-
--- > :set -XOverloadedStrings
--- > A.decode "\"x\"" :: Maybe Maybe_List_Of_String
--- > A.decode "[\"x\",\"y\"]" :: Maybe Maybe_List_Of_String
-instance A.FromJSON Maybe_List_Of_String where
-    parseJSON v =
-        case v of
-          A.String _ -> fmap S (A.parseJSON v)
-          A.Array _ -> fmap L (A.parseJSON v)
-          _ -> error "parseJSON: Maybe_List_String"
diff --git a/Music/Theory/DB/Plain.hs b/Music/Theory/DB/Plain.hs
deleted file mode 100644
--- a/Music/Theory/DB/Plain.hs
+++ /dev/null
@@ -1,60 +0,0 @@
--- | @key: value@ database, allows duplicate @key@s.
-module Music.Theory.DB.Plain where
-
-import Data.List {- base -}
-import qualified Data.List.Split as Split {- split -}
-import Data.Maybe {- base -}
-import qualified Safe as Safe {- safe -}
-
-import qualified Music.Theory.IO as IO {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-
--- | (RECORD-SEPARATOR,FIELD-SEPARATOR,ENTRY-SEPARATOR)
-type SEP = (String,String,String)
-
-type Key = String
-type Value = String
-type Entry = (Key,[Value])
-type Record = [Entry]
-type DB = [Record]
-
-sep_plain :: SEP
-sep_plain = (['\n','\n'],['\n'],": ")
-
--- > record_parse (";","=") "F=f/rec;E=au;C=A;K=P;K=Q"
-record_parse :: (String,String) -> String -> Record
-record_parse (fs,es) = T.collate_adjacent . mapMaybe (T.separate_at es) . Split.splitOn fs
-
-record_lookup :: Key -> Record -> [Value]
-record_lookup k = fromMaybe [] . lookup k
-
-record_lookup_at :: (Key,Int) -> Record -> Maybe Value
-record_lookup_at (k,n) = flip Safe.atMay n . record_lookup k
-
-record_has_key :: Key -> Record -> Bool
-record_has_key k = isJust . lookup k
-
-record_lookup_uniq :: Key -> Record -> Maybe Value
-record_lookup_uniq k r =
-    case record_lookup k r of
-      [] -> Nothing
-      [v] -> Just v
-      _ -> error "record_lookup_uniq: non uniq"
-
-db_parse :: SEP -> String -> [Record]
-db_parse (rs,fs,es) s =
-    let r = Split.splitOn rs s
-    in map (record_parse (fs,es)) r
-
-db_sort :: [(Key,Int)] -> [Record] -> [Record]
-db_sort k = T.sort_by_n_stage (map record_lookup_at k)
-
-db_load_utf8 :: SEP -> FilePath -> IO [Record]
-db_load_utf8 sep = fmap (db_parse sep) . IO.read_file_utf8
-
--- > record_pp (";","=") [("F","f/rec.au"),("C","A")]
-record_pp :: (String,String) -> Record -> String
-record_pp (fs,es) = intercalate fs . map (\(k,v) -> k ++ es ++ v) . T.uncollate
-
-db_store_utf8 :: SEP -> FilePath -> [Record] -> IO ()
-db_store_utf8 (rs,fs,es) fn = IO.write_file_utf8 fn . intercalate rs . map (record_pp (fs,es))
diff --git a/Music/Theory/Db/Cli.hs b/Music/Theory/Db/Cli.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Db/Cli.hs
@@ -0,0 +1,52 @@
+module Music.Theory.Db.Cli where
+
+import qualified Music.Theory.Db.Csv as Csv {- hmt -}
+import qualified Music.Theory.Db.Common as Common {- hmt -}
+--import qualified Music.Theory.Db.Json as Json {- hmt -}
+import qualified Music.Theory.Db.Plain as Plain {- hmt -}
+
+db_load_ty :: String -> FilePath -> IO (Common.Db String String)
+db_load_ty ty fn =
+    case ty of
+      "plain" -> fmap (map Common.record_uncollate) (Plain.db_load_utf8 Plain.sep_plain fn)
+      --"json" -> JSON.db_load_utf8 fn
+      "csv" -> Csv.db_load_utf8 fn
+      _ -> error "db_load_ty"
+
+db_store_ty :: String -> FilePath -> Common.Db String String -> IO ()
+db_store_ty ty fn =
+    case ty of
+      "plain" -> Plain.db_store_utf8 Plain.sep_plain fn . map Common.record_collate
+      --"json" -> JSON.db_store_utf8 fn
+      "csv" -> Csv.db_store_utf8 fn
+      _ -> error "db_store_ty"
+
+-- > convert ("plain","csv") ("/home/rohan/ut/www-spr/data/db.text","/tmp/t.csv")
+-- > convert ("csv","json") ("/tmp/t.csv","/tmp/t.json")
+convert :: (String,String) -> (FilePath,FilePath) -> IO ()
+convert (input_ty,output_ty) (input_fn,output_fn) = do
+  db <- db_load_ty input_ty input_fn
+  db_store_ty output_ty output_fn db
+
+-- > stat "plain" "/home/rohan/ut/inland/db/artists.text"
+stat :: String -> FilePath -> IO ()
+stat ty fn = do
+  db <- db_load_ty ty fn
+  let ks = Common.db_key_set db
+  print ("#-records",length db)
+  print ("#-keys",length ks)
+  print ("key-set",unwords ks)
+
+help :: [String]
+help =
+    ["convert input-type output-type input-file output-file"
+    ,"stat type file-name"
+    ,""
+    ,"  type = csv | plain"] -- json
+
+db_cli :: [String] -> IO ()
+db_cli arg = do
+  case arg of
+    ["convert",i_ty,o_ty,i_fn,o_fn] -> convert (i_ty,o_ty) (i_fn,o_fn)
+    ["stat",ty,fn] -> stat ty fn
+    _ -> putStrLn (unlines help)
diff --git a/Music/Theory/Db/Common.hs b/Music/Theory/Db/Common.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Db/Common.hs
@@ -0,0 +1,131 @@
+-- | Database as [[(key,value)]]
+module Music.Theory.Db.Common where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Safe {- safe -}
+
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Maybe as T {- hmt-base -}
+
+-- * Type
+
+type Entry k v = (k,v)
+type Record k v = [Entry k v]
+type Db k v = [Record k v]
+
+type Key = String
+type Value = String
+type Entry' = Entry Key Value
+type Record' = Record Key Value
+type Db' = Db Key Value
+
+-- * Record
+
+-- | The sequence of keys at 'Record'.
+record_key_seq :: Record k v -> [k]
+record_key_seq = map fst
+
+-- | 'True' if 'Key' is present in 'Entity'.
+record_has_key :: Eq k => k -> Record k v -> Bool
+record_has_key k = elem k . record_key_seq
+
+-- | 'T.histogram' of 'record_key_seq'.
+record_key_histogram :: Ord k => Record k v -> [(k,Int)]
+record_key_histogram = T.histogram . record_key_seq
+
+-- | Duplicate keys predicate.
+record_has_duplicate_keys :: Ord k => Record k v -> Bool
+record_has_duplicate_keys = any ((> 0) . snd) . record_key_histogram
+
+-- | Find all associations for key using given equality function.
+record_lookup_by :: (k -> k -> Bool) -> k -> Record k v -> [v]
+record_lookup_by f k = map snd . filter (f k . fst)
+
+-- | 'record_lookup_by' of '=='.
+record_lookup :: Eq k => k -> Record k v -> [v]
+record_lookup = record_lookup_by (==)
+
+-- | /n/th element of 'record_lookup'.
+record_lookup_at :: Eq k => (k,Int) -> Record k v -> Maybe v
+record_lookup_at (c,n) = flip atMay n . record_lookup c
+
+-- | Variant of 'record_lookup' requiring a unique key.  'Nothing' indicates
+-- there is no entry, it is an 'error' if duplicate keys are present.
+record_lookup_uniq :: Eq k => k -> Record k v -> Maybe v
+record_lookup_uniq k r =
+    case record_lookup k r of
+      [] -> Nothing
+      [v] -> Just v
+      _ -> error "record_lookup_uniq: non uniq"
+
+-- | 'True' if key exists and is unique.
+record_has_key_uniq :: Eq k => k -> Record k v -> Bool
+record_has_key_uniq k = isJust . record_lookup_uniq k
+
+-- | Error variant.
+record_lookup_uniq_err :: Eq k => k -> Record k v -> v
+record_lookup_uniq_err k = T.from_just "record_lookup_uniq: none" . record_lookup_uniq k
+
+-- | Default value variant.
+record_lookup_uniq_def :: Eq k => v -> k -> Record k v -> v
+record_lookup_uniq_def v k = fromMaybe v . record_lookup_uniq k
+
+-- | Remove all associations for key using given equality function.
+record_delete_by :: (k -> k -> Bool) -> k -> Record k v -> Record k v
+record_delete_by f k = filter (not . f k . fst)
+
+-- | 'record_delete_by' of '=='.
+record_delete :: Eq k => k -> Record k v -> Record k v
+record_delete = record_delete_by (==)
+
+-- * Db
+
+-- | Preserves order of occurence.
+db_key_set :: Ord k => Db k v -> [k]
+db_key_set = nub . map fst . concat
+
+db_lookup_by :: (k -> k -> Bool) -> (v -> v -> Bool) -> k -> v -> Db k v -> [Record k v]
+db_lookup_by k_cmp v_cmp k v =
+    let f = any (v_cmp v) . record_lookup_by k_cmp k
+    in filter f
+
+db_lookup :: (Eq k,Eq v) => k -> v -> Db k v -> [Record k v]
+db_lookup = db_lookup_by (==) (==)
+
+db_has_duplicate_keys :: Ord k => Db k v -> Bool
+db_has_duplicate_keys = any record_has_duplicate_keys
+
+db_key_histogram :: Ord k => Db k v -> [(k,Int)]
+db_key_histogram db =
+    let h = concatMap record_key_histogram db
+        f k = (k,maximum (record_lookup k h))
+    in map f (db_key_set db)
+
+db_to_table :: Ord k => (Maybe v -> e) -> Db k v -> ([k],[[e]])
+db_to_table f db =
+    let kh = db_key_histogram db
+        hdr = concatMap (\(k,n) -> replicate n k) kh
+        ix = concatMap (\(k,n) -> zip (repeat k) [0 .. n - 1]) kh
+    in (hdr,map (\r -> map (\i -> f (record_lookup_at i r)) ix) db)
+
+-- * Collating duplicate keys.
+
+record_collate_from :: Eq k => (k,[v]) -> Record k v -> Record k [v]
+record_collate_from (k,v) r =
+    case r of
+      [] -> [(k,reverse v)]
+      (k',v'):r' ->
+          if k == k'
+          then record_collate_from (k,v' : v) r'
+          else (k,reverse v) : record_collate_from (k',[v']) r'
+
+-- | Collate adjacent entries of existing sequence with equal key.
+record_collate :: Eq k => Record k v -> Record k [v]
+record_collate r =
+    case r of
+      [] -> error "record_collate: nil"
+      (k,v):r' -> record_collate_from (k,[v]) r'
+
+record_uncollate :: Record k [v] -> Record k v
+record_uncollate = concatMap (\(k,v) -> zip (repeat k) v)
diff --git a/Music/Theory/Db/Csv.hs b/Music/Theory/Db/Csv.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Db/Csv.hs
@@ -0,0 +1,26 @@
+-- | Keys are given in the header, empty fields are omitted from records.
+module Music.Theory.Db.Csv where
+
+import Data.Maybe {- base -}
+
+import qualified Text.CSV.Lazy.String as C {- lazy-csv -}
+
+import qualified Music.Theory.Io as T {- hmt-base -}
+
+import Music.Theory.Db.Common {- hmt -}
+
+-- | Load 'DB' from 'FilePath'.
+db_load_utf8 :: FilePath -> IO Db'
+db_load_utf8 fn = do
+  s <- T.read_file_utf8 fn
+  let p = C.fromCSVTable (C.csvTable (C.parseCSV s))
+      (h,d) = (head p,tail p)
+      f k v = if null v then Nothing else Just (k,v)
+  return (map (catMaybes . zipWith f h) d)
+
+db_store_utf8 :: FilePath -> Db' -> IO ()
+db_store_utf8 fn db = do
+  let (hdr,tbl) = db_to_table (fromMaybe "") db
+      (_,tbl') = C.toCSVTable (hdr : tbl)
+      str = C.ppCSVTable tbl'
+  T.write_file_utf8 fn str
diff --git a/Music/Theory/Db/Plain.hs b/Music/Theory/Db/Plain.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Db/Plain.hs
@@ -0,0 +1,61 @@
+-- | @key: value@ database, allows duplicate @key@s.
+module Music.Theory.Db.Plain where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Data.List.Split as Split {- split -}
+import qualified Safe {- safe -}
+
+import qualified Music.Theory.Io as Io {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+
+-- | (Record-, Field-, Entry-) separators
+type Sep = (String, String, String)
+
+type Key = String
+type Value = String
+type Entry = (Key, [Value])
+type Record = [Entry]
+type Db = [Record]
+
+sep_plain :: Sep
+sep_plain = (['\n','\n'],['\n'],": ")
+
+-- > record_parse (";","=") "F=f/rec;E=au;C=A;K=P;K=Q"
+record_parse :: (String,String) -> String -> Record
+record_parse (fs,es) = T.collate_adjacent . mapMaybe (T.separate_at es) . Split.splitOn fs
+
+record_lookup :: Key -> Record -> [Value]
+record_lookup k = fromMaybe [] . lookup k
+
+record_lookup_at :: (Key,Int) -> Record -> Maybe Value
+record_lookup_at (k,n) = flip Safe.atMay n . record_lookup k
+
+record_has_key :: Key -> Record -> Bool
+record_has_key k = isJust . lookup k
+
+record_lookup_uniq :: Key -> Record -> Maybe Value
+record_lookup_uniq k r =
+    case record_lookup k r of
+      [] -> Nothing
+      [v] -> Just v
+      _ -> error "record_lookup_uniq: non uniq"
+
+db_parse :: Sep -> String -> [Record]
+db_parse (rs,fs,es) s =
+    let r = Split.splitOn rs s
+    in map (record_parse (fs,es)) r
+
+db_sort :: [(Key,Int)] -> [Record] -> [Record]
+db_sort k = T.sort_by_n_stage_on (map record_lookup_at k)
+
+db_load_utf8 :: Sep -> FilePath -> IO [Record]
+db_load_utf8 sep = fmap (db_parse sep) . Io.read_file_utf8
+
+-- > record_pp (";","=") [("F","f/rec.au"),("C","A")]
+record_pp :: (String,String) -> Record -> String
+record_pp (fs,es) = intercalate fs . map (\(k,v) -> k ++ es ++ v) . T.uncollate
+
+db_store_utf8 :: Sep -> FilePath -> [Record] -> IO ()
+db_store_utf8 (rs,fs,es) fn = Io.write_file_utf8 fn . intercalate rs . map (record_pp (fs,es))
diff --git a/Music/Theory/Directory.hs b/Music/Theory/Directory.hs
deleted file mode 100644
--- a/Music/Theory/Directory.hs
+++ /dev/null
@@ -1,38 +0,0 @@
--- | Directory functions.
-module Music.Theory.Directory where
-
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import System.Directory {- directory -}
-import System.FilePath {- filepath -}
-
--- | Scan a list of directories until a file is located, or not.
-path_scan :: [FilePath] -> FilePath -> IO (Maybe FilePath)
-path_scan p fn =
-    case p of
-      [] -> return Nothing
-      dir:p' -> let nm = dir </> fn
-                    f x = if x then return (Just nm) else path_scan p' fn
-                in doesFileExist nm >>= f
-
-path_scan_err :: [FilePath] -> FilePath -> IO FilePath
-path_scan_err p x =
-    let err = (error ("path_scan: " ++ show p ++ ": " ++ x))
-    in fmap (fromMaybe err) (path_scan p x)
-
--- | Subset of files in /dir/ with an extension in /ext/.
-dir_subset :: [String] -> FilePath -> IO [FilePath]
-dir_subset ext dir = do
-  let f nm = takeExtension nm `elem` ext
-  c <- getDirectoryContents dir
-  return (map (dir </>) (sort (filter f c)))
-
--- | If path is not absolute, prepend current working directory.
---
--- > to_absolute_cwd "x"
-to_absolute_cwd :: FilePath -> IO FilePath
-to_absolute_cwd x =
-    if isAbsolute x
-    then return x
-    else fmap (</> x) getCurrentDirectory
-
diff --git a/Music/Theory/Duration.hs b/Music/Theory/Duration.hs
--- a/Music/Theory/Duration.hs
+++ b/Music/Theory/Duration.hs
@@ -1,7 +1,6 @@
 -- | Common music notation duration model.
 module Music.Theory.Duration where
 
-import Control.Monad {- base -}
 import Data.List {- base -}
 import Data.Maybe {- base -}
 import Data.Ratio {- base -}
@@ -9,12 +8,16 @@
 import qualified Music.Theory.List as T {- hmt -}
 import qualified Music.Theory.Ord as T {- hmt -}
 
+type Division = Integer
+type Dots = Int
+
 -- | Common music notation durational model
-data Duration = Duration {division :: Integer -- ^ division of whole note
-                         ,dots :: Integer -- ^ number of dots
-                         ,multiplier :: Rational -- ^ tuplet modifier
-                         }
-                deriving (Eq,Show)
+data Duration =
+  Duration
+  {division :: Division -- ^ division of whole note
+  ,dots :: Int -- ^ number of dots
+  ,multiplier :: Rational} -- ^ tuplet modifier
+  deriving (Eq,Show)
 
 -- | Are multipliers equal?
 duration_meq :: Duration -> Duration -> Bool
@@ -52,48 +55,54 @@
 no_dots (x0,x1) = dots x0 == 0 && dots x1 == 0
 
 -- | Sum undotted divisions, input is required to be sorted.
-sum_dur_undotted :: (Integer, Integer) -> Maybe Duration
-sum_dur_undotted (x0, x1)
-    | x0 == x1 = Just (Duration (x0 `div` 2) 0 1)
-    | x0 == x1 * 2 = Just (Duration x1 1 1)
+sum_dur_undotted :: Rational -> (Division, Division) -> Maybe Duration
+sum_dur_undotted m (x0, x1)
+    | x0 == x1 = Just (Duration (x0 `div` 2) 0 m)
+    | x0 == x1 * 2 = Just (Duration x1 1 m)
     | otherwise = Nothing
 
--- | Sum dotted divisions, input is required to be sorted.
---
--- > sum_dur_dotted (4,1,4,1) == Just (Duration 2 1 1)
--- > sum_dur_dotted (4,0,2,1) == Just (Duration 1 0 1)
--- > sum_dur_dotted (8,1,4,0) == Just (Duration 4 2 1)
--- > sum_dur_dotted (16,0,4,2) == Just (Duration 2 0 1)
-sum_dur_dotted :: (Integer,Integer,Integer,Integer) -> Maybe Duration
-sum_dur_dotted (x0, n0, x1, n1)
+{- | Sum dotted divisions, input is required to be sorted.
+
+> sum_dur_dotted 1 (4,1,4,1) == Just (Duration 2 1 1)
+> sum_dur_dotted 1 (4,0,2,1) == Just (Duration 1 0 1)
+> sum_dur_dotted 1 (8,1,4,0) == Just (Duration 4 2 1)
+> sum_dur_dotted 1 (16,0,4,2) == Just (Duration 2 0 1)
+-}
+sum_dur_dotted :: Rational -> (Division,Dots,Division,Dots) -> Maybe Duration
+sum_dur_dotted m (x0, n0, x1, n1)
     | x0 == x1 &&
       n0 == 1 &&
-      n1 == 1 = Just (Duration (x1 `div` 2) 1 1)
+      n1 == 1 = Just (Duration (x1 `div` 2) 1 m)
     | x0 == x1 * 2 &&
       n0 == 0 &&
-      n1 == 1 = Just (Duration (x1 `div` 2) 0 1)
+      n1 == 1 = Just (Duration (x1 `div` 2) 0 m)
     | x0 == x1 * 4 &&
       n0 == 0 &&
-      n1 == 2 = Just (Duration (x1 `div` 2) 0 1)
+      n1 == 2 = Just (Duration (x1 `div` 2) 0 m)
     | x0 == x1 * 2 &&
       n0 == 1 &&
-      n1 == 0 = Just (Duration x1 2 1)
+      n1 == 0 = Just (Duration x1 2 m)
     | otherwise = Nothing
 
--- | Sum durations.  Not all durations can be summed, and the present
---   algorithm is not exhaustive.
---
--- > import Music.Theory.Duration.Name
--- > sum_dur quarter_note eighth_note == Just dotted_quarter_note
--- > sum_dur dotted_quarter_note eighth_note == Just half_note
--- > sum_dur quarter_note dotted_eighth_note == Just double_dotted_quarter_note
+{- | Sum durations.  Not all durations can be summed, and the present
+     algorithm is not exhaustive.
+
+> import Music.Theory.Duration
+> import Music.Theory.Duration.Name
+> sum_dur quarter_note eighth_note == Just dotted_quarter_note
+> sum_dur dotted_quarter_note eighth_note == Just half_note
+> sum_dur quarter_note dotted_eighth_note == Just double_dotted_quarter_note
+-}
 sum_dur :: Duration -> Duration -> Maybe Duration
 sum_dur y0 y1 =
-    let f (x0,x1) = if no_dots (x0,x1)
-                    then sum_dur_undotted (division x0, division x1)
-                    else sum_dur_dotted (division x0, dots x0
-                                        ,division x1, dots x1)
-    in join (fmap f (T.sort_pair_m duration_compare_meq (y0,y1)))
+    let (m0,m1) = (multiplier y0,multiplier y1)
+        f (x0,x1) = if m0 /= m1
+                    then Nothing -- cannot sum durations with non-equal multipliers
+                    else if no_dots (x0,x1)
+                         then sum_dur_undotted m0 (division x0, division x1)
+                         else sum_dur_dotted m0 (division x0, dots x0
+                                                ,division x1, dots x1)
+    in T.sort_pair_m duration_compare_meq (y0,y1) >>= f
 
 -- | Erroring variant of 'sum_dur'.
 sum_dur_err :: Duration -> Duration -> Duration
@@ -102,46 +111,52 @@
         err = error ("sum_dur': " ++ show (y0,y1))
     in fromMaybe err y2
 
--- | Standard divisions (from 0 to 256).  MusicXML allows @-1@ as a division (for @long@).
-divisions_set :: [Integer]
-divisions_set = [0,1,2,4,8,16,32,64,128,256]
+{- | Standard divisions (from 1 to 256).
+MusicXml allows 0 for breve and -1 for long.
+Negative divisors can represent any number of longer durations, -2 be a breve, -4 a long, -8 a maximus, &etc.
+-}
+divisions_std_set :: [Division]
+divisions_std_set = [1,2,4,8,16,32,64,128,256]
 
--- | Durations set derived from 'divisions_set' with up to /k/ dots.  Multiplier of @1@.
-duration_set :: Integer -> [Duration]
-duration_set k = [Duration dv dt 1 | dv <- divisions_set, dt <- [0..k]]
+divisions_musicxml_set :: [Division]
+divisions_musicxml_set = -1 : 0 : divisions_std_set
 
+-- | Durations set derived from 'divisions_std_set' with up to /k/ dots.  Multiplier of @1@.
+duration_set :: Dots -> [Duration]
+duration_set k = [Duration dv dt 1 | dv <- divisions_std_set, dt <- [0..k]]
+
 -- | Table of number of beams at notated division.
-beam_count_tbl :: [(Integer,Integer)]
-beam_count_tbl = zip (-1 : divisions_set) [0,0,0,0,0,1,2,3,4,5,6]
+beam_count_tbl :: [(Division,Int)]
+beam_count_tbl = zip divisions_musicxml_set [0,0,0,0,0,1,2,3,4,5,6]
 
 -- | Lookup 'beam_count_tbl'.
 --
 -- > whole_note_division_to_beam_count 32 == Just 3
-whole_note_division_to_beam_count :: Integer -> Maybe Integer
+whole_note_division_to_beam_count :: Division -> Maybe Int
 whole_note_division_to_beam_count x = lookup x beam_count_tbl
 
 -- | Calculate number of beams at 'Duration'.
 --
 -- > map duration_beam_count [Duration 2 0 1,Duration 16 0 1] == [0,2]
-duration_beam_count :: Duration -> Integer
+duration_beam_count :: Duration -> Int
 duration_beam_count (Duration x _ _) =
     let err = error "duration_beam_count"
         bc = whole_note_division_to_beam_count x
     in fromMaybe err bc
 
--- * MusicXML
+-- * MusicXml
 
--- | Table giving @MusicXML@ types for divisions.
-division_musicxml_tbl :: [(Integer,String)]
+-- | Table giving MusicXml types for divisions.
+division_musicxml_tbl :: [(Division,String)]
 division_musicxml_tbl =
     let nm = ["long","breve","whole","half","quarter","eighth"
              ,"16th","32nd","64th","128th","256th"]
-    in zip (-1 : divisions_set) nm
+    in zip divisions_musicxml_set nm
 
 -- | Lookup 'division_musicxml_tbl'.
 --
 -- > map whole_note_division_to_musicxml_type [2,4] == ["half","quarter"]
-whole_note_division_to_musicxml_type :: Integer -> String
+whole_note_division_to_musicxml_type :: Division -> String
 whole_note_division_to_musicxml_type x =
     T.lookup_err_msg "division_musicxml_tbl" x division_musicxml_tbl
 
@@ -161,7 +176,7 @@
 -- | Lookup 'division_unicode_tbl'.
 --
 -- > map whole_note_division_to_unicode_symbol [1,2,4,8] == "𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮"
-whole_note_division_to_unicode_symbol :: Integer -> Char
+whole_note_division_to_unicode_symbol :: Division -> Char
 whole_note_division_to_unicode_symbol x =
     T.lookup_err_msg "division_unicode_tbl" x division_unicode_tbl
 
@@ -175,8 +190,8 @@
 
 -- * Lilypond
 
--- | Give /Lilypond/ notation for 'Duration'.  Note that the duration
--- multiplier is /not/ written.
+-- | Give /Lilypond/ notation for 'Duration'.
+-- Note that the duration multiplier is /not/ written.
 --
 -- > map duration_to_lilypond_type [Duration 2 0 1,Duration 4 1 1] == ["2","4."]
 duration_to_lilypond_type :: Duration -> String
@@ -191,11 +206,10 @@
 <http://humdrum.org/Humdrum/representations/recip.rep.html>
 
 > let d = map (\z -> Duration z 0 1) [0,1,2,4,8,16,32]
-> in map duration_recip_pp d == ["0","1","2","4","8","16","32"]
+> map duration_recip_pp d == ["0","1","2","4","8","16","32"]
 
 > let d = [Duration 1 1 (1/3),Duration 4 1 1,Duration 4 1 (2/3)]
-> in map duration_recip_pp d == ["3.","4.","6."]
-
+> map duration_recip_pp d == ["3.","4.","6."]
 -}
 duration_recip_pp :: Duration -> String
 duration_recip_pp (Duration x d m) =
@@ -207,20 +221,40 @@
 
 -- * Letter
 
-whole_note_division_letter_pp :: Integer -> Maybe Char
-whole_note_division_letter_pp x =
-    let t = [(16,'s'),(8,'e'),(4,'q'),(2,'h'),(1,'w')]
-    in lookup x t
+{- | Names for note divisions.
+Starting from 1/32 these names haev uniqe initial letters that can be used for concise notation.
+-}
+whole_note_division_name_tbl :: [(Division, String)]
+whole_note_division_name_tbl =
+  [(64,"sixtyfourth") -- hemidemisemiquaver
+  ,(32,"thirtysecond") -- demisemiquaver
+  ,(16,"sixteenth") -- semiquaver
+  ,(8,"eighth") -- quaver
+  ,(4,"quarter") -- crotchet
+  ,(2,"half") -- minim
+  ,(1,"whole") -- semibreve
+  ,(0,"breve")
+  ,(-1,"longa")
+  ,(-2,"maxima")]
 
--- > mapMaybe duration_letter_pp [Duration 4 0 1,Duration 2 1 1,Duration 8 2 1] == ["q","h'","e''"]
--- > duration_letter_pp
+whole_note_division_name :: Division -> Maybe String
+whole_note_division_name = flip lookup whole_note_division_name_tbl
+
+whole_note_division_letter_tbl :: [(Division, Char)]
+whole_note_division_letter_tbl = map (\(d,n) -> (d,head n)) whole_note_division_name_tbl
+
+  -- > mapMaybe whole_note_division_letter_pp [-2, -1, 0, 1, 2, 4, 8, 16, 32] == "mlbwhqest"
+whole_note_division_letter_pp :: Division -> Maybe Char
+whole_note_division_letter_pp = flip lookup (tail whole_note_division_letter_tbl)
+
+-- > mapMaybe duration_letter_pp [Duration 4 0 1,Duration 2 1 1,Duration 8 2 1] == ["q","h.","e.."]
+-- > mapMaybe duration_letter_pp [Duration 4 1 (2/3)] == ["q./2:3"]
 duration_letter_pp :: Duration -> Maybe String
 duration_letter_pp (Duration x d m) =
-    let d' = genericReplicate d '\''
+    let d' = genericReplicate d '.'
         m' = case (numerator m,denominator m) of
                (1,1) -> ""
-               (1,i) -> '/' : show i
-               (i,j) -> '*' : show i ++ "/" ++ show j
+               (i,j) -> '/' : show i ++ ":" ++ show j
     in case whole_note_division_letter_pp x of
          Just x' -> Just (x' : d' ++ m')
          _ -> Nothing
diff --git a/Music/Theory/Duration/Annotation.hs b/Music/Theory/Duration/Annotation.hs
--- a/Music/Theory/Duration/Annotation.hs
+++ b/Music/Theory/Duration/Annotation.hs
@@ -5,9 +5,10 @@
 import Data.Ratio {- base -}
 import Data.Tree {- containers -}
 
+import qualified Music.Theory.List as L {- hmt-base -}
+
 import Music.Theory.Duration
-import Music.Theory.Duration.RQ
-import qualified Music.Theory.List as L {- hmt -}
+import Music.Theory.Duration.Rq
 
 -- | Standard music notation durational model annotations
 data D_Annotation = Tie_Right
@@ -57,7 +58,7 @@
 da_tuplet (d,n) x =
     let fn (p,q) = (p {multiplier = n%d},q)
         k = sum (map (duration_to_rq . fst) x) / (d%1)
-        ty = rq_to_duration_err (show ("da_tuplet",d,n,x,k)) k
+        ty = rq_to_duration_err (show ("da_tuplet",d,n,x,k)) 2 k
         t0 = [Begin_Tuplet (d,n,ty)]
         ts = [t0] ++ replicate (length x - 2) [] ++ [[End_Tuplet]]
         jn (p,q) z = (p,q++z)
diff --git a/Music/Theory/Duration/CT.hs b/Music/Theory/Duration/CT.hs
deleted file mode 100644
--- a/Music/Theory/Duration/CT.hs
+++ /dev/null
@@ -1,195 +0,0 @@
--- | Functions to generate a click track from a metric structure.
-module Music.Theory.Duration.CT where
-
-import Data.Function {- base -}
-import Data.List {- base -}
-import Data.Maybe {- base -}
-
-import qualified Music.Theory.Duration.RQ as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Time_Signature as T {- hmt -}
-import qualified Music.Theory.Time.Seq as T {- hmt -}
-
--- | 1-indexed.
-type Measure = Int
-
--- | 1-indexed.
-type Pulse = Int
-
--- | Transform measures given as 'T.RQ' divisions to absolute 'T.RQ'
--- locations.  /mdv/ abbreviates measure divisions.
---
--- > mdv_to_mrq [[1,2,1],[3,2,1]] == [[0,1,3],[4,7,9]]
-mdv_to_mrq :: [[T.RQ]] -> [[T.RQ]]
-mdv_to_mrq = snd . mapAccumL T.dx_d' 0
-
--- | Lookup function for ('Measure','Pulse') indexed structure.
-mp_lookup_err :: [[a]] -> (Measure,Pulse) -> a
-mp_lookup_err sq (m,p) =
-    if m < 1 || p < 1
-    then error (show ("mp_lookup_err: one indexed?",m,p))
-    else (sq !! (m - 1)) !! (p - 1)
-
--- | Comparison for ('Measure','Pulse') indices.
-mp_compare :: (Measure,Pulse) -> (Measure,Pulse) -> Ordering
-mp_compare = T.two_stage_compare (compare `on` fst) (compare `on` snd)
-
--- * CT
-
--- | Latch measures (ie. make measures contiguous, hold previous value).
---
--- > unzip (ct_ext 10 'a' [(3,'b'),(8,'c')]) == ([1..10],"aabbbbbccc")
-ct_ext :: Int -> a -> [(Measure,a)] -> [(Measure,a)]
-ct_ext n def sq = T.tseq_latch def sq [1 .. n]
-
--- | Variant that requires a value at measure one (first measure).
-ct_ext1 :: Int -> [(Measure,a)] -> [(Measure,a)]
-ct_ext1 n sq =
-    case sq of
-      (1,e) : sq' -> ct_ext n e sq'
-      _ -> error "ct_ext1"
-
--- | 'T.rts_divisions' of 'ct_ext1'.
-ct_dv_seq :: Int -> T.Tseq Measure T.Rational_Time_Signature -> [(Measure,[[T.RQ]])]
-ct_dv_seq n ts = map (fmap T.rts_divisions) (ct_ext1 n ts)
-
--- | 'ct_dv_seq' without measures numbers.
-ct_mdv_seq :: Int -> T.Tseq Measure T.Rational_Time_Signature -> [[T.RQ]]
-ct_mdv_seq n = map (concat . snd) . ct_dv_seq n
-
--- | 'mdv_to_mrq' of 'ct_mdv_seq'.
-ct_rq :: Int -> T.Tseq Measure T.Rational_Time_Signature -> [[T.RQ]]
-ct_rq n ts = mdv_to_mrq (ct_mdv_seq n ts)
-
-ct_mp_lookup :: [[T.RQ]] -> (Measure,Pulse) -> T.RQ
-ct_mp_lookup = mp_lookup_err . mdv_to_mrq
-
-ct_m_to_rq :: [[T.RQ]] -> [(Measure,t)] -> [(T.RQ,t)]
-ct_m_to_rq sq = map (\(m,c) -> (ct_mp_lookup sq (m,1),c))
-
--- | Latch rehearsal mark sequence, only indicating marks.  Initial mark is @.@.
---
--- > ct_mark_seq 2 [] == [(1,Just '.'),(2,Nothing)]
---
--- > let r = [(1,Just '.'),(3,Just 'A'),(8,Just 'B')]
--- > in filter (isJust . snd) (ct_mark_seq 10 [(3,'A'),(8,'B')]) == r
-ct_mark_seq :: Int -> T.Tseq Measure Char -> T.Tseq Measure (Maybe Char)
-ct_mark_seq n mk = T.seq_changed (ct_ext n '.' mk)
-
--- | Indicate measures prior to marks.
---
--- > ct_pre_mark [] == []
--- > ct_pre_mark [(1,'A')] == []
--- > ct_pre_mark [(3,'A'),(8,'B')] == [(2,Just ()),(7,Just ())]
-ct_pre_mark :: [(Measure,a)] -> [(Measure,Maybe ())]
-ct_pre_mark = mapMaybe (\(m,_) -> if m <= 1 then Nothing else Just (m - 1,Just ()))
-
--- | Contiguous pre-mark sequence.
---
--- > ct_pre_mark_seq 1 [(1,'A')] == [(1,Nothing)]
--- > ct_pre_mark_seq 10 [(3,'A'),(8,'B')]
-ct_pre_mark_seq :: Measure -> T.Tseq Measure Char -> T.Tseq Measure (Maybe ())
-ct_pre_mark_seq n mk =
-    let pre = ct_pre_mark mk
-    in T.tseq_merge_resolve const pre (zip [1 .. n] (repeat Nothing))
-
-ct_tempo_lseq_rq :: [[T.RQ]] -> T.Lseq (Measure,Pulse) T.RQ -> T.Lseq T.RQ T.RQ
-ct_tempo_lseq_rq sq = T.lseq_tmap (ct_mp_lookup sq)
-
--- | Interpolating lookup of tempo sequence ('T.lseq_lookup_err').
-ct_tempo_at :: T.Lseq T.RQ T.RQ -> T.RQ -> Rational
-ct_tempo_at = T.lseq_lookup_err compare
-
--- | Types of nodes.
-data CT_Node = CT_Mark T.RQ -- ^ The start of a measure with a rehearsal mark.
-             | CT_Start T.RQ -- ^ The start of a regular measure.
-             | CT_Normal T.RQ -- ^ A regular pulse.
-             | CT_Edge T.RQ -- ^ The start of a pulse group within a measure.
-             | CT_Pre T.RQ -- ^ A regular pulse in a measure prior to a rehearsal mark.
-             | CT_End -- ^ The end of the track.
-               deriving (Eq,Show)
-
--- | Lead-in of @(pulse,tempo,count)@.
-ct_leadin :: (T.RQ,Double,Int) -> T.Dseq Double CT_Node
-ct_leadin (du,tm,n) = replicate n (realToFrac du * (60 / tm),CT_Normal du)
-
--- | Prepend initial element to start of list.
---
--- > delay1 "abc" == "aabc"
-delay1 :: [a] -> [a]
-delay1 l =
-    case l of
-      [] -> error "delay1: []"
-      e:_ -> e : l
-
-ct_measure:: T.Lseq T.RQ T.RQ -> ([T.RQ],Maybe Char,Maybe (),[[T.RQ]]) -> [(Rational,CT_Node)]
-ct_measure sq (mrq,mk,pr,dv) =
-    let dv' = concatMap (zip [1::Int ..]) dv
-        f (p,rq,(g,du)) =
-            let nm = if p == 1
-                     then case mk of
-                            Nothing -> CT_Start du
-                            Just _ -> CT_Mark du
-                     else if pr == Just ()
-                          then CT_Pre du
-                          else if g == 1 then CT_Edge du else CT_Normal du
-            in (du * (60 / ct_tempo_at sq rq),nm)
-    in map f (zip3 [1::Int ..] mrq dv')
-
--- | Click track definition.
-data CT = CT {ct_len :: Int
-             ,ct_ts :: [(Measure,T.Rational_Time_Signature)]
-             ,ct_mark :: [(Measure,Char)]
-             ,ct_tempo :: T.Lseq (Measure,Pulse) T.RQ
-             ,ct_count :: (T.RQ,Int)}
-          deriving Show
-
--- | Initial tempo, if given.
-ct_tempo0 :: CT -> Maybe T.RQ
-ct_tempo0 ct =
-    case ct_tempo ct of
-      (((1,1),_),n):_ -> Just n
-      _ -> Nothing
-
--- | Erroring variant.
-ct_tempo0_err :: CT -> T.RQ
-ct_tempo0_err = fromMaybe (error "ct_tempo0") . ct_tempo0
-
--- > import Music.Theory.Duration.CT
--- > import Music.Theory.Time.Seq
--- > let ct = CT 2 [(1,[(3,8),(2,4)])] [(1,'a')] [(((1,0),T.None),60)] undefined
--- > ct_measures ct
-ct_measures :: CT -> [T.Dseq Rational CT_Node]
-ct_measures (CT n ts mk tm _) =
-    let f msg sq = let (m,v) = unzip sq
-                   in if m == [1 .. n]
-                      then v
-                      else error (show ("ct_measures",msg,sq,m,v,n))
-        msr = zip4
-              (f "ts" (zip [1..] (ct_rq n ts)))
-              (f "mk" (ct_mark_seq n mk))
-              (f "pre-mk" (ct_pre_mark_seq n mk))
-              (f "dv" (ct_dv_seq n ts))
-    in map (ct_measure (ct_tempo_lseq_rq (ct_mdv_seq n ts) tm)) msr
-
-ct_dseq' :: CT -> T.Dseq Rational CT_Node
-ct_dseq' = concat . ct_measures
-
-ct_dseq :: CT -> T.Dseq Double CT_Node
-ct_dseq = T.dseq_tmap fromRational . ct_dseq'
-
--- * Indirect
-
-ct_rq_measure :: [[T.RQ]] -> T.RQ -> Maybe Measure
-ct_rq_measure sq rq = fmap fst (find ((rq `elem`) . snd) (zip [1..] sq))
-
-ct_rq_mp :: [[T.RQ]] -> T.RQ -> Maybe (Measure,Pulse)
-ct_rq_mp sq rq =
-    let f (m,l) = (m,fromMaybe (error "ct_rq_mp: ix") (findIndex (== rq) l) + 1)
-    in fmap f (find ((rq `elem`) . snd) (zip [1..] sq))
-
-ct_rq_mp_err :: [[T.RQ]] -> T.RQ -> (Measure, Pulse)
-ct_rq_mp_err sq = fromMaybe (error "ct_rq_mp") . ct_rq_mp sq
-
-ct_mp_to_rq :: [[T.RQ]] -> [((Measure,Pulse),t)] -> [(T.RQ,t)]
-ct_mp_to_rq sq = map (\(mp,c) -> (ct_mp_lookup sq mp,c))
diff --git a/Music/Theory/Duration/ClickTrack.hs b/Music/Theory/Duration/ClickTrack.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Duration/ClickTrack.hs
@@ -0,0 +1,216 @@
+-- | Functions to generate a click track from a metric structure.
+module Music.Theory.Duration.ClickTrack where
+
+import Data.Bifunctor {- base -}
+import Data.Function {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Music.Theory.List as List {- hmt-base -}
+
+import qualified Music.Theory.Duration.Rq as T {- hmt -}
+import qualified Music.Theory.Time_Signature as T {- hmt -}
+import qualified Music.Theory.Time.Seq as T {- hmt -}
+
+-- | 1-indexed.
+type Measure = Int
+
+-- | 1-indexed.
+type Pulse = Int
+
+-- | Measures given as 'T.Rq' divisions, Mdv abbreviates measure divisions.
+type Mdv = [[T.Rq]]
+
+{- | Absolute 'T.Rq' locations grouped in measures.
+     mrq abbreviates measure rational quarter-notes.
+     Locations are zero-indexed.
+-}
+type Mrq = [[T.Rq]]
+
+{- | Transform Mdv to Mrq.
+
+> mdv_to_mrq [[1,2,1],[3,2,1]] == [[0,1,3],[4,7,9]]
+-}
+mdv_to_mrq :: Mdv -> Mrq
+mdv_to_mrq = snd . mapAccumL List.dx_d' 0
+
+{- | Lookup function for ('Measure','Pulse') indexed structure.
+     mp abbreviates Measure Pulse.
+-}
+mp_lookup_err :: [[t]] -> (Measure,Pulse) -> t
+mp_lookup_err sq (m,p) =
+    if m < 1 || p < 1
+    then error (show ("mp_lookup_err: one indexed?",m,p))
+    else (sq !! (m - 1)) !! (p - 1)
+
+-- | Comparison for ('Measure','Pulse') indices.
+mp_compare :: (Measure,Pulse) -> (Measure,Pulse) -> Ordering
+mp_compare = List.two_stage_compare (compare `on` fst) (compare `on` snd)
+
+-- * Ct
+
+{- | Latch measures (ie. make measures contiguous, hold previous value).
+     Arguments are the number of measures and the default (intial) value.
+
+> unzip (ct_ext 10 'a' [(3,'b'),(8,'c')]) == ([1..10],"aabbbbbccc")
+-}
+ct_ext :: Int -> t -> T.Tseq Measure t -> T.Tseq Measure t
+ct_ext n def sq = T.tseq_latch def sq [1 .. n]
+
+-- | Variant that requires a value at measure one (first measure).
+ct_ext1 :: Int -> T.Tseq Measure t -> T.Tseq Measure t
+ct_ext1 n sq =
+    case sq of
+      (1,e) : sq' -> ct_ext n e sq'
+      _ -> error "ct_ext1"
+
+-- | 'T.rts_divisions' of 'ct_ext1'.
+ct_dv_seq :: Int -> T.Tseq Measure T.Rational_Time_Signature -> [(Measure,[[T.Rq]])]
+ct_dv_seq n ts = map (fmap T.rts_divisions) (ct_ext1 n ts)
+
+-- | 'ct_dv_seq' without measures numbers (which are 1..n)
+ct_mdv_seq :: Int -> T.Tseq Measure T.Rational_Time_Signature -> [[T.Rq]]
+ct_mdv_seq n = map (concat . snd) . ct_dv_seq n
+
+-- | 'mdv_to_mrq' of 'ct_mdv_seq'.
+ct_rq :: Int -> T.Tseq Measure T.Rational_Time_Signature -> [[T.Rq]]
+ct_rq n ts = mdv_to_mrq (ct_mdv_seq n ts)
+
+ct_mp_lookup :: [[T.Rq]] -> (Measure,Pulse) -> T.Rq
+ct_mp_lookup = mp_lookup_err . mdv_to_mrq
+
+ct_m_to_rq :: [[T.Rq]] -> [(Measure,t)] -> [(T.Rq,t)]
+ct_m_to_rq sq = map (\(m,c) -> (ct_mp_lookup sq (m,1),c))
+
+-- | Latch rehearsal mark sequence, only indicating marks.  Initial mark is @.@.
+--
+-- > ct_mark_seq 2 [] == [(1,Just '.'),(2,Nothing)]
+--
+-- > let r = [(1,Just '.'),(3,Just 'A'),(8,Just 'B')]
+-- > in filter (isJust . snd) (ct_mark_seq 10 [(3,'A'),(8,'B')]) == r
+ct_mark_seq :: Int -> T.Tseq Measure Char -> T.Tseq Measure (Maybe Char)
+ct_mark_seq n mk = T.seq_changed (ct_ext n '.' mk)
+
+-- | Indicate measures prior to marks.
+--
+-- > ct_pre_mark [] == []
+-- > ct_pre_mark [(1,'A')] == []
+-- > ct_pre_mark [(3,'A'),(8,'B')] == [(2,Just ()),(7,Just ())]
+ct_pre_mark :: [(Measure,a)] -> [(Measure,Maybe ())]
+ct_pre_mark = mapMaybe (\(m,_) -> if m <= 1 then Nothing else Just (m - 1,Just ()))
+
+-- | Contiguous pre-mark sequence.
+--
+-- > ct_pre_mark_seq 1 [(1,'A')] == [(1,Nothing)]
+-- > ct_pre_mark_seq 10 [(3,'A'),(8,'B')]
+ct_pre_mark_seq :: Measure -> T.Tseq Measure Char -> T.Tseq Measure (Maybe ())
+ct_pre_mark_seq n mk =
+    let pre = ct_pre_mark mk
+    in T.tseq_merge_resolve const pre (zip [1 .. n] (repeat Nothing))
+
+ct_tempo_lseq_rq :: [[T.Rq]] -> T.Lseq (Measure,Pulse) T.Rq -> T.Lseq T.Rq T.Rq
+ct_tempo_lseq_rq sq = T.lseq_tmap (ct_mp_lookup sq)
+
+-- | Interpolating lookup of tempo sequence ('T.lseq_lookup_err').
+ct_tempo_at :: T.Lseq T.Rq T.Rq -> T.Rq -> Rational
+ct_tempo_at = T.lseq_lookup_err compare
+
+-- | Types of nodes.
+data Ct_Node = Ct_Mark T.Rq -- ^ The start of a measure with a rehearsal mark.
+             | Ct_Start T.Rq -- ^ The start of a regular measure.
+             | Ct_Normal T.Rq -- ^ A regular pulse.
+             | Ct_Edge T.Rq -- ^ The start of a pulse group within a measure.
+             | Ct_Pre T.Rq -- ^ A regular pulse in a measure prior to a rehearsal mark.
+             | Ct_End -- ^ The end of the track.
+               deriving (Eq,Show)
+
+-- | Lead-in of @(pulse,tempo,count)@.
+ct_leadin :: (T.Rq,Double,Int) -> T.Dseq Double Ct_Node
+ct_leadin (du,tm,n) = replicate n (realToFrac du * (60 / tm),Ct_Normal du)
+
+-- | Prepend initial element to start of list.
+--
+-- > delay1 "abc" == "aabc"
+delay1 :: [a] -> [a]
+delay1 l =
+    case l of
+      [] -> error "delay1: []"
+      e:_ -> e : l
+
+{- | Generate Ct measure.
+     Calculates durations of events considering only the tempo at the start of the event.
+     To be correct it should consider the tempo envelope through the event.
+-}
+ct_measure:: T.Lseq T.Rq T.Rq -> ([T.Rq],Maybe Char,Maybe (),[[T.Rq]]) -> [(Rational,Ct_Node)]
+ct_measure sq (mrq,mk,pr,dv) =
+    let dv' = concatMap (zip [1::Int ..]) dv
+        f (p,rq,(g,du)) =
+            let nm = if p == 1
+                     then case mk of
+                            Nothing -> Ct_Start du
+                            Just _ -> Ct_Mark du
+                     else if pr == Just ()
+                          then Ct_Pre du
+                          else if g == 1 then Ct_Edge du else Ct_Normal du
+            in (du * (60 / ct_tempo_at sq rq),nm)
+    in map f (zip3 [1::Int ..] mrq dv')
+
+-- | Click track definition.
+data Ct =
+  Ct
+  {ct_len :: Int
+  ,ct_ts :: [(Measure,T.Rational_Time_Signature)]
+  ,ct_mark :: [(Measure,Char)]
+  ,ct_tempo :: T.Lseq (Measure,Pulse) T.Rq
+  ,ct_count :: (T.Rq,Int)}
+  deriving Show
+
+-- | Initial tempo, if given.
+ct_tempo0 :: Ct -> Maybe T.Rq
+ct_tempo0 ct =
+    case ct_tempo ct of
+      (((1,1),_),n):_ -> Just n
+      _ -> Nothing
+
+-- | Erroring variant.
+ct_tempo0_err :: Ct -> T.Rq
+ct_tempo0_err = fromMaybe (error "ct_tempo0") . ct_tempo0
+
+-- > import Music.Theory.Duration.Ct
+-- > import Music.Theory.Time.Seq
+-- > let ct = CT 2 [(1,[(3,8),(2,4)])] [(1,'a')] [(((1,1),T.None),60)] undefined
+-- > ct_measures ct
+ct_measures :: Ct -> [T.Dseq Rational Ct_Node]
+ct_measures (Ct n ts mk tm _) =
+    let f msg sq = let (m,v) = unzip sq
+                   in if m == [1 .. n]
+                      then v
+                      else error (show ("ct_measures",msg,sq,m,v,n))
+        msr = zip4
+              (f "ts" (zip [1..] (ct_rq n ts)))
+              (f "mk" (ct_mark_seq n mk))
+              (f "pre-mk" (ct_pre_mark_seq n mk))
+              (f "dv" (ct_dv_seq n ts))
+    in map (ct_measure (ct_tempo_lseq_rq (ct_mdv_seq n ts) tm)) msr
+
+ct_dseq' :: Ct -> T.Dseq Rational Ct_Node
+ct_dseq' = concat . ct_measures
+
+ct_dseq :: Ct -> T.Dseq Double Ct_Node
+ct_dseq = T.dseq_tmap fromRational . ct_dseq'
+
+-- * Indirect
+
+ct_rq_measure :: [[T.Rq]] -> T.Rq -> Maybe Measure
+ct_rq_measure sq rq = fmap fst (find ((rq `elem`) . snd) (zip [1..] sq))
+
+ct_rq_mp :: [[T.Rq]] -> T.Rq -> Maybe (Measure,Pulse)
+ct_rq_mp sq rq =
+    let f (m,l) = (m,fromMaybe (error "ct_rq_mp: ix") (elemIndex rq l) + 1)
+    in fmap f (find ((rq `elem`) . snd) (zip [1..] sq))
+
+ct_rq_mp_err :: [[T.Rq]] -> T.Rq -> (Measure, Pulse)
+ct_rq_mp_err sq = fromMaybe (error "ct_rq_mp") . ct_rq_mp sq
+
+ct_mp_to_rq :: [[T.Rq]] -> [((Measure,Pulse),t)] -> [(T.Rq,t)]
+ct_mp_to_rq sq = map (first (ct_mp_lookup sq))
diff --git a/Music/Theory/Duration/Hollos2014.hs b/Music/Theory/Duration/Hollos2014.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Duration/Hollos2014.hs
@@ -0,0 +1,104 @@
+-- | "Creating Rhythms" by Stefan Hollos and J. Richard Hollos
+--    <http://abrazol.com/books/rhythm1/software.html>
+module Music.Theory.Duration.Hollos2014 where
+
+import Data.List {- base -}
+
+import Music.Theory.List {- hmt-base -}
+
+import Music.Theory.Permutations.List {- hmt -}
+import Music.Theory.Set.List {- hmt -}
+
+-- | Donald Knuth, Art of Computer Programming, Algorithm H
+--   <http://www-cs-faculty.stanford.edu/~knuth/fasc3b.ps.gz>
+--
+-- > partm 3 6 == [[1,1,4],[2,1,3],[2,2,2]]
+partm :: (Num a, Ord a) => a -> a -> [[a]]
+partm i j =
+  let f t m n =
+        if m == 1 && t == n
+        then [[t]]
+        else if n < m || n < 1 || m < 1 || t < 1
+             then []
+        else [reverse (t : r) | r <- f t (m - 1) (n - t)] ++ (f (t - 1) m n)
+  in f (j - i + 1) i j
+
+-- | Generates all partitions of n.
+--
+-- > compUniq 4 == [[1,1,1,1],[1,1,2],[1,3],[2,2],[4]]
+-- > compUniq 5 == [[1,1,1,1,1],[1,1,1,2],[1,1,3],[2,1,2],[1,4],[2,3],[5]]
+part :: (Num a, Ord a, Enum a) => a -> [[a]]
+part n = concatMap (\k -> partm k n) (reverse [1 .. n])
+
+-- | Generates all partitions of n with parts in the set e.
+--
+-- > parta 8 [2,3] == [[2,2,2,2],[3,2,3]]
+parta :: (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
+parta n e = filter (all (`elem` e)) (part n)
+
+-- | Generate all compositions of n.
+--
+-- > comp 4 == [[1,1,1,1],[1,1,2],[1,2,1],[2,1,1],[1,3],[3,1],[2,2],[4]]
+-- > length (comp 8) == 128
+comp :: (Num a, Ord a, Enum a) => a -> [[a]]
+comp = concatMap multiset_permutations . part
+
+-- | Generates all compositions of n into k parts.
+--
+-- > compm 3 6 == [[1,1,4],[1,4,1],[4,1,1],[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1],[2,2,2]]
+-- > length (compm 5 16) == 1365
+compm :: (Ord a, Num a) => a -> a -> [[a]]
+compm k = concatMap multiset_permutations . partm k
+
+-- | Generates all compositions of n with parts in the set (p1 p2 ... pk).
+--
+-- > compa 8 [3,4,5,6] == [[3,5],[5,3],[4,4]]
+compa :: (Num a, Ord a, Enum a) => a -> [a] -> [[a]]
+compa n e = filter (all (`elem` e)) (comp n)
+
+-- | Generates all compositions of n with m parts in the set (p1 p2 ... pk).
+--
+-- > compam 4 16 [3,4,5]
+compam :: (Num a, Ord a, Enum a) => a -> a -> [a] -> [[a]]
+compam k n e = filter (all (`elem` e)) (compm k n)
+
+-- | Generates all binary necklaces of length n.  <http://combos.org/necklace>
+--
+-- > neck 5 == [[1,1,1,1,1],[1,1,1,1,0],[1,1,0,1,0],[1,1,1,0,0],[1,0,1,0,0],[1,1,0,0,0],[1,0,0,0,0],[0,0,0,0,0]]
+neck :: (Ord t, Num t) => Int -> [[t]]
+neck n = concatMap multiset_cycles [replicate i 0 ++ replicate (n - i) 1 | i <- [0 .. n]]
+
+-- | Generates all binary necklaces of length n with m ones.
+--
+-- > neckm 8 2 == [[1,0,0,0,1,0,0,0],[1,0,0,1,0,0,0,0],[1,0,1,0,0,0,0,0],[1,1,0,0,0,0,0,0]]
+neckm :: (Num a, Ord a) => Int -> Int -> [[a]]
+neckm n m = filter ((== m) . length . filter (== 1)) (neck n)
+
+-- | Part is the length of a substring 10...0 composing the necklace.
+--   For example the necklace 10100 has parts of size 2 and 3.
+--
+-- > necklaceParts [1,0,1,0,0] == [2,3]
+-- > necklaceParts [0,0,0,0,0,0,0,0] == []
+necklaceParts :: (Eq a, Num a) => [a] -> [Int]
+necklaceParts l = d_dx (findIndices (== 1) l ++ [length l])
+
+necklaceWithParts :: (Eq a, Num a) => [Int] -> [a] -> Bool
+necklaceWithParts e l =
+  let p = necklaceParts l
+  in not (null p) && all (`elem` e) p
+
+-- | Generates all binary necklaces of length n with parts in e.
+--
+-- > necka 8 [2,3,4] == [[1,0,1,0,1,0,1,0],[1,0,1,0,0,1,0,0],[1,0,1,0,1,0,0,0],[1,0,0,0,1,0,0,0]]
+necka :: (Num a, Ord a) => Int -> [Int] -> [[a]]
+necka n e = filter (necklaceWithParts e) (neck n)
+
+-- | Generates all binary necklaces of length n with m ones and parts in e.
+neckam :: (Num a, Ord a) => Int -> Int -> [Int] -> [[a]]
+neckam n m e = filter (necklaceWithParts e) (neckm n m)
+
+-- | Generates all permutations of the non-negative integers in the set.
+--
+-- > permi [1,2,3] == [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
+permi :: [a] -> [[a]]
+permi = permutations_l
diff --git a/Music/Theory/Duration/Name.hs b/Music/Theory/Duration/Name.hs
--- a/Music/Theory/Duration/Name.hs
+++ b/Music/Theory/Duration/Name.hs
@@ -1,7 +1,7 @@
 -- | Names for common music notation durations.
 module Music.Theory.Duration.Name where
 
-import Music.Theory.Duration
+import Music.Theory.Duration {- hmt -}
 
 -- * Constants
 
diff --git a/Music/Theory/Duration/Name/Abbreviation.hs b/Music/Theory/Duration/Name/Abbreviation.hs
--- a/Music/Theory/Duration/Name/Abbreviation.hs
+++ b/Music/Theory/Duration/Name/Abbreviation.hs
@@ -1,4 +1,4 @@
--- | Abbreviated names for 'Duration' values when written as literals.
+-- | Abbreviated names for 'Duration' values when written as Haskell literals.
 -- There are /letter/ names where 'w' is 'whole_note' and so on, and
 -- /numerical/ names where '_4' is 'quarter_note' and so on.  In both
 -- cases a @'@ extension means a @dot@ so that 'e''' is a double
diff --git a/Music/Theory/Duration/RQ.hs b/Music/Theory/Duration/RQ.hs
deleted file mode 100644
--- a/Music/Theory/Duration/RQ.hs
+++ /dev/null
@@ -1,173 +0,0 @@
--- | Rational quarter-note notation for durations.
-module Music.Theory.Duration.RQ where
-
-import Data.Function {- base -}
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Data.Ratio {- base -}
-
-import Music.Theory.Duration {- hmt -}
-
--- | Rational Quarter-Note
-type RQ = Rational
-
--- > rq_duration_tbl 2
-rq_duration_tbl :: Integer -> [(Rational,Duration)]
-rq_duration_tbl k = map (\d -> (duration_to_rq d,d)) (duration_set k)
-
--- | Rational quarter note to duration value.  It is a mistake to hope
--- this could handle tuplets directly since, for instance, a @3:2@
--- dotted note will be of the same duration as a plain undotted note.
---
--- > rq_to_duration (3/4) == Just dotted_eighth_note
-rq_to_duration :: RQ -> Maybe Duration
-rq_to_duration x = lookup x (rq_duration_tbl 2)
-
--- | Is 'RQ' a /cmn/ duration.
---
--- > map rq_is_cmn [1/4,1/5,1/8,3/32] == [True,False,True,False]
-rq_is_cmn :: RQ -> Bool
-rq_is_cmn = isJust . rq_to_duration
-
--- | Variant of 'rq_to_duration' with error message.
-rq_to_duration_err :: Show a => a -> RQ -> Duration
-rq_to_duration_err msg n =
-    let err = error ("rq_to_duration:" ++ show (msg,n))
-    in fromMaybe err (rq_to_duration n)
-
--- | Convert a whole note division integer to an 'RQ' value.
---
--- > map whole_note_division_to_rq [1,2,4,8] == [4,2,1,1/2]
-whole_note_division_to_rq :: Integer -> RQ
-whole_note_division_to_rq x =
-    let f = (* 4) . recip . (%1)
-    in case x of
-         0 -> 8
-         -1 -> 16
-         _ -> f x
-
--- | Apply dots to an 'RQ' duration.
---
--- > map (rq_apply_dots 1) [1,2] == [3/2,7/4]
-rq_apply_dots :: RQ -> Integer -> RQ
-rq_apply_dots n d =
-    let m = iterate (/ 2) n
-    in sum (genericTake (d + 1) m)
-
--- | Convert 'Duration' to 'RQ' value, see 'rq_to_duration' for
--- partial inverse.
---
--- > let d = [half_note,dotted_quarter_note,dotted_whole_note]
--- > in map duration_to_rq d == [2,3/2,6]
-duration_to_rq :: Duration -> RQ
-duration_to_rq (Duration n d m) =
-    let x = whole_note_division_to_rq n
-    in rq_apply_dots x d * m
-
--- | 'compare' function for 'Duration' via 'duration_to_rq'.
---
--- > half_note `duration_compare_rq` quarter_note == GT
-duration_compare_rq :: Duration -> Duration -> Ordering
-duration_compare_rq = compare `on` duration_to_rq
-
--- | 'RQ' modulo.
---
--- > map (rq_mod (5/2)) [3/2,3/4,5/2] == [1,1/4,0]
-rq_mod :: RQ -> RQ -> RQ
-rq_mod i j
-    | i == j = 0
-    | i < 0 = rq_mod (i + j) j
-    | i > j = rq_mod (i - j) j
-    | otherwise = i
-
--- | Is /p/ divisible by /q/, ie. is the 'denominator' of @p/q@ '==' @1@.
---
--- > map (rq_divisible_by (3%2)) [1%2,1%3] == [True,False]
-rq_divisible_by :: RQ -> RQ -> Bool
-rq_divisible_by i j = denominator (i / j) == 1
-
--- | Is 'RQ' a whole number (ie. is 'denominator' '==' @1@.
---
--- > map rq_is_integral [1,3/2,2] == [True,False,True]
-rq_is_integral :: RQ -> Bool
-rq_is_integral = (== 1) . denominator
-
--- | Return 'numerator' of 'RQ' if 'denominator' '==' @1@.
---
--- > map rq_integral [1,3/2,2] == [Just 1,Nothing,Just 2]
-rq_integral :: RQ -> Maybe Integer
-rq_integral n = if rq_is_integral n then Just (numerator n) else Nothing
-
--- | Derive the tuplet structure of a set of 'RQ' values.
---
--- > rq_derive_tuplet_plain [1/2] == Nothing
--- > rq_derive_tuplet_plain [1/2,1/2] == Nothing
--- > rq_derive_tuplet_plain [1/4,1/4] == Nothing
--- > rq_derive_tuplet_plain [1/3,2/3] == Just (3,2)
--- > rq_derive_tuplet_plain [1/2,1/3,1/6] == Just (6,4)
--- > rq_derive_tuplet_plain [1/3,1/6] == Just (6,4)
--- > rq_derive_tuplet_plain [2/5,3/5] == Just (5,4)
--- > rq_derive_tuplet_plain [1/3,1/6,2/5,1/10] == Just (30,16)
---
--- > map rq_derive_tuplet_plain [[1/3,1/6],[2/5,1/10]] == [Just (6,4)
--- >                                                      ,Just (10,8)]
-rq_derive_tuplet_plain :: [RQ] -> Maybe (Integer,Integer)
-rq_derive_tuplet_plain x =
-    let i = foldl lcm 1 (map denominator x)
-        j = let z = iterate (* 2) 2
-            in fromJust (find (>= i) z) `div` 2
-    in if i `rem` j == 0 then Nothing else Just (i,j)
-
--- | Derive the tuplet structure of a set of 'RQ' values.
---
--- > rq_derive_tuplet [1/4,1/8,1/8] == Nothing
--- > rq_derive_tuplet [1/3,2/3] == Just (3,2)
--- > rq_derive_tuplet [1/2,1/3,1/6] == Just (3,2)
--- > rq_derive_tuplet [2/5,3/5] == Just (5,4)
--- > rq_derive_tuplet [1/3,1/6,2/5,1/10] == Just (15,8)
-rq_derive_tuplet :: [RQ] -> Maybe (Integer,Integer)
-rq_derive_tuplet =
-    let f (i,j) = let k = i % j
-                  in (numerator k,denominator k)
-    in fmap f . rq_derive_tuplet_plain
-
--- | Remove tuplet multiplier from value, ie. to give notated
--- duration.  This seems odd but is neccessary to avoid ambiguity.
--- Ie. is @1@ a quarter note or a @3:2@ tuplet dotted-quarter-note etc.
---
--- > map (rq_un_tuplet (3,2)) [1,2/3,1/2,1/3] == [3/2,1,3/4,1/2]
-rq_un_tuplet :: (Integer,Integer) -> RQ -> RQ
-rq_un_tuplet (i,j) x = x * (i % j)
-
--- | If an 'RQ' duration is un-representable by a single /cmn/
--- duration, give tied notation.
---
--- > catMaybes (map rq_to_cmn [1..9]) == [(4,1),(4,3),(8,1)]
---
--- > map rq_to_cmn [5/4,5/8] == [Just (1,1/4),Just (1/2,1/8)]
-rq_to_cmn :: RQ -> Maybe (RQ,RQ)
-rq_to_cmn x =
-    let (i,j) = (numerator x,denominator x)
-        k = case i of
-              5 -> Just (4,1)
-              7 -> Just (4,3)
-              9 -> Just (8,1)
-              _ -> Nothing
-        f (n,m) = (n%j,m%j)
-    in fmap f k
-
--- | Predicate to determine if a segment can be notated either without
--- a tuplet or with a single tuplet.
---
--- > rq_can_notate [1/2,1/4,1/4] == True
--- > rq_can_notate [1/3,1/6] == True
--- > rq_can_notate [2/5,1/10] == True
--- > rq_can_notate [1/3,1/6,2/5,1/10] == False
--- > rq_can_notate [4/7,1/7,6/7,3/7] == True
--- > rq_can_notate [4/7,1/7,2/7] == True
-rq_can_notate :: [RQ] -> Bool
-rq_can_notate x =
-    let x' = case rq_derive_tuplet x of
-               Nothing -> x
-               Just t -> map (rq_un_tuplet t) x
-    in all rq_is_cmn x'
diff --git a/Music/Theory/Duration/RQ/Division.hs b/Music/Theory/Duration/RQ/Division.hs
deleted file mode 100644
--- a/Music/Theory/Duration/RQ/Division.hs
+++ /dev/null
@@ -1,91 +0,0 @@
--- | 'RQ' sub-divisions.
-module Music.Theory.Duration.RQ.Division where
-
-import Data.List.Split {- split -}
-import Data.Ratio
-
-import Music.Theory.Duration.RQ
-import Music.Theory.Duration.RQ.Tied
-import Music.Theory.List
-import Music.Theory.Permutations.List
-
--- | Divisions of /n/ 'RQ' into /i/ equal parts grouped as /j/.
--- A quarter and eighth note triplet is written @(1,1,[2,1],False)@.
-type RQ_Div = (Rational,Integer,[Integer],Tied_Right)
-
--- | Variant of 'RQ_Div' where /n/ is @1@.
-type RQ1_Div = (Integer,[Integer],Tied_Right)
-
--- | Lift 'RQ1_Div' to 'RQ_Div'.
-rq1_div_to_rq_div :: RQ1_Div -> RQ_Div
-rq1_div_to_rq_div (i,j,k) = (1,i,j,k)
-
--- | Verify that grouping /j/ sums to the divisor /i/.
-rq_div_verify :: RQ_Div -> Bool
-rq_div_verify (_,n,m,_) = n == sum m
-
-rq_div_mm_verify :: Int -> [RQ_Div] -> [(Integer,[RQ])]
-rq_div_mm_verify n x =
-    let q = map (sum . fst . rq_div_to_rq_set_t) x
-    in zip [1..] (chunksOf n q)
-
--- | Translate from 'RQ_Div' to a sequence of 'RQ' values.
---
--- > rq_div_to_rq_set_t (1,5,[1,3,1],True) == ([1/5,3/5,1/5],True)
--- > rq_div_to_rq_set_t (1/2,6,[3,1,2],False) == ([1/4,1/12,1/6],False)
-rq_div_to_rq_set_t :: RQ_Div -> ([RQ],Tied_Right)
-rq_div_to_rq_set_t (n,k,d,t) =
-    let q = map ((* n) . (% k)) d
-    in (q,t)
-
--- | Translate from result of 'rq_div_to_rq_set_t' to seqeunce of 'RQ_T'.
---
--- > rq_set_t_to_rqt ([1/5,3/5,1/5],True) == [(1/5,_f),(3/5,_f),(1/5,_t)]
-rq_set_t_to_rqt :: ([RQ],Tied_Right) -> [RQ_T]
-rq_set_t_to_rqt (x,t) = at_last (\i -> (i,False)) (\i -> (i,t)) x
-
--- | Transform sequence of 'RQ_Div' into sequence of 'RQ', discarding
--- any final tie.
---
--- > let q = [(1,5,[1,3,1],True),(1/2,6,[3,1,2],True)]
--- > in rq_div_seq_rq q == [1/5,3/5,9/20,1/12,1/6]
-rq_div_seq_rq :: [RQ_Div] -> [RQ]
-rq_div_seq_rq =
-    let f i qq = case qq of
-                  [] -> maybe [] return i
-                  q:qq' -> let (r,t) = rq_div_to_rq_set_t q
-                               r' = maybe r (\j -> at_head (+ j) id r) i
-                           in if t
-                              then let (r'',i') = separate_last r'
-                                   in r'' ++ f (Just i') qq'
-                              else r' ++ f Nothing qq'
-    in f Nothing
-
--- | Partitions of an 'Integral' that sum to /n/.  This includes the
--- two 'trivial paritions, into a set /n/ @1@, and a set of @1@ /n/.
---
--- > partitions_sum 4 == [[1,1,1,1],[2,1,1],[2,2],[3,1],[4]]
---
--- > map (length . partitions_sum) [9..15] == [30,42,56,77,101,135,176]
-partitions_sum :: Integral i => i -> [[i]]
-partitions_sum n =
-    let f p = if null p then 0 else head p
-    in case n of
-         0 -> [[]]
-         _ -> [x:y | x <- [1..n], y <- partitions_sum (n - x), x >= f y]
-
--- | The 'multiset_permutations' of 'partitions_sum'.
---
--- > map (length . partitions_sum_p) [9..12] == [256,512,1024,2048]
-partitions_sum_p :: Integral i => i -> [[i]]
-partitions_sum_p = concatMap multiset_permutations . partitions_sum
-
--- | The set of all 'RQ1_Div' that sum to /n/, a variant on
--- 'partitions_sum_p'.
---
--- > map (length . rq1_div_univ) [3..5] == [8,16,32]
--- > map (length . rq1_div_univ) [9..12] == [512,1024,2048,4096]
-rq1_div_univ :: Integer -> [RQ1_Div]
-rq1_div_univ n =
-    let f l = [(n,l,k) | k <- [False,True]]
-    in concatMap f (partitions_sum_p n)
diff --git a/Music/Theory/Duration/RQ/Tied.hs b/Music/Theory/Duration/RQ/Tied.hs
deleted file mode 100644
--- a/Music/Theory/Duration/RQ/Tied.hs
+++ /dev/null
@@ -1,91 +0,0 @@
--- | 'RQ' values with /tie right/ qualifier.
-module Music.Theory.Duration.RQ.Tied where
-
-import Data.Maybe
-import Music.Theory.Duration.Annotation
-import Music.Theory.Duration.RQ
-import Music.Theory.List
-
--- | Boolean.
-type Tied_Right = Bool
-
--- | 'RQ' with /tie right/.
-type RQ_T = (RQ,Tied_Right)
-
--- | Construct 'RQ_T'.
-rqt :: Tied_Right -> RQ -> RQ_T
-rqt t d = (d,t)
-
--- | 'RQ' field of 'RQ_T'.
-rqt_rq :: RQ_T -> RQ
-rqt_rq = fst
-
--- | 'Tied' field of 'RQ_T'.
-rqt_tied :: RQ_T -> Tied_Right
-rqt_tied = snd
-
--- | Is 'RQ_T' tied right.
-is_tied_right :: RQ_T -> Bool
-is_tied_right = snd
-
--- | 'RQ_T' variant of 'rq_un_tuplet'.
---
--- > rqt_un_tuplet (3,2) (1,T) == (3/2,T)
---
--- > let f = rqt_un_tuplet (7,4)
--- > in map f [(2/7,F),(4/7,T),(1/7,F)] == [(1/2,F),(1,T),(1/4,F)]
-rqt_un_tuplet :: (Integer,Integer) -> RQ_T -> RQ_T
-rqt_un_tuplet i (d,t) = (rq_un_tuplet i d,t)
-
--- | Transform 'RQ' to untied 'RQ_T'.
---
--- > rq_rqt 3 == (3,F)
-rq_rqt :: RQ -> RQ_T
-rq_rqt n = (n,False)
-
--- | Tie last element only of list of 'RQ'.
---
--- > rq_tie_last [1,2,3] == [(1,F),(2,F),(3,T)]
-rq_tie_last :: [RQ] -> [RQ_T]
-rq_tie_last = at_last rq_rqt (\d -> (d,True))
-
--- | Transform a list of 'RQ_T' to a list of 'Duration_A'.  The flag
--- indicates if the initial value is tied left.
---
--- > rqt_to_duration_a False [(1,T),(1/4,T),(3/4,F)]
-rqt_to_duration_a :: Bool -> [RQ_T] -> [Duration_A]
-rqt_to_duration_a z x =
-    let rt = map is_tied_right x
-        lt = z : rt
-        f p e = if p then Just e else Nothing
-        g r l = catMaybes [f r Tie_Right,f l Tie_Left]
-        h = rq_to_duration_err (show ("rqt_to_duration_a",z,x)) . rqt_rq
-    in zip (map h x) (zipWith g rt lt)
-
--- | 'RQ_T' variant of 'rq_can_notate'.
-rqt_can_notate :: [RQ_T] -> Bool
-rqt_can_notate = rq_can_notate . map rqt_rq
-
--- | 'RQ_T' variant of 'rq_to_cmn'.
---
--- > rqt_to_cmn (5,T) == Just ((4,T),(1,T))
--- > rqt_to_cmn (5/4,T) == Just ((1,T),(1/4,T))
--- > rqt_to_cmn (5/7,F) == Just ((4/7,T),(1/7,F))
-rqt_to_cmn :: RQ_T -> Maybe (RQ_T,RQ_T)
-rqt_to_cmn (k,t) =
-    let f (i,j) = ((i,True),(j,t))
-    in fmap f (rq_to_cmn k)
-
--- | List variant of 'rqt_to_cmn'.
---
--- > rqt_to_cmn_l (5,T) == [(4,T),(1,T)]
-rqt_to_cmn_l :: RQ_T -> [RQ_T]
-rqt_to_cmn_l x = maybe [x] (\(i,j) -> [i,j]) (rqt_to_cmn x)
-
--- | 'concatMap' 'rqt_to_cmn_l'.
---
--- > rqt_set_to_cmn [(1,T),(5/4,F)] == [(1,T),(1,T),(1/4,F)]
---
--- > rqt_set_to_cmn [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
-rqt_set_to_cmn :: [RQ_T] -> [RQ_T]
-rqt_set_to_cmn = concatMap rqt_to_cmn_l
diff --git a/Music/Theory/Duration/Rq.hs b/Music/Theory/Duration/Rq.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Duration/Rq.hs
@@ -0,0 +1,239 @@
+-- | Rational quarter-note notation for durations.
+module Music.Theory.Duration.Rq where
+
+import Data.Function {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ratio {- base -}
+
+import qualified Music.Theory.List as T {- hmt-base -}
+
+import Music.Theory.Duration {- hmt -}
+
+-- | Rational Quarter-Note
+type Rq = Rational
+
+{- | Table mapping tuple Rq values to Durations.
+     Only has cases where the duration can be expressed without a tie.
+     Currently has entries for 3-,5-,6- and 7-tuplets.
+
+> all (\(i,j) -> i == duration_to_rq j) rq_tuplet_duration_table == True
+-}
+rq_tuplet_duration_table :: [(Rq, Duration)]
+rq_tuplet_duration_table =
+  [(1/3,Duration 8 0 (2/3))
+  ,(2/3,Duration 4 0 (2/3))
+  ,(1/5,Duration 16 0 (4/5))
+  ,(2/5,Duration 8 0 (4/5))
+  ,(3/5,Duration 8 1 (4/5))
+  ,(4/5,Duration 4 0 (4/5))
+  ,(1/6,Duration 16 0 (2/3))
+  ,(1/7,Duration 16 0 (4/7))
+  ,(2/7,Duration 8 0 (4/7))
+  ,(3/7,Duration 8 1 (4/7))
+  ,(4/7,Duration 4 0 (4/7))
+  ,(6/7,Duration 4 1 (4/7))
+  ]
+
+{- | Lookup rq_tuplet_duration_tbl.
+
+> rq_tuplet_to_duration (1/3) == Just (Duration 8 0 (2/3))
+-}
+rq_tuplet_to_duration :: Rq -> Maybe Duration
+rq_tuplet_to_duration x = lookup x rq_tuplet_duration_table
+
+{- | Make table of (Rq,Duration) associations.
+     Only lists durations with a multiplier of 1.
+
+> map (length . rq_plain_duration_tbl) [1,2,3] == [20,30,40]
+> map (multiplier . snd) (rq_plain_duration_tbl 1) == replicate 20 1
+-}
+rq_plain_duration_tbl :: Dots -> [(Rq,Duration)]
+rq_plain_duration_tbl k = map (\d -> (duration_to_rq d,d)) (duration_set k)
+
+rq_plain_to_duration :: Dots -> Rq -> Maybe Duration
+rq_plain_to_duration k x = lookup x (rq_plain_duration_tbl k)
+
+rq_plain_to_duration_err :: Dots -> Rq -> Duration
+rq_plain_to_duration_err k x = T.lookup_err x (rq_plain_duration_tbl k)
+
+{- | Rational quarter note to duration value.
+     Lookup composite plain (hence dots) and tuplet tables.
+     It is a mistake to hope this could handle tuplets directly in a general sense.
+     For instance, a @3:2@ dotted note is the same duration as a plain undotted note.
+     However it does give durations for simple notations of simple tuplet values.
+
+> rq_to_duration 2 (3/4) == Just (Duration 8 1 1) -- dotted_eighth_note
+> rq_to_duration 2 (1/3) == Just (Duration 8 0 (2/3))
+-}
+rq_to_duration :: Dots -> Rq -> Maybe Duration
+rq_to_duration k x = lookup x (rq_tuplet_duration_table ++ rq_plain_duration_tbl k)
+
+-- | Variant of 'rq_to_duration' with error message.
+rq_to_duration_err :: Show a => a -> Dots -> Rq -> Duration
+rq_to_duration_err msg k n =
+    let err = error ("rq_to_duration:" ++ show (msg,n))
+    in fromMaybe err (rq_to_duration k n)
+
+-- | Is 'Rq' a /cmn/ duration (ie. rq_plain_to_duration)
+--
+-- > map (rq_is_cmn 2) [1/4,1/5,1/8,3/32] == [True,False,True,True]
+rq_is_cmn :: Dots -> Rq -> Bool
+rq_is_cmn k = isJust . rq_plain_to_duration k
+
+-- | Convert a whole note division integer to an 'Rq' value.
+--
+-- > map whole_note_division_to_rq [1,2,4,8] == [4,2,1,1/2]
+whole_note_division_to_rq :: Division -> Rq
+whole_note_division_to_rq x =
+    let f = (* 4) . recip . (% 1)
+    in case x of
+         0 -> 8
+         -1 -> 16
+         _ -> f x
+
+-- | Apply dots to an 'Rq' duration.
+--
+-- > map (rq_apply_dots 1) [1,2] == [1 + 1/2,1 + 1/2 + 1/4]
+rq_apply_dots :: Rq -> Dots -> Rq
+rq_apply_dots n d =
+    let m = iterate (/ 2) n
+    in sum (genericTake (d + 1) m)
+
+-- | Convert 'Duration' to 'Rq' value, see 'rq_to_duration' for partial inverse.
+--
+-- > let d = [Duration 2 0 1,Duration 4 1 1,Duration 1 1 1]
+-- > map duration_to_rq d == [2,3/2,6] -- half_note,dotted_quarter_note,dotted_whole_note
+duration_to_rq :: Duration -> Rq
+duration_to_rq (Duration n d m) =
+    let x = whole_note_division_to_rq n
+    in rq_apply_dots x d * m
+
+-- | 'compare' function for 'Duration' via 'duration_to_rq'.
+--
+-- > half_note `duration_compare_rq` quarter_note == GT
+duration_compare_rq :: Duration -> Duration -> Ordering
+duration_compare_rq = compare `on` duration_to_rq
+
+-- | 'Rq' modulo.
+--
+-- > map (rq_mod (5/2)) [3/2,3/4,5/2] == [1,1/4,0]
+rq_mod :: Rq -> Rq -> Rq
+rq_mod i j
+    | i == j = 0
+    | i < 0 = rq_mod (i + j) j
+    | i > j = rq_mod (i - j) j
+    | otherwise = i
+
+-- | Is /p/ divisible by /q/, ie. is the 'denominator' of @p/q@ '==' @1@.
+--
+-- > map (rq_divisible_by (3%2)) [1%2,1%3] == [True,False]
+rq_divisible_by :: Rq -> Rq -> Bool
+rq_divisible_by i j = denominator (i / j) == 1
+
+-- | Is 'Rq' a whole number (ie. is 'denominator' '==' @1@.
+--
+-- > map rq_is_integral [1,3/2,2] == [True,False,True]
+rq_is_integral :: Rq -> Bool
+rq_is_integral = (== 1) . denominator
+
+-- | Return 'numerator' of 'Rq' if 'denominator' '==' @1@.
+--
+-- > map rq_integral [1,3/2,2] == [Just 1,Nothing,Just 2]
+rq_integral :: Rq -> Maybe Integer
+rq_integral n = if rq_is_integral n then Just (numerator n) else Nothing
+
+-- | Derive the tuplet structure of a set of 'Rq' values.
+--
+-- > rq_derive_tuplet_plain [1/2] == Nothing
+-- > rq_derive_tuplet_plain [1/2,1/2] == Nothing
+-- > rq_derive_tuplet_plain [1/4,1/4] == Nothing
+-- > rq_derive_tuplet_plain [1/3,2/3] == Just (3,2)
+-- > rq_derive_tuplet_plain [1/2,1/3,1/6] == Just (6,4)
+-- > rq_derive_tuplet_plain [1/3,1/6] == Just (6,4)
+-- > rq_derive_tuplet_plain [2/5,3/5] == Just (5,4)
+-- > rq_derive_tuplet_plain [1/3,1/6,2/5,1/10] == Just (30,16)
+--
+-- > map rq_derive_tuplet_plain [[1/3,1/6],[2/5,1/10]] == [Just (6,4)
+-- >                                                      ,Just (10,8)]
+rq_derive_tuplet_plain :: [Rq] -> Maybe (Integer,Integer)
+rq_derive_tuplet_plain x =
+    let i = foldl lcm 1 (map denominator x)
+        j = let z = iterate (* 2) 2
+            in fromJust (find (>= i) z) `div` 2
+    in if i `rem` j == 0 then Nothing else Just (i,j)
+
+-- | Derive the tuplet structure of a set of 'Rq' values.
+--
+-- > rq_derive_tuplet [1/4,1/8,1/8] == Nothing
+-- > rq_derive_tuplet [1/3,2/3] == Just (3,2)
+-- > rq_derive_tuplet [1/2,1/3,1/6] == Just (3,2)
+-- > rq_derive_tuplet [2/5,3/5] == Just (5,4)
+-- > rq_derive_tuplet [1/3,1/6,2/5,1/10] == Just (15,8)
+rq_derive_tuplet :: [Rq] -> Maybe (Integer,Integer)
+rq_derive_tuplet =
+    let f (i,j) = let k = i % j
+                  in (numerator k,denominator k)
+    in fmap f . rq_derive_tuplet_plain
+
+-- | Remove tuplet multiplier from value, ie. to give notated
+-- duration.  This seems odd but is neccessary to avoid ambiguity.
+-- Ie. is @1@ a quarter note or a @3:2@ tuplet dotted-quarter-note etc.
+--
+-- > map (rq_un_tuplet (3,2)) [1,2/3,1/2,1/3] == [3/2,1,3/4,1/2]
+rq_un_tuplet :: (Integer,Integer) -> Rq -> Rq
+rq_un_tuplet (i,j) x = x * (i % j)
+
+-- | If an 'Rq' duration is un-representable by a single /cmn/
+-- duration, give tied notation.
+--
+-- > catMaybes (map rq_to_cmn [1..9]) == [(4,1),(4,3),(8,1)]
+--
+-- > map rq_to_cmn [5/4,5/8] == [Just (1,1/4),Just (1/2,1/8)]
+rq_to_cmn :: Rq -> Maybe (Rq,Rq)
+rq_to_cmn x =
+    let (i,j) = (numerator x,denominator x)
+        k = case i of
+              5 -> Just (4,1)
+              7 -> Just (4,3)
+              9 -> Just (8,1)
+              _ -> Nothing
+        f (n,m) = (n%j,m%j)
+    in fmap f k
+
+{- | Predicate to determine if a segment can be notated
+     either without a tuplet or with a single tuplet.
+
+> rq_can_notate 2 [1/2,1/4,1/4] == True
+> rq_can_notate 2 [1/3,1/6] == True
+> rq_can_notate 2 [2/5,1/10] == True
+> rq_can_notate 2 [1/3,1/6,2/5,1/10] == False
+> rq_can_notate 2 [4/7,1/7,6/7,3/7] == True
+> rq_can_notate 2 [4/7,1/7,2/7] == True
+-}
+rq_can_notate :: Dots -> [Rq] -> Bool
+rq_can_notate k x =
+    let x' = case rq_derive_tuplet x of
+               Nothing -> x
+               Just t -> map (rq_un_tuplet t) x
+    in all (rq_is_cmn k) x'
+
+-- * Time
+
+-- | Duration in seconds of Rq given qpm
+--
+--   qpm = pulses-per-minute, rq = rational-quarter-note
+--
+-- > map (\sd -> rq_to_seconds_qpm (90 * sd) 1) [1,2,4,8,16] == [2/3,1/3,1/6,1/12,1/24]
+-- > map (rq_to_seconds_qpm 90) [1,2,3,4] == [2/3,1 + 1/3,2,2 + 2/3]
+-- > map (rq_to_seconds_qpm 90) [0::Rq,1,1 + 1/2,1 + 3/4,1 + 7/8,2] == [0,2/3,1,7/6,5/4,4/3]
+rq_to_seconds_qpm :: Fractional a => a -> a -> a
+rq_to_seconds_qpm qpm rq = rq * (60 / qpm)
+
+-- | Qpm given that /rq/ has duration /x/, ie. inverse of 'rq_to_seconds_qpm'
+--
+-- > map (rq_to_qpm 1) [0.4,0.5,0.8,1,1.5,2] == [150,120,75,60,40,30]
+-- > map (\qpm -> rq_to_seconds_qpm qpm 1) [150,120,75,60,40,30] == [0.4,0.5,0.8,1,1.5,2]
+rq_to_qpm :: Fractional a => a -> a -> a
+rq_to_qpm rq x = (rq / x) * 60
+
diff --git a/Music/Theory/Duration/Rq/Division.hs b/Music/Theory/Duration/Rq/Division.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Duration/Rq/Division.hs
@@ -0,0 +1,91 @@
+-- | 'Rq' sub-divisions.
+module Music.Theory.Duration.Rq.Division where
+
+import Data.List.Split {- split -}
+import Data.Ratio
+
+import Music.Theory.Duration.Rq
+import Music.Theory.Duration.Rq.Tied
+import Music.Theory.List
+import Music.Theory.Permutations.List
+
+-- | Divisions of /n/ 'Rq' into /i/ equal parts grouped as /j/.
+-- A quarter and eighth note triplet is written @(1,1,[2,1],False)@.
+type Rq_Div = (Rational,Integer,[Integer],Tied_Right)
+
+-- | Variant of 'Rq_Div' where /n/ is @1@.
+type Rq1_Div = (Integer,[Integer],Tied_Right)
+
+-- | Lift 'Rq1_Div' to 'Rq_Div'.
+rq1_div_to_rq_div :: Rq1_Div -> Rq_Div
+rq1_div_to_rq_div (i,j,k) = (1,i,j,k)
+
+-- | Verify that grouping /j/ sums to the divisor /i/.
+rq_div_verify :: Rq_Div -> Bool
+rq_div_verify (_,n,m,_) = n == sum m
+
+rq_div_mm_verify :: Int -> [Rq_Div] -> [(Integer,[Rq])]
+rq_div_mm_verify n x =
+    let q = map (sum . fst . rq_div_to_rq_set_t) x
+    in zip [1..] (chunksOf n q)
+
+-- | Translate from 'Rq_Div' to a sequence of 'Rq' values.
+--
+-- > rq_div_to_rq_set_t (1,5,[1,3,1],True) == ([1/5,3/5,1/5],True)
+-- > rq_div_to_rq_set_t (1/2,6,[3,1,2],False) == ([1/4,1/12,1/6],False)
+rq_div_to_rq_set_t :: Rq_Div -> ([Rq],Tied_Right)
+rq_div_to_rq_set_t (n,k,d,t) =
+    let q = map ((* n) . (% k)) d
+    in (q,t)
+
+-- | Translate from result of 'rq_div_to_rq_set_t' to seqeunce of 'Rq_Tied'.
+--
+-- > rq_set_t_to_rqt ([1/5,3/5,1/5],True) == [(1/5,_f),(3/5,_f),(1/5,_t)]
+rq_set_t_to_rqt :: ([Rq],Tied_Right) -> [Rq_Tied]
+rq_set_t_to_rqt (x,t) = at_last (\i -> (i,False)) (\i -> (i,t)) x
+
+-- | Transform sequence of 'Rq_Div' into sequence of 'Rq', discarding
+-- any final tie.
+--
+-- > let q = [(1,5,[1,3,1],True),(1/2,6,[3,1,2],True)]
+-- > in rq_div_seq_rq q == [1/5,3/5,9/20,1/12,1/6]
+rq_div_seq_rq :: [Rq_Div] -> [Rq]
+rq_div_seq_rq =
+    let f i qq = case qq of
+                  [] -> maybe [] return i
+                  q:qq' -> let (r,t) = rq_div_to_rq_set_t q
+                               r' = maybe r (\j -> at_head (+ j) id r) i
+                           in if t
+                              then let (r'',i') = separate_last r'
+                                   in r'' ++ f (Just i') qq'
+                              else r' ++ f Nothing qq'
+    in f Nothing
+
+-- | Partitions of an 'Integral' that sum to /n/.  This includes the
+-- two 'trivial paritions, into a set /n/ @1@, and a set of @1@ /n/.
+--
+-- > partitions_sum 4 == [[1,1,1,1],[2,1,1],[2,2],[3,1],[4]]
+--
+-- > map (length . partitions_sum) [9..15] == [30,42,56,77,101,135,176]
+partitions_sum :: Integral i => i -> [[i]]
+partitions_sum n =
+    let f p = if null p then 0 else head p
+    in case n of
+         0 -> [[]]
+         _ -> [x:y | x <- [1..n], y <- partitions_sum (n - x), x >= f y]
+
+-- | The 'multiset_permutations' of 'partitions_sum'.
+--
+-- > map (length . partitions_sum_p) [9..12] == [256,512,1024,2048]
+partitions_sum_p :: Integral i => i -> [[i]]
+partitions_sum_p = concatMap multiset_permutations . partitions_sum
+
+-- | The set of all 'Rq1_Div' that sum to /n/, a variant on
+-- 'partitions_sum_p'.
+--
+-- > map (length . rq1_div_univ) [3..5] == [8,16,32]
+-- > map (length . rq1_div_univ) [9..12] == [512,1024,2048,4096]
+rq1_div_univ :: Integer -> [Rq1_Div]
+rq1_div_univ n =
+    let f l = [(n,l,k) | k <- [False,True]]
+    in concatMap f (partitions_sum_p n)
diff --git a/Music/Theory/Duration/Rq/Tied.hs b/Music/Theory/Duration/Rq/Tied.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Duration/Rq/Tied.hs
@@ -0,0 +1,101 @@
+-- | 'Rq' values with /tie right/ qualifier.
+module Music.Theory.Duration.Rq.Tied where
+
+import Data.Maybe {- base -}
+
+import Music.Theory.List {- hmt-base -}
+
+import Music.Theory.Duration {- hmt -}
+import qualified Music.Theory.Duration.Annotation as Annotation {- hmt -}
+import Music.Theory.Duration.Rq {- hmt -}
+
+-- | Boolean.
+type Tied_Right = Bool
+
+-- | 'Rq' with /tie right/.
+type Rq_Tied = (Rq,Tied_Right)
+
+-- | If Rq_Tied is not tied, get Rq.
+rqt_to_rq :: Rq_Tied -> Maybe Rq
+rqt_to_rq (rq,x) = if x then Nothing else Just rq
+
+-- | Erroring variant of rqt_to_rq.
+rqt_to_rq_err :: Rq_Tied -> Rq
+rqt_to_rq_err = fromMaybe (error "rqt_to_rq") . rqt_to_rq
+
+-- | Construct 'Rq_Tied'.
+rqt :: Tied_Right -> Rq -> Rq_Tied
+rqt t d = (d,t)
+
+-- | 'Rq' field of 'Rq_Tied'.
+rqt_rq :: Rq_Tied -> Rq
+rqt_rq = fst
+
+-- | 'Tied' field of 'Rq_Tied'.
+rqt_tied :: Rq_Tied -> Tied_Right
+rqt_tied = snd
+
+-- | Is 'Rq_Tied' tied right.
+is_tied_right :: Rq_Tied -> Bool
+is_tied_right = snd
+
+-- | 'Rq_Tied' variant of 'rq_un_tuplet'.
+--
+-- > rqt_un_tuplet (3,2) (1,T) == (3/2,T)
+--
+-- > let f = rqt_un_tuplet (7,4)
+-- > in map f [(2/7,F),(4/7,T),(1/7,F)] == [(1/2,F),(1,T),(1/4,F)]
+rqt_un_tuplet :: (Integer,Integer) -> Rq_Tied -> Rq_Tied
+rqt_un_tuplet i (d,t) = (rq_un_tuplet i d,t)
+
+-- | Transform 'Rq' to untied 'Rq_Tied'.
+--
+-- > rq_rqt 3 == (3,F)
+rq_rqt :: Rq -> Rq_Tied
+rq_rqt n = (n,False)
+
+-- | Tie last element only of list of 'Rq'.
+--
+-- > rq_tie_last [1,2,3] == [(1,F),(2,F),(3,T)]
+rq_tie_last :: [Rq] -> [Rq_Tied]
+rq_tie_last = at_last rq_rqt (\d -> (d,True))
+
+-- | Transform a list of 'Rq_Tied' to a list of 'Duration_A'.  The flag
+-- indicates if the initial value is tied left.
+--
+-- > rqt_to_duration_a False [(1,T),(1/4,T),(3/4,F)]
+rqt_to_duration_a :: Bool -> [Rq_Tied] -> [Annotation.Duration_A]
+rqt_to_duration_a z x =
+    let rt = map is_tied_right x
+        lt = z : rt
+        f p e = if p then Just e else Nothing
+        g r l = catMaybes [f r Annotation.Tie_Right,f l Annotation.Tie_Left]
+        h = rq_to_duration_err (show ("rqt_to_duration_a",z,x)) 2 . rqt_rq
+    in zip (map h x) (zipWith g rt lt)
+
+-- | 'Rq_Tied' variant of 'rq_can_notate'.
+rqt_can_notate :: Dots -> [Rq_Tied] -> Bool
+rqt_can_notate k = rq_can_notate k  . map rqt_rq
+
+-- | 'Rq_Tied' variant of 'rq_to_cmn'.
+--
+-- > rqt_to_cmn (5,T) == Just ((4,T),(1,T))
+-- > rqt_to_cmn (5/4,T) == Just ((1,T),(1/4,T))
+-- > rqt_to_cmn (5/7,F) == Just ((4/7,T),(1/7,F))
+rqt_to_cmn :: Rq_Tied -> Maybe (Rq_Tied,Rq_Tied)
+rqt_to_cmn (k,t) =
+    let f (i,j) = ((i,True),(j,t))
+    in fmap f (rq_to_cmn k)
+
+-- | List variant of 'rqt_to_cmn'.
+--
+-- > rqt_to_cmn_l (5,T) == [(4,T),(1,T)]
+rqt_to_cmn_l :: Rq_Tied -> [Rq_Tied]
+rqt_to_cmn_l x = maybe [x] (\(i,j) -> [i,j]) (rqt_to_cmn x)
+
+-- | 'concatMap' 'rqt_to_cmn_l'.
+--
+-- > rqt_set_to_cmn [(1,T),(5/4,F)] == [(1,T),(1,T),(1/4,F)]
+-- > rqt_set_to_cmn [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
+rqt_set_to_cmn :: [Rq_Tied] -> [Rq_Tied]
+rqt_set_to_cmn = concatMap rqt_to_cmn_l
diff --git a/Music/Theory/Duration/Sequence/Notate.hs b/Music/Theory/Duration/Sequence/Notate.hs
--- a/Music/Theory/Duration/Sequence/Notate.hs
+++ b/Music/Theory/Duration/Sequence/Notate.hs
@@ -1,7 +1,7 @@
--- | Notation of a sequence of 'RQ' values as annotated 'Duration' values.
+-- | Notation of a sequence of 'Rq' values as annotated 'Duration' values.
 --
 -- 1. Separate input sequence into measures, adding tie annotations as
--- required (see 'to_measures_ts').  Ensure all 'RQ_T' values can be
+-- required (see 'to_measures_ts').  Ensure all 'Rq_Tied' values can be
 -- notated as /common music notation/ durations.
 --
 -- 2. Separate each measure into pulses (see 'm_divisions_ts').
@@ -17,53 +17,31 @@
 -- 5. Ascribe values to notated durations, see 'ascribe'.
 module Music.Theory.Duration.Sequence.Notate where
 
-import Control.Monad {- base -}
 import Data.List {- base -}
 import Data.List.Split {- split -}
 import Data.Maybe {- base -}
 import Data.Ratio {- base -}
 
+import Music.Theory.Either {- hmt-base -}
+import Music.Theory.Function {- hmt-base -}
+import Music.Theory.List {- hmt-base -}
+
 import Music.Theory.Duration {- hmt -}
 import Music.Theory.Duration.Annotation {- hmt -}
-import Music.Theory.Function {- hmt -}
-import Music.Theory.Duration.RQ {- hmt -}
-import Music.Theory.Duration.RQ.Tied {- hmt -}
-import Music.Theory.List {- hmt -}
+import Music.Theory.Duration.Rq {- hmt -}
+import Music.Theory.Duration.Rq.Tied {- hmt -}
 import Music.Theory.Time_Signature {- hmt -}
 
 -- * Lists
 
--- | Variant of 'catMaybes'.  If all elements of the list are @Just
--- a@, then gives @Just [a]@ else gives 'Nothing'.
---
--- > all_just (map Just [1..3]) == Just [1..3]
--- > all_just [Just 1,Nothing,Just 3] == Nothing
-all_just :: [Maybe a] -> Maybe [a]
-all_just x =
-    case x of
-      [] -> Just []
-      Just i:x' -> fmap (i :) (all_just x')
-      Nothing:_ -> Nothing
+{- | Applies a /join/ function to the first two elements of the list.
+     If the /join/ function succeeds the joined element is considered for further coalescing.
 
--- | Variant of 'Data.Either.rights' that preserves first 'Left'.
---
--- > all_right (map Right [1..3]) == Right [1..3]
--- > all_right [Right 1,Left 'a',Left 'b'] == Left 'a'
-all_right :: [Either a b] -> Either a [b]
-all_right x =
-    case x of
-      [] -> Right []
-      Right i:x' -> fmap (i :) (all_right x')
-      Left i:_ -> Left i
+> coalesce (\p q -> Just (p + q)) [1..5] == [15]
 
--- | Applies a /join/ function to the first two elements of the list.
--- If the /join/ function succeeds the joined element is considered
--- for further coalescing.
---
--- > coalesce (\p q -> Just (p + q)) [1..5] == [15]
---
--- > let jn p q = if even p then Just (p + q) else Nothing
--- > in coalesce jn [1..5] == map sum [[1],[2,3],[4,5]]
+> let jn p q = if even p then Just (p + q) else Nothing
+> coalesce jn [1..5] == map sum [[1],[2,3],[4,5]]
+-}
 coalesce :: (a -> a -> Maybe a) -> [a] -> [a]
 coalesce f x =
     case x of
@@ -75,13 +53,13 @@
 
 -- | Variant of 'coalesce' with accumulation parameter.
 --
--- > coalesce_accum (\i p q -> Left (p + q)) 0 [1..5] == [(0,15)]
+-- > coalesce_accum (\_ p q -> Left (p + q)) 0 [1..5] == [(0,15)]
 --
 -- > let jn i p q = if even p then Left (p + q) else Right (p + i)
--- > in coalesce_accum jn 0 [1..7] == [(0,1),(1,5),(6,9),(15,13)]
+-- > coalesce_accum jn 0 [1..7] == [(0,1),(1,5),(6,9),(15,13)]
 --
 -- > let jn i p q = if even p then Left (p + q) else Right [p,q]
--- > in coalesce_accum jn [] [1..5] == [([],1),([1,2],5),([5,4],9)]
+-- > coalesce_accum jn [] [1..5] == [([],1),([1,2],5),([5,4],9)]
 coalesce_accum :: (b -> a -> a -> Either a b) -> b -> [a] -> [(b,a)]
 coalesce_accum f i x =
     case x of
@@ -95,7 +73,7 @@
 -- | Variant of 'coalesce_accum' that accumulates running sum.
 --
 -- > let f i p q = if i == 1 then Just (p + q) else Nothing
--- > in coalesce_sum (+) 0 f [1,1/2,1/4,1/4] == [1,1]
+-- > coalesce_sum (+) 0 f [1,1/2,1/4,1/4] == [1,1]
 coalesce_sum :: (b -> a -> b) -> b -> (b -> a -> a -> Maybe a) -> [a] -> [a]
 coalesce_sum add zero f =
     let g i p q = case f i p q of
@@ -103,12 +81,6 @@
                     Nothing -> Right (i `add` p)
     in map snd . coalesce_accum g zero
 
--- * Either
-
--- | Lower 'Either' to 'Maybe' by discarding 'Left'.
-either_to_maybe :: Either a b -> Maybe b
-either_to_maybe = either (const Nothing) Just
-
 -- * Separate
 
 -- | Take elements while the sum of the prefix is less than or equal
@@ -160,21 +132,21 @@
                      Nothing -> Nothing
       _ -> Nothing
 
--- | Split sequence such that the prefix sums to precisely /m/.  The
--- third element of the result indicates if it was required to divide
--- an element.  Note that zero elements are kept left.  If the required
--- sum is non positive, or the input list does not sum to at least the
--- required sum, gives nothing.
---
--- > split_sum 5 [2,3,1] == Just ([2,3],[1],Nothing)
--- > split_sum 5 [2,1,3] == Just ([2,1,2],[1],Just (2,1))
--- > split_sum 2 [3/2,3/2,3/2] == Just ([3/2,1/2],[1,3/2],Just (1/2,1))
--- > split_sum 6 [1..10] == Just ([1..3],[4..10],Nothing)
--- > fmap (\(a,_,c)->(a,c)) (split_sum 5 [1..]) == Just ([1,2,2],Just (2,1))
--- > split_sum 0 [1..] == Nothing
--- > split_sum 3 [1,1] == Nothing
--- > split_sum 3 [2,1,0] == Just ([2,1,0],[],Nothing)
--- > split_sum 3 [2,1,0,1] == Just ([2,1,0],[1],Nothing)
+{- | Split sequence /l/ such that the prefix sums to precisely /m/.
+     The third element of the result indicates if it was required to divide an element.
+     Note that zero elements are kept left.
+     If the required sum is non positive, or the input list does not sum to at least the required sum, gives nothing.
+
+> split_sum 5 [2,3,1] == Just ([2,3],[1],Nothing)
+> split_sum 5 [2,1,3] == Just ([2,1,2],[1],Just (2,1))
+> split_sum 2 [3/2,3/2,3/2] == Just ([3/2,1/2],[1,3/2],Just (1/2,1))
+> split_sum 6 [1..10] == Just ([1..3],[4..10],Nothing)
+> fmap (\(a,_,c)->(a,c)) (split_sum 5 [1..]) == Just ([1,2,2],Just (2,1))
+> split_sum 0 [1..] == Nothing
+> split_sum 3 [1,1] == Nothing
+> split_sum 3 [2,1,0] == Just ([2,1,0],[],Nothing)
+> split_sum 3 [2,1,0,1] == Just ([2,1,0],[1],Nothing)
+-}
 split_sum :: (Ord a, Num a) => a -> [a] -> Maybe ([a],[a],Maybe (a,a))
 split_sum m l =
     let (p,n,q) = take_sum m l
@@ -186,24 +158,20 @@
               [] -> Nothing
               z:q' -> Just (p++[n],z-n:q',Just (n,z-n))
 
--- | Alias for 'True', used locally for documentation.
-_t :: Bool
-_t = True
+{- | Variant of 'split_sum' that operates at 'Rq_Tied' sequences.
 
--- | Alias for 'False', used locally for documentation.
-_f :: Bool
-_f = False
+> t = True
+> f = False
 
--- | Variant of 'split_sum' that operates at 'RQ_T' sequences.
---
--- > let r = Just ([(3,_f),(2,_t)],[(1,_f)])
--- > in rqt_split_sum 5 [(3,_f),(2,_t),(1,_f)] == r
---
--- > let r = Just ([(3,_f),(1,_t)],[(1,_t),(1,_f)])
--- > in rqt_split_sum 4 [(3,_f),(2,_t),(1,_f)] == r
---
--- > rqt_split_sum 4 [(5/2,False)] == Nothing
-rqt_split_sum :: RQ -> [RQ_T] -> Maybe ([RQ_T],[RQ_T])
+> r = Just ([(3,f),(2,t)],[(1,f)])
+> rqt_split_sum 5 [(3,f),(2,t),(1,f)] == r
+
+> r = Just ([(3,f),(1,t)],[(1,t),(1,f)])
+> rqt_split_sum 4 [(3,f),(2,t),(1,f)] == r
+
+> rqt_split_sum 4 [(5/2,False)] == Nothing
+-}
+rqt_split_sum :: Rq -> [Rq_Tied] -> Maybe ([Rq_Tied],[Rq_Tied])
 rqt_split_sum d x =
     case split_sum d (map rqt_rq x) of
       Just (i,_,k) ->
@@ -214,57 +182,61 @@
                                   ,(q,z) : t)
       Nothing -> Nothing
 
--- | Separate 'RQ_T' values in sequences summing to 'RQ' values.  This
--- is a recursive variant of 'rqt_split_sum'.  Note that is does not
--- ensure /cmn/ notation of values.
---
--- > let d = [(2,_f),(2,_f),(2,_f)]
--- > in rqt_separate [3,3] d == Right [[(2,_f),(1,_t)]
--- >                                  ,[(1,_f),(2,_f)]]
---
--- > let d = [(5/8,_f),(1,_f),(3/8,_f)]
--- > in rqt_separate [1,1] d == Right [[(5/8,_f),(3/8,_t)]
--- >                                  ,[(5/8,_f),(3/8,_f)]]
---
--- > let d = [(4/7,_t),(1/7,_f),(1,_f),(6/7,_f),(3/7,_f)]
--- > in rqt_separate [1,1,1] d == Right [[(4/7,_t),(1/7,_f),(2/7,_t)]
--- >                                    ,[(5/7,_f),(2/7,_t)]
--- >                                    ,[(4/7,_f),(3/7,_f)]]
-rqt_separate :: [RQ] -> [RQ_T] -> Either String [[RQ_T]]
+{- | Separate 'Rq_Tied' values in sequences summing to 'Rq' values.
+    This is a recursive variant of 'rqt_split_sum'.
+    Note that is does not ensure /cmn/ notation of values.
+
+> t = True
+> f = False
+
+> d = [(2,f),(2,f),(2,f)]
+> r = [[(2,f),(1,t)],[(1,f),(2,f)]]
+> rqt_separate [3,3] d == Right r
+
+> d = [(5/8,f),(1,f),(3/8,f)]
+> r = [[(5/8,f),(3/8,t)],[(5/8,f),(3/8,f)]]
+> rqt_separate [1,1] d == Right r
+
+> d = [(4/7,t),(1/7,f),(1,f),(6/7,f),(3/7,f)]
+> r = [[(4/7,t),(1/7,f),(2/7,t)],[(5/7,f),(2/7,t)],[(4/7,f),(3/7,f)]]
+> rqt_separate [1,1,1] d == Right r
+-}
+rqt_separate :: [Rq] -> [Rq_Tied] -> Either String [[Rq_Tied]]
 rqt_separate m x =
     case (m,x) of
       ([],[]) -> Right []
-      ([],_) -> Left (show ("rqt_separate",x))
+      ([],_) -> Left (show ("rqt_separate: lhs empty, rhs non-empty",x))
       (i:m',_) ->
           case rqt_split_sum i x of
             Just (r,x') -> fmap (r :) (rqt_separate m' x')
-            Nothing -> Left (show ("rqt_separate",i,m',x))
+            Nothing -> Left (show ("rqt_separate: rqt_split_sum failed",(i,x),m'))
 
-rqt_separate_m :: [RQ] -> [RQ_T] -> Maybe [[RQ_T]]
+-- | Maybe form ot 'rqt_separate'
+rqt_separate_m :: [Rq] -> [Rq_Tied] -> Maybe [[Rq_Tied]]
 rqt_separate_m m = either_to_maybe . rqt_separate m
 
--- | If the input 'RQ_T' sequence cannot be notated (see
+-- | If the input 'Rq_Tied' sequence cannot be notated (see
 -- 'rqt_can_notate') separate into equal parts, so long as each part
 -- is not less than /i/.
 --
--- > rqt_separate_tuplet undefined [(1/3,_f),(1/6,_f)]
--- > rqt_separate_tuplet undefined [(4/7,_t),(1/7,_f),(2/7,_f)]
+-- > rqt_separate_tuplet undefined [(1/3,f),(1/6,f)]
+-- > rqt_separate_tuplet undefined [(4/7,t),(1/7,f),(2/7,f)]
 --
 -- > let d = map rq_rqt [1/3,1/6,2/5,1/10]
--- > in rqt_separate_tuplet (1/8) d == Right [[(1/3,_f),(1/6,_f)]
--- >                                         ,[(2/5,_f),(1/10,_f)]]
+-- > in rqt_separate_tuplet (1/8) d == Right [[(1/3,f),(1/6,f)]
+-- >                                         ,[(2/5,f),(1/10,f)]]
 --
 -- > let d = [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
 -- > in rqt_separate_tuplet (1/16) d
 --
--- > let d = [(2/5,_f),(1/5,_f),(1/5,_f),(1/5,_t),(1/2,_f),(1/2,_f)]
+-- > let d = [(2/5,f),(1/5,f),(1/5,f),(1/5,t),(1/2,f),(1/2,f)]
 -- > in rqt_separate_tuplet (1/2) d
 --
 -- > let d = [(4/10,True),(1/10,False),(1/2,True)]
 -- > in rqt_separate_tuplet (1/2) d
-rqt_separate_tuplet :: RQ -> [RQ_T] -> Either String [[RQ_T]]
+rqt_separate_tuplet :: Rq -> [Rq_Tied] -> Either String [[Rq_Tied]]
 rqt_separate_tuplet i x =
-    if rqt_can_notate x
+    if rqt_can_notate 2 x
     then Left (show ("rqt_separate_tuplet: separation not required",x))
     else let j = sum (map rqt_rq x) / 2
          in if j < i
@@ -274,10 +246,10 @@
 -- | Recursive variant of 'rqt_separate_tuplet'.
 --
 -- > let d = map rq_rqt [1,1/3,1/6,2/5,1/10]
--- > in rqt_tuplet_subdivide (1/8) d == [[(1/1,_f)]
--- >                                    ,[(1/3,_f),(1/6,_f)]
--- >                                    ,[(2/5,_f),(1/10,_f)]]
-rqt_tuplet_subdivide :: RQ -> [RQ_T] -> [[RQ_T]]
+-- > in rqt_tuplet_subdivide (1/8) d == [[(1/1,f)]
+-- >                                    ,[(1/3,f),(1/6,f)]
+-- >                                    ,[(2/5,f),(1/10,f)]]
+rqt_tuplet_subdivide :: Rq -> [Rq_Tied] -> [[Rq_Tied]]
 rqt_tuplet_subdivide i x =
     case rqt_separate_tuplet i x of
       Left _ -> [x]
@@ -287,13 +259,13 @@
 --
 -- > let d = [(1/5,True),(1/20,False),(1/2,False),(1/4,True)]
 -- > in rqt_tuplet_subdivide_seq (1/2) [d]
-rqt_tuplet_subdivide_seq :: RQ -> [[RQ_T]] -> [[RQ_T]]
+rqt_tuplet_subdivide_seq :: Rq -> [[Rq_Tied]] -> [[Rq_Tied]]
 rqt_tuplet_subdivide_seq i = concatMap (rqt_tuplet_subdivide i)
 
 -- | If a tuplet is all tied, it ought to be a plain value?!
 --
--- > rqt_tuplet_sanity_ [(4/10,_t),(1/10,_f)] == [(1/2,_f)]
-rqt_tuplet_sanity_ :: [RQ_T] -> [RQ_T]
+-- > rqt_tuplet_sanity_ [(4/10,t),(1/10,f)] == [(1/2,f)]
+rqt_tuplet_sanity_ :: [Rq_Tied] -> [Rq_Tied]
 rqt_tuplet_sanity_ t =
     let last_tied = rqt_tied (last t)
         all_tied = all rqt_tied (dropRight 1 t)
@@ -301,82 +273,86 @@
        then [(sum (map rqt_rq t),last_tied)]
        else t
 
-rqt_tuplet_subdivide_seq_sanity_ :: RQ -> [[RQ_T]] -> [[RQ_T]]
+rqt_tuplet_subdivide_seq_sanity_ :: Rq -> [[Rq_Tied]] -> [[Rq_Tied]]
 rqt_tuplet_subdivide_seq_sanity_ i =
     map rqt_tuplet_sanity_ .
     rqt_tuplet_subdivide_seq i
 
 -- * Divisions
 
--- | Separate 'RQ' sequence into measures given by 'RQ' length.
+-- | Separate 'Rq' sequence into measures given by 'Rq' length.
 --
--- > to_measures_rq [3,3] [2,2,2] == Right [[(2,_f),(1,_t)],[(1,_f),(2,_f)]]
--- > to_measures_rq [3,3] [6] == Right [[(3,_t)],[(3,_f)]]
--- > to_measures_rq [1,1,1] [3] == Right [[(1,_t)],[(1,_t)],[(1,_f)]]
+-- > to_measures_rq [3,3] [2,2,2] == Right [[(2,f),(1,t)],[(1,f),(2,f)]]
+-- > to_measures_rq [3,3] [6] == Right [[(3,t)],[(3,f)]]
+-- > to_measures_rq [1,1,1] [3] == Right [[(1,t)],[(1,t)],[(1,f)]]
 -- > to_measures_rq [3,3] [2,2,1]
 -- > to_measures_rq [3,2] [2,2,2]
 --
 -- > let d = [4/7,33/28,9/20,4/5]
--- > in to_measures_rq [3] d == Right [[(4/7,_f),(33/28,_f),(9/20,_f),(4/5,_f)]]
-to_measures_rq :: [RQ] -> [RQ] -> Either String [[RQ_T]]
+-- > in to_measures_rq [3] d == Right [[(4/7,f),(33/28,f),(9/20,f),(4/5,f)]]
+to_measures_rq :: [Rq] -> [Rq] -> Either String [[Rq_Tied]]
 to_measures_rq m = rqt_separate m . map rq_rqt
 
--- | Variant of 'to_measures_rq' that ensures 'RQ_T' are /cmn/
+-- | Variant that is applicable only at sequence that do not require splitting and ties, else error.
+to_measures_rq_untied_err :: [Rq] -> [Rq] -> [[Rq]]
+to_measures_rq_untied_err m = either (error "to_measures_rq_untied") (map (map rqt_to_rq_err)) . to_measures_rq m
+
+-- | Variant of 'to_measures_rq' that ensures 'Rq_Tied' are /cmn/
 -- durations.  This is not a good composition.
 --
--- > to_measures_rq_cmn [6,6] [5,5,2] == Right [[(4,_t),(1,_f),(1,_t)]
--- >                                           ,[(4,_f),(2,_f)]]
+-- > to_measures_rq_cmn [6,6] [5,5,2] == Right [[(4,t),(1,f),(1,t)]
+-- >                                           ,[(4,f),(2,f)]]
 --
--- > let r = [[(4/7,_t),(1/7,_f),(1,_f),(6/7,_f),(3/7,_f)]]
+-- > let r = [[(4/7,t),(1/7,f),(1,f),(6/7,f),(3/7,f)]]
 -- > in to_measures_rq_cmn [3] [5/7,1,6/7,3/7] == Right r
 --
--- > to_measures_rq_cmn [1,1,1] [5/7,1,6/7,3/7] == Right [[(4/7,_t),(1/7,_f),(2/7,_t)]
--- >                                                     ,[(4/7,_t),(1/7,_f),(2/7,_t)]
--- >                                                     ,[(4/7,_f),(3/7,_f)]]
-to_measures_rq_cmn :: [RQ] -> [RQ] -> Either String [[RQ_T]]
+-- > to_measures_rq_cmn [1,1,1] [5/7,1,6/7,3/7] == Right [[(4/7,t),(1/7,f),(2/7,t)]
+-- >                                                     ,[(4/7,t),(1/7,f),(2/7,t)]
+-- >                                                     ,[(4/7,f),(3/7,f)]]
+to_measures_rq_cmn :: [Rq] -> [Rq] -> Either String [[Rq_Tied]]
 to_measures_rq_cmn m = fmap (map rqt_set_to_cmn) . to_measures_rq m
 
 -- | Variant of 'to_measures_rq' with measures given by
--- 'Time_Signature' values.  Does not ensure 'RQ_T' are /cmn/
+-- 'Time_Signature' values.  Does not ensure 'Rq_Tied' are /cmn/
 -- durations.
 --
--- > to_measures_ts [(1,4)] [5/8,3/8] /= Right [[(1/2,_t),(1/8,_f),(3/8,_f)]]
--- > to_measures_ts [(1,4)] [5/7,2/7] /= Right [[(4/7,_t),(1/7,_f),(2/7,_f)]]
+-- > to_measures_ts [(1,4)] [5/8,3/8] /= Right [[(1/2,t),(1/8,f),(3/8,f)]]
+-- > to_measures_ts [(1,4)] [5/7,2/7] /= Right [[(4/7,t),(1/7,f),(2/7,f)]]
 --
 -- > let {m = replicate 18 (1,4)
 -- >     ;x = [3/4,2,5/4,9/4,1/4,3/2,1/2,7/4,1,5/2,11/4,3/2]}
--- > in to_measures_ts m x == Right [[(3/4,_f),(1/4,_t)],[(1/1,_t)]
--- >                                ,[(3/4,_f),(1/4,_t)],[(1/1,_f)]
--- >                                ,[(1/1,_t)],[(1/1,_t)]
--- >                                ,[(1/4,_f),(1/4,_f),(1/2,_t)],[(1/1,_f)]
--- >                                ,[(1/2,_f),(1/2,_t)],[(1/1,_t)]
--- >                                ,[(1/4,_f),(3/4,_t)],[(1/4,_f),(3/4,_t)]
--- >                                ,[(1/1,_t)],[(3/4,_f),(1/4,_t)]
--- >                                ,[(1/1,_t)],[(1/1,_t)]
--- >                                ,[(1/2,_f),(1/2,_t)],[(1/1,_f)]]
+-- > in to_measures_ts m x == Right [[(3/4,f),(1/4,t)],[(1/1,t)]
+-- >                                ,[(3/4,f),(1/4,t)],[(1/1,f)]
+-- >                                ,[(1/1,t)],[(1/1,t)]
+-- >                                ,[(1/4,f),(1/4,f),(1/2,t)],[(1/1,f)]
+-- >                                ,[(1/2,f),(1/2,t)],[(1/1,t)]
+-- >                                ,[(1/4,f),(3/4,t)],[(1/4,f),(3/4,t)]
+-- >                                ,[(1/1,t)],[(3/4,f),(1/4,t)]
+-- >                                ,[(1/1,t)],[(1/1,t)]
+-- >                                ,[(1/2,f),(1/2,t)],[(1/1,f)]]
 --
 -- > to_measures_ts [(3,4)] [4/7,33/28,9/20,4/5]
 -- > to_measures_ts (replicate 3 (1,4)) [4/7,33/28,9/20,4/5]
-to_measures_ts :: [Time_Signature] -> [RQ] -> Either String [[RQ_T]]
+to_measures_ts :: [Time_Signature] -> [Rq] -> Either String [[Rq_Tied]]
 to_measures_ts m = to_measures_rq (map ts_rq m)
 
 -- | Variant of 'to_measures_ts' that allows for duration field
 -- operation but requires that measures be well formed.  This is
 -- useful for re-grouping measures after notation and ascription.
-to_measures_ts_by_eq :: (a -> RQ) -> [Time_Signature] -> [a] -> Maybe [[a]]
+to_measures_ts_by_eq :: (a -> Rq) -> [Time_Signature] -> [a] -> Maybe [[a]]
 to_measures_ts_by_eq f m = split_sum_by_eq f (map ts_rq m)
 
--- | Divide measure into pulses of indicated 'RQ' durations.  Measure
+-- | Divide measure into pulses of indicated 'Rq' durations.  Measure
 -- must be of correct length but need not contain only /cmn/
 -- durations.  Pulses are further subdivided if required to notate
 -- tuplets correctly, see 'rqt_tuplet_subdivide_seq'.
 --
--- > let d = [(1/4,_f),(1/4,_f),(2/3,_t),(1/6,_f),(16/15,_f),(1/5,_f)
--- >         ,(1/5,_f),(2/5,_t),(1/20,_f),(1/2,_f),(1/4,_t)]
+-- > let d = [(1/4,f),(1/4,f),(2/3,t),(1/6,f),(16/15,f),(1/5,f)
+-- >         ,(1/5,f),(2/5,t),(1/20,f),(1/2,f),(1/4,t)]
 -- > in m_divisions_rq [1,1,1,1] d
 --
--- > m_divisions_rq [1,1,1] [(4/7,_f),(33/28,_f),(9/20,_f),(4/5,_f)]
-m_divisions_rq :: [RQ] -> [RQ_T] -> Either String [[RQ_T]]
+-- > m_divisions_rq [1,1,1] [(4/7,f),(33/28,f),(9/20,f),(4/5,f)]
+m_divisions_rq :: [Rq] -> [Rq_Tied] -> Either String [[Rq_Tied]]
 m_divisions_rq z =
     fmap (rqt_tuplet_subdivide_seq_sanity_ (1/16) .
           map rqt_set_to_cmn) .
@@ -385,59 +361,59 @@
 -- | Variant of 'm_divisions_rq' that determines pulse divisions from
 -- 'Time_Signature'.
 --
--- > let d = [(4/7,_t),(1/7,_f),(2/7,_f)]
+-- > let d = [(4/7,t),(1/7,f),(2/7,f)]
 -- > in m_divisions_ts (1,4) d == Just [d]
 --
 -- > let d = map rq_rqt [1/3,1/6,2/5,1/10]
--- > in m_divisions_ts (1,4) d == Just [[(1/3,_f),(1/6,_f)]
--- >                                   ,[(2/5,_f),(1/10,_f)]]
+-- > in m_divisions_ts (1,4) d == Just [[(1/3,f),(1/6,f)]
+-- >                                   ,[(2/5,f),(1/10,f)]]
 --
 -- > let d = map rq_rqt [4/7,33/28,9/20,4/5]
--- > in m_divisions_ts (3,4) d == Just [[(4/7,_f),(3/7,_t)]
--- >                                   ,[(3/4,_f),(1/4,_t)]
--- >                                   ,[(1/5,_f),(4/5,_f)]]
-m_divisions_ts :: Time_Signature -> [RQ_T] -> Either String [[RQ_T]]
+-- > in m_divisions_ts (3,4) d == Just [[(4/7,f),(3/7,t)]
+-- >                                   ,[(3/4,f),(1/4,t)]
+-- >                                   ,[(1/5,f),(4/5,f)]]
+m_divisions_ts :: Time_Signature -> [Rq_Tied] -> Either String [[Rq_Tied]]
 m_divisions_ts ts = m_divisions_rq (ts_divisions ts)
 
 {-| Composition of 'to_measures_rq' and 'm_divisions_rq', where
 measures are initially given as sets of divisions.
 
 > let m = [[1,1,1],[1,1,1]]
-> in to_divisions_rq m [2,2,2] == Right [[[(1,_t)],[(1,_f)],[(1,_t)]]
->                                      ,[[(1,_f)],[(1,_t)],[(1,_f)]]]
+> in to_divisions_rq m [2,2,2] == Right [[[(1,t)],[(1,f)],[(1,t)]]
+>                                      ,[[(1,f)],[(1,t)],[(1,f)]]]
 
 > let d = [2/7,1/7,4/7,5/7,8/7,1,1/7]
-> in to_divisions_rq [[1,1,1,1]] d == Right [[[(2/7,_f),(1/7,_f),(4/7,_f)]
->                                           ,[(4/7,_t),(1/7,_f),(2/7,_t)]
->                                           ,[(6/7,_f),(1/7,_t)]
->                                           ,[(6/7,_f),(1/7,_f)]]]
+> in to_divisions_rq [[1,1,1,1]] d == Right [[[(2/7,f),(1/7,f),(4/7,f)]
+>                                           ,[(4/7,t),(1/7,f),(2/7,t)]
+>                                           ,[(6/7,f),(1/7,t)]
+>                                           ,[(6/7,f),(1/7,f)]]]
 
 > let d = [5/7,1,6/7,3/7]
-> in to_divisions_rq [[1,1,1]] d == Right [[[(4/7,_t),(1/7,_f),(2/7,_t)]
->                                         ,[(4/7,_t),(1/7,_f),(2/7,_t)]
->                                         ,[(4/7,_f),(3/7,_f)]]]
+> in to_divisions_rq [[1,1,1]] d == Right [[[(4/7,t),(1/7,f),(2/7,t)]
+>                                         ,[(4/7,t),(1/7,f),(2/7,t)]
+>                                         ,[(4/7,f),(3/7,f)]]]
 
 > let d = [2/7,1/7,4/7,5/7,1,6/7,3/7]
-> in to_divisions_rq [[1,1,1,1]] d == Right [[[(2/7,_f),(1/7,_f),(4/7,_f)]
->                                           ,[(4/7,_t),(1/7,_f),(2/7,_t)]
->                                           ,[(4/7,_t),(1/7,_f),(2/7,_t)]
->                                           ,[(4/7,_f),(3/7,_f)]]]
+> in to_divisions_rq [[1,1,1,1]] d == Right [[[(2/7,f),(1/7,f),(4/7,f)]
+>                                           ,[(4/7,t),(1/7,f),(2/7,t)]
+>                                           ,[(4/7,t),(1/7,f),(2/7,t)]
+>                                           ,[(4/7,f),(3/7,f)]]]
 
 > let d = [4/7,33/28,9/20,4/5]
-> in to_divisions_rq [[1,1,1]] d == Right [[[(4/7,_f),(3/7,_t)]
->                                          ,[(3/4,_f),(1/4,_t)]
->                                          ,[(1/5,_f),(4/5,_f)]]]
+> in to_divisions_rq [[1,1,1]] d == Right [[[(4/7,f),(3/7,t)]
+>                                          ,[(3/4,f),(1/4,t)]
+>                                          ,[(1/5,f),(4/5,f)]]]
 
 > let {p = [[1/2,1,1/2],[1/2,1]]
 >     ;d = map (/6) [1,1,1,1,1,1,4,1,2,1,1,2,1,3]}
-> in to_divisions_rq p d == Right [[[(1/6,_f),(1/6,_f),(1/6,_f)]
->                                  ,[(1/6,_f),(1/6,_f),(1/6,_f),(1/2,True)]
->                                  ,[(1/6,_f),(1/6,_f),(1/6,True)]]
->                                 ,[[(1/6,_f),(1/6,_f),(1/6,_f)]
->                                  ,[(1/3,_f),(1/6,_f),(1/2,_f)]]]
+> in to_divisions_rq p d == Right [[[(1/6,f),(1/6,f),(1/6,f)]
+>                                  ,[(1/6,f),(1/6,f),(1/6,f),(1/2,True)]
+>                                  ,[(1/6,f),(1/6,f),(1/6,True)]]
+>                                 ,[[(1/6,f),(1/6,f),(1/6,f)]
+>                                  ,[(1/3,f),(1/6,f),(1/2,f)]]]
 
 -}
-to_divisions_rq :: [[RQ]] -> [RQ] -> Either String [[[RQ_T]]]
+to_divisions_rq :: [[Rq]] -> [Rq] -> Either String [[[Rq_Tied]]]
 to_divisions_rq m x =
     let m' = map sum m
     in case to_measures_rq m' x of
@@ -448,39 +424,39 @@
 -- 'Time_Signature'.
 --
 -- > let d = [3/5,2/5,1/3,1/6,7/10,17/15,1/2,1/6]
--- > in to_divisions_ts [(4,4)] d == Just [[[(3/5,_f),(2/5,_f)]
--- >                                       ,[(1/3,_f),(1/6,_f),(1/2,_t)]
--- >                                       ,[(1/5,_f),(4/5,_t)]
--- >                                       ,[(1/3,_f),(1/2,_f),(1/6,_f)]]]
+-- > in to_divisions_ts [(4,4)] d == Just [[[(3/5,f),(2/5,f)]
+-- >                                       ,[(1/3,f),(1/6,f),(1/2,t)]
+-- >                                       ,[(1/5,f),(4/5,t)]
+-- >                                       ,[(1/3,f),(1/2,f),(1/6,f)]]]
 --
 -- > let d = [3/5,2/5,1/3,1/6,7/10,29/30,1/2,1/3]
--- > in to_divisions_ts [(4,4)] d == Just [[[(3/5,_f),(2/5,_f)]
--- >                                       ,[(1/3,_f),(1/6,_f),(1/2,_t)]
--- >                                       ,[(1/5,_f),(4/5,_t)]
--- >                                       ,[(1/6,_f),(1/2,_f),(1/3,_f)]]]
+-- > in to_divisions_ts [(4,4)] d == Just [[[(3/5,f),(2/5,f)]
+-- >                                       ,[(1/3,f),(1/6,f),(1/2,t)]
+-- >                                       ,[(1/5,f),(4/5,t)]
+-- >                                       ,[(1/6,f),(1/2,f),(1/3,f)]]]
 --
 -- > let d = [3/5,2/5,1/3,1/6,7/10,4/5,1/2,1/2]
--- > in to_divisions_ts [(4,4)] d == Just [[[(3/5,_f),(2/5,_f)]
--- >                                       ,[(1/3,_f),(1/6,_f),(1/2,_t)]
--- >                                       ,[(1/5,_f),(4/5,_f)]
--- >                                       ,[(1/2,_f),(1/2,_f)]]]
+-- > in to_divisions_ts [(4,4)] d == Just [[[(3/5,f),(2/5,f)]
+-- >                                       ,[(1/3,f),(1/6,f),(1/2,t)]
+-- >                                       ,[(1/5,f),(4/5,f)]
+-- >                                       ,[(1/2,f),(1/2,f)]]]
 --
 -- > let d = [4/7,33/28,9/20,4/5]
--- > in to_divisions_ts [(3,4)] d == Just [[[(4/7,_f),(3/7,_t)]
--- >                                       ,[(3/4,_f),(1/4,_t)]
--- >                                       ,[(1/5,_f),(4/5,_f)]]]
-to_divisions_ts :: [Time_Signature] -> [RQ] -> Either String [[[RQ_T]]]
+-- > in to_divisions_ts [(3,4)] d == Just [[[(4/7,f),(3/7,t)]
+-- >                                       ,[(3/4,f),(1/4,t)]
+-- >                                       ,[(1/5,f),(4/5,f)]]]
+to_divisions_ts :: [Time_Signature] -> [Rq] -> Either String [[[Rq_Tied]]]
 to_divisions_ts ts = to_divisions_rq (map ts_divisions ts)
 
 -- * Durations
 
 -- | Pulse tuplet derivation.
 --
--- > p_tuplet_rqt [(2/3,_f),(1/3,_t)] == Just ((3,2),[(1,_f),(1/2,_t)])
--- > p_tuplet_rqt (map rq_rqt [1/3,1/6]) == Just ((3,2),[(1/2,_f),(1/4,_f)])
--- > p_tuplet_rqt (map rq_rqt [2/5,1/10]) == Just ((5,4),[(1/2,_f),(1/8,_f)])
+-- > p_tuplet_rqt [(2/3,f),(1/3,t)] == Just ((3,2),[(1,f),(1/2,t)])
+-- > p_tuplet_rqt (map rq_rqt [1/3,1/6]) == Just ((3,2),[(1/2,f),(1/4,f)])
+-- > p_tuplet_rqt (map rq_rqt [2/5,1/10]) == Just ((5,4),[(1/2,f),(1/8,f)])
 -- > p_tuplet_rqt (map rq_rqt [1/3,1/6,2/5,1/10])
-p_tuplet_rqt :: [RQ_T] -> Maybe ((Integer,Integer),[RQ_T])
+p_tuplet_rqt :: [Rq_Tied] -> Maybe ((Integer,Integer),[Rq_Tied])
 p_tuplet_rqt x =
     let f t = (t,map (rqt_un_tuplet t) x)
     in fmap f (rq_derive_tuplet (map rqt_rq x))
@@ -488,31 +464,31 @@
 -- | Notate pulse, ie. derive tuplet if neccesary. The flag indicates
 -- if the initial value is tied left.
 --
--- > p_notate False [(2/3,_f),(1/3,_t)]
--- > p_notate False [(2/5,_f),(1/10,_t)]
--- > p_notate False [(1/4,_t),(1/8,_f),(1/8,_f)]
+-- > p_notate False [(2/3,f),(1/3,t)]
+-- > p_notate False [(2/5,f),(1/10,t)]
+-- > p_notate False [(1/4,t),(1/8,f),(1/8,f)]
 -- > p_notate False (map rq_rqt [1/3,1/6])
 -- > p_notate False (map rq_rqt [2/5,1/10])
 -- > p_notate False (map rq_rqt [1/3,1/6,2/5,1/10]) == Nothing
-p_notate :: Bool -> [RQ_T] -> Either String [Duration_A]
+p_notate :: Bool -> [Rq_Tied] -> Either String [Duration_A]
 p_notate z x =
     let f = p_simplify . rqt_to_duration_a z
         d = case p_tuplet_rqt x of
               Just (t,x') -> da_tuplet t (f x')
               Nothing -> f x
-    in if rq_can_notate (map rqt_rq x)
+    in if rq_can_notate 2 (map rqt_rq x)
        then Right d
        else Left (show ("p_notate",z,x))
 
 -- | Notate measure.
 --
--- > m_notate True [[(2/3,_f),(1/3,_t)],[(1,_t)],[(1,_f)]]
+-- > m_notate True [[(2/3,f),(1/3,t)],[(1,t)],[(1,f)]]
 --
 -- > let f = m_notate False . concat
 --
 -- > fmap f (to_divisions_ts [(4,4)] [3/5,2/5,1/3,1/6,7/10,17/15,1/2,1/6])
 -- > fmap f (to_divisions_ts [(4,4)] [3/5,2/5,1/3,1/6,7/10,29/30,1/2,1/3])
-m_notate :: Bool -> [[RQ_T]] -> Either String [Duration_A]
+m_notate :: Bool -> [[Rq_Tied]] -> Either String [Duration_A]
 m_notate z m =
     let z' = z : map (is_tied_right . last) m
     in fmap concat (all_right (zipWith p_notate z' m))
@@ -533,7 +509,7 @@
 > in fmap mm_notate (to_divisions_rq p d)
 
 -}
-mm_notate :: [[[RQ_T]]] -> Either String [[Duration_A]]
+mm_notate :: [[[Rq_Tied]]] -> Either String [[Duration_A]]
 mm_notate d =
     let z = False : map (is_tied_right . last . last) d
     in all_right (zipWith m_notate z d)
@@ -542,13 +518,13 @@
 
 -- | Structure given to 'Simplify_P' to decide simplification.  The
 -- structure is /(ts,start-rq,(left-rq,right-rq))/.
-type Simplify_T = (Time_Signature,RQ,(RQ,RQ))
+type Simplify_T = (Time_Signature,Rq,(Rq,Rq))
 
 -- | Predicate function at 'Simplify_T'.
 type Simplify_P = Simplify_T -> Bool
 
 -- | Variant of 'Simplify_T' allowing multiple rules.
-type Simplify_M = ([Time_Signature],[RQ],[(RQ,RQ)])
+type Simplify_M = ([Time_Signature],[Rq],[(Rq,Rq)])
 
 -- | Transform 'Simplify_M' to 'Simplify_P'.
 meta_table_p :: Simplify_M -> Simplify_P
@@ -641,7 +617,7 @@
                 g i = if dots i <= n_dots && t && e && m && r
                       then Just (i,a)
                       else Nothing
-            in join (fmap g d)
+            in g =<< d
         z i (j,_) = i + duration_to_rq j
     in coalesce_sum z 0 f
 
@@ -667,13 +643,13 @@
 -- > p_simplify [(e,[Tie_Right]),(s,[Tie_Left]),(e',[])] == [(e',[]),(e',[])]
 --
 -- > let f = rqt_to_duration_a False
--- > in p_simplify (f [(1/8,_t),(1/4,_t),(1/8,_f)]) == f [(1/2,_f)]
+-- > in p_simplify (f [(1/8,t),(1/4,t),(1/8,f)]) == f [(1/2,f)]
 p_simplify :: [Duration_A] -> [Duration_A]
 p_simplify = m_simplify p_simplify_rule undefined
 
 -- * Notate
 
-{-| Notate RQ duration sequence.  Derive pulse divisions from
+{-| Notate Rq duration sequence.  Derive pulse divisions from
 'Time_Signature' if not given directly.  Composition of
 'to_divisions_ts', 'mm_notate' 'm_simplify'.
 
@@ -684,7 +660,7 @@
 >  in T.notate_rqp 4 sr ts (Just ts_p) rq
 
 -}
-notate_rqp :: Int -> Simplify_P -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] ->
+notate_rqp :: Int -> Simplify_P -> [Time_Signature] -> Maybe [[Rq]] -> [Rq] ->
               Either String [[Duration_A]]
 notate_rqp limit r ts ts_p x = do
   let ts_p' = fromMaybe (map ts_divisions ts) ts_p
@@ -695,9 +671,8 @@
 -- | Variant of 'notate_rqp' without pulse divisions (derive).
 --
 -- > notate 4 (default_rule [((3,2),0,(2,2)),((3,2),0,(4,2))]) [(3,2)] [6]
-notate :: Int -> Simplify_P -> [Time_Signature] -> [RQ] ->
-          Either String [[Duration_A]]
-notate limit r ts x = notate_rqp limit r ts Nothing x
+notate :: Int -> Simplify_P -> [Time_Signature] -> [Rq] -> Either String [[Duration_A]]
+notate limit r ts = notate_rqp limit r ts Nothing
 
 -- * Ascribe
 
@@ -779,15 +754,15 @@
                in r : mm_ascribe mm' x'
 
 -- | 'mm_ascribe of 'notate'.
-notate_mm_ascribe :: Show a => Int -> [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [a] ->
+notate_mm_ascribe :: Show a => Int -> [Simplify_T] -> [Time_Signature] -> Maybe [[Rq]] -> [Rq] -> [a] ->
                      Either String [[(Duration_A,a)]]
 notate_mm_ascribe limit r ts rqp d p =
     let n = notate_rqp limit (default_rule r) ts rqp d
         f = flip mm_ascribe p
-        err str = show ("notate_ascribe",str,ts,d,p)
+        err str = show ("notate_mm_ascribe",str,ts,d,p)
     in either (Left . err) (Right . f) n
 
-notate_mm_ascribe_err :: Show a => Int -> [Simplify_T] -> [Time_Signature] -> Maybe [[RQ]] -> [RQ] -> [a] ->
+notate_mm_ascribe_err :: Show a => Int -> [Simplify_T] -> [Time_Signature] -> Maybe [[Rq]] -> [Rq] -> [a] ->
                          [[(Duration_A,a)]]
 notate_mm_ascribe_err = either error id .::::: notate_mm_ascribe
 
diff --git a/Music/Theory/Dynamic_Mark.hs b/Music/Theory/Dynamic_Mark.hs
--- a/Music/Theory/Dynamic_Mark.hs
+++ b/Music/Theory/Dynamic_Mark.hs
@@ -4,57 +4,71 @@
 import Data.Char {- base -}
 import Data.List {- base -}
 import Data.Maybe {- base -}
+import Text.Read {- base -}
 
-import qualified Music.Theory.List as T
+import qualified Music.Theory.List as T {- hmt -}
 
 -- | Enumeration of dynamic mark symbols.
-data Dynamic_Mark_T = Niente
-                    | PPPPP | PPPP | PPP | PP | P | MP
-                    | MF | F | FF | FFF | FFFF | FFFFF
-                    | FP | SF | SFP | SFPP | SFZ | SFFZ
-                      deriving (Eq,Ord,Enum,Bounded,Show)
+data Dynamic_Mark = Niente
+                    | Ppppp | Pppp | Ppp | Pp | P | Mp
+                    | Mf | F | Ff | Fff | Ffff | Fffff
+                    | Fp | Sf | Sfp | Sfpp | Sfz | Sffz
+                      deriving (Eq,Ord,Enum,Bounded,Show,Read)
 
--- | Lookup MIDI velocity for 'Dynamic_Mark_T'.  The range is linear
--- in @0-127@.
---
--- > let r = [0,6,17,28,39,50,61,72,83,94,105,116,127]
--- > in mapMaybe dynamic_mark_midi [Niente .. FFFFF] == r
---
--- > map dynamic_mark_midi [FP,SF,SFP,SFPP,SFZ,SFFZ] == replicate 6 Nothing
-dynamic_mark_midi :: (Num n,Enum n) => Dynamic_Mark_T -> Maybe n
+{- | Case insensitive reader for 'Dynamic_Mark'.
+
+> map dynamic_mark_t_parse_ci (words "pP p Mp F")
+-}
+dynamic_mark_t_parse_ci :: String -> Maybe Dynamic_Mark
+dynamic_mark_t_parse_ci =
+  let capitalise x = toUpper (head x) : map toLower (tail x)
+  in readMaybe . capitalise
+
+{- | Lookup Midi velocity for 'Dynamic_Mark'.  The range is linear in @0-127@.
+
+> let r = [0,6,17,28,39,50,61,72,83,94,105,116,127]
+> mapMaybe dynamic_mark_midi [Niente .. Fffff] == r
+
+> mapMaybe dynamic_mark_midi [Pp .. Ff] == [39,50,61,72,83,94]
+
+> map dynamic_mark_midi [Fp,Sf,Sfp,Sfpp,Sfz,Sffz] == replicate 6 Nothing
+-}
+dynamic_mark_midi :: (Num n,Enum n) => Dynamic_Mark -> Maybe n
 dynamic_mark_midi m =
     let r = zip [0..] (0 : reverse [127, 127-11 .. 0])
     in lookup (fromEnum m) r
 
 -- | Error variant.
-dynamic_mark_midi_err :: Integral n => Dynamic_Mark_T -> n
+dynamic_mark_midi_err :: Integral n => Dynamic_Mark -> n
 dynamic_mark_midi_err = fromMaybe (error "dynamic_mark_midi") . dynamic_mark_midi
 
--- | Map midi velocity (0-127) to dynamic mark.
---
--- > histogram (mapMaybe midi_dynamic_mark [0 .. 127])
-midi_dynamic_mark :: (Ord n,Num n,Enum n) => n -> Maybe Dynamic_Mark_T
+{- | Map midi velocity (0-127) to dynamic mark.
+
+> histogram (mapMaybe midi_dynamic_mark [0 .. 127])
+-}
+midi_dynamic_mark :: (Ord n,Num n,Enum n) => n -> Maybe Dynamic_Mark
 midi_dynamic_mark m =
     let r = zip (0 : [12,24 .. 132]) [0..]
     in fmap (toEnum . snd) (find ((>= m) . fst) r)
 
--- | Translate /fixed/ 'Dynamic_Mark_T's to /db/ amplitude over given
--- /range/.
---
--- > mapMaybe (dynamic_mark_db 120) [Niente,P,F,FFFFF] == [-120,-70,-40,0]
--- > mapMaybe (dynamic_mark_db 60) [Niente,P,F,FFFFF] == [-60,-35,-20,0]
-dynamic_mark_db :: Fractional n => n -> Dynamic_Mark_T -> Maybe n
+{- | Translate /fixed/ 'Dynamic_Mark's to /db/ amplitude over given /range/.
+
+> mapMaybe (dynamic_mark_db 120) [Niente,P,F,Fffff] == [-120,-70,-40,0]
+> mapMaybe (dynamic_mark_db 60) [Niente,P,F,Fffff] == [-60,-35,-20,0]
+-}
+dynamic_mark_db :: Fractional n => n -> Dynamic_Mark -> Maybe n
 dynamic_mark_db r m =
-    let u = [Niente .. FFFFF]
+    let u = [Niente .. Fffff]
         n = length u - 1
         k = r / fromIntegral n
         f i = negate r + (fromIntegral i * k)
     in fmap f (elemIndex m u)
 
--- | <http://www.csounds.com/manual/html/ampmidid.html>
---
--- > import Sound.SC3.Plot
--- > plotTable [map (ampmidid 20) [0 .. 127],map (ampmidid 60) [0 .. 127]]
+{- | <http://www.csounds.com/manual/html/ampmidid.html>
+
+> import Sound.Sc3.Plot {- hsc3-plot -}
+> plot_p1_ln [map (ampmidid 20) [0 .. 127],map (ampmidid 60) [0 .. 127]]
+-}
 ampmidid :: Floating a => a -> a -> a
 ampmidid db v =
     let r = 10 ** (db / 20)
@@ -62,26 +76,29 @@
         m = (1 - b) / 127
     in (m * v + b) ** 2
 
--- | JMcC (SC3) equation.
---
--- > plotTable1 (map amp_db [0,0.005 .. 1])
+{- | JMcC (Sc3) equation.
+
+> plot_p1_ln [map amp_db [0,0.005 .. 1]]
+-}
 amp_db :: Floating a => a -> a
 amp_db a = logBase 10 a * 20
 
--- | JMcC (SC3) equation.
---
--- > plotTable1 (map db_amp [-60,-59 .. 0])
+{- | JMcC (Sc3) equation.
+
+> plot_p1_ln [map db_amp [-60,-59 .. 0]]
+-}
 db_amp :: Floating a => a -> a
 db_amp a = 10 ** (a * 0.05)
 
 -- | Enumeration of hairpin indicators.
-data Hairpin_T = Crescendo | Diminuendo | End_Hairpin
+data Hairpin = Crescendo | Diminuendo | End_Hairpin
                  deriving (Eq,Ord,Enum,Bounded,Show)
 
--- | The 'Hairpin_T' implied by a ordered pair of 'Dynamic_Mark_T's.
---
--- > map (implied_hairpin MF) [MP,F] == [Just Diminuendo,Just Crescendo]
-implied_hairpin :: Dynamic_Mark_T -> Dynamic_Mark_T -> Maybe Hairpin_T
+{- | The 'Hairpin' implied by a ordered pair of 'Dynamic_Mark's.
+
+> map (implied_hairpin Mf) [Mp,F] == [Just Diminuendo,Just Crescendo]
+-}
+implied_hairpin :: Dynamic_Mark -> Dynamic_Mark -> Maybe Hairpin
 implied_hairpin p q =
     case compare p q of
       LT -> Just Crescendo
@@ -89,20 +106,18 @@
       GT -> Just Diminuendo
 
 -- | A node in a dynamic sequence.
-type Dynamic_Node = (Maybe Dynamic_Mark_T,Maybe Hairpin_T)
+type Dynamic_Node = (Maybe Dynamic_Mark,Maybe Hairpin)
 
 -- | The empty 'Dynamic_Node'.
 empty_dynamic_node :: Dynamic_Node
 empty_dynamic_node = (Nothing,Nothing)
 
--- | Calculate a 'Dynamic_Node' sequence from a sequence of
--- 'Dynamic_Mark_T's.
---
--- > dynamic_sequence [PP,MP,MP,PP] == [(Just PP,Just Crescendo)
--- >                                   ,(Just MP,Just End_Hairpin)
--- >                                   ,(Nothing,Just Diminuendo)
--- >                                   ,(Just PP,Just End_Hairpin)]
-dynamic_sequence :: [Dynamic_Mark_T] -> [Dynamic_Node]
+{- | Calculate a 'Dynamic_Node' sequence from a sequence of 'Dynamic_Mark's.
+
+> let r = [(Just Pp,Just Crescendo), (Just Mp,Just End_Hairpin) ,(Nothing,Just Diminuendo) ,(Just Pp,Just End_Hairpin)]
+> dynamic_sequence [Pp,Mp,Mp,Pp] == r
+-}
+dynamic_sequence :: [Dynamic_Mark] -> [Dynamic_Node]
 dynamic_sequence d =
     let h = zipWith implied_hairpin d (tail d) ++ [Nothing]
         e = Just End_Hairpin
@@ -117,11 +132,12 @@
                             Just _ -> (j,k) : rec True p'
     in rec False (zip (T.indicate_repetitions d) h)
 
--- | Delete redundant (unaltered) dynamic marks.
---
--- > let s = [Just P,Nothing,Just P,Just P,Just F]
--- > in delete_redundant_marks s == [Just P,Nothing,Nothing,Nothing,Just F]
-delete_redundant_marks :: [Maybe Dynamic_Mark_T] -> [Maybe Dynamic_Mark_T]
+{- | Delete redundant (unaltered) dynamic marks.
+
+> let r = [Just P,Nothing,Nothing,Nothing,Just F]
+> delete_redundant_marks [Just P,Nothing,Just P,Just P,Just F] == r
+-}
+delete_redundant_marks :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Mark]
 delete_redundant_marks =
     let f i j = case (i,j) of
                   (Just a,Just b) -> if a == b then (j,Nothing) else (j,j)
@@ -129,48 +145,46 @@
                   (Nothing,_) -> (j,j)
     in snd . mapAccumL f Nothing
 
--- | Variant of 'dynamic_sequence' for sequences of 'Dynamic_Mark_T'
--- with holes (ie. rests).  Runs 'delete_redundant_marks'.
---
--- > let r = [Just (Just P,Just Crescendo),Just (Just F,Just End_Hairpin)
--- >         ,Nothing,Just (Just P,Nothing)]
--- > in dynamic_sequence_sets [Just P,Just F,Nothing,Just P] == r
---
--- > let s = [Just P,Nothing,Just P]
--- > in dynamic_sequence_sets s = [Just (Just P,Nothing),Nothing,Nothing]
-dynamic_sequence_sets :: [Maybe Dynamic_Mark_T] -> [Maybe Dynamic_Node]
+{- | Variant of 'dynamic_sequence' for sequences of 'Dynamic_Mark' with holes (ie. rests).
+Runs 'delete_redundant_marks'.
+
+> let r = [Just (Just P,Just Crescendo),Just (Just F,Just End_Hairpin),Nothing,Just (Just P,Nothing)]
+> dynamic_sequence_sets [Just P,Just F,Nothing,Just P] == r
+
+> dynamic_sequence_sets [Just P,Nothing,Just P] == [Just (Just P,Nothing),Nothing,Nothing]
+-}
+dynamic_sequence_sets :: [Maybe Dynamic_Mark] -> [Maybe Dynamic_Node]
 dynamic_sequence_sets =
     let f l = case l of
                 Nothing:_ -> map (const Nothing) l
                 _ -> map Just (dynamic_sequence (catMaybes l))
     in concatMap f . T.group_just . delete_redundant_marks
 
--- | Apply 'Hairpin_T' and 'Dynamic_Mark_T' functions in that order as
--- required by 'Dynamic_Node'.
---
--- > let f _ x = show x
--- > in apply_dynamic_node f f (Nothing,Just Crescendo) undefined
-apply_dynamic_node :: (a -> Dynamic_Mark_T -> a) -> (a -> Hairpin_T -> a)
-                   -> Dynamic_Node -> a -> a
+{- | Apply 'Hairpin' and 'Dynamic_Mark' functions in that order as required by 'Dynamic_Node'.
+
+> let f _ x = show x
+> apply_dynamic_node f f (Nothing,Just Crescendo) undefined
+-}
+apply_dynamic_node :: (a -> Dynamic_Mark -> a) -> (a -> Hairpin -> a) -> Dynamic_Node -> a -> a
 apply_dynamic_node f g (i,j) m =
     let n = maybe m (g m) j
     in maybe n (f n) i
 
--- * ASCII
+-- * Ascii
 
--- | ASCII pretty printer for 'Dynamic_Mark_T'.
-dynamic_mark_ascii :: Dynamic_Mark_T -> String
+-- | Ascii pretty printer for 'Dynamic_Mark'.
+dynamic_mark_ascii :: Dynamic_Mark -> String
 dynamic_mark_ascii = map toLower . show
 
--- | ASCII pretty printer for 'Hairpin_T'.
-hairpin_ascii :: Hairpin_T -> String
+-- | Ascii pretty printer for 'Hairpin'.
+hairpin_ascii :: Hairpin -> String
 hairpin_ascii hp =
     case hp of
       Crescendo -> "<"
       Diminuendo -> ">"
       End_Hairpin -> ""
 
--- | ASCII pretty printer for 'Dynamic_Node'.
+-- | Ascii pretty printer for 'Dynamic_Node'.
 dynamic_node_ascii :: Dynamic_Node -> String
 dynamic_node_ascii (mk,hp) =
     let mk' = maybe "" dynamic_mark_ascii mk
@@ -181,9 +195,9 @@
          (_,[]) -> mk'
          _ -> mk' ++ " " ++ hp'
 
--- | ASCII pretty printer for 'Dynamic_Node' sequence.
+-- | Ascii pretty printer for 'Dynamic_Node' sequence.
 dynamic_sequence_ascii :: [Dynamic_Node] -> String
 dynamic_sequence_ascii =
-    intercalate " " .
+    unwords .
     filter (not . null) .
     map dynamic_node_ascii
diff --git a/Music/Theory/Either.hs b/Music/Theory/Either.hs
deleted file mode 100644
--- a/Music/Theory/Either.hs
+++ /dev/null
@@ -1,16 +0,0 @@
--- | Either
-module Music.Theory.Either where
-
--- | Maybe 'Left' of 'Either'.
-fromLeft :: Either a b -> Maybe a
-fromLeft e =
-    case e of
-      Left x -> Just x
-      _ -> Nothing
-
--- | Maybe 'Right' of 'Either'.
-fromRight :: Either a b -> Maybe b
-fromRight e =
-    case e of
-      Right x -> Just x
-      _ -> Nothing
diff --git a/Music/Theory/Enum.hs b/Music/Theory/Enum.hs
deleted file mode 100644
--- a/Music/Theory/Enum.hs
+++ /dev/null
@@ -1,38 +0,0 @@
--- | Enumeration functions.
-module Music.Theory.Enum where
-
--- | Generic variant of 'fromEnum' (p.263).
-genericFromEnum :: (Integral i,Enum e) => e -> i
-genericFromEnum = fromIntegral . fromEnum
-
--- | Generic variant of 'toEnum' (p.263).
-genericToEnum :: (Integral i,Enum e) => i -> e
-genericToEnum = toEnum . fromIntegral
-
--- | Variant of 'enumFromTo' that, if /p/ is after /q/, cycles from
--- 'maxBound' to 'minBound'.
---
--- > import Data.Word
--- > enum_from_to_cyclic (254 :: Word8) 1 == [254,255,0,1]
-enum_from_to_cyclic :: (Bounded a, Enum a) => a -> a -> [a]
-enum_from_to_cyclic p q =
-    if fromEnum p > fromEnum q
-    then [p .. maxBound] ++ [minBound .. q]
-    else [p .. q]
-
--- | Variant of 'enumFromTo' that, if /p/ is after /q/, enumerates
--- from /q/ to /p/.
---
--- > enum_from_to_reverse 5 1 == [5,4,3,2,1]
--- > enum_from_to_reverse 1 5 == enumFromTo 1 5
-enum_from_to_reverse :: Enum a => a -> a -> [a]
-enum_from_to_reverse p q =
-    if fromEnum p > fromEnum q
-    then reverse [q .. p]
-    else [p .. q]
-
--- | All elements in sequence.
---
--- > (enum_univ :: [Data.Word.Word8]) == [0 .. 255]
-enum_univ :: (Bounded t,Enum t) => [t]
-enum_univ = [minBound .. maxBound]
diff --git a/Music/Theory/Function.hs b/Music/Theory/Function.hs
deleted file mode 100644
--- a/Music/Theory/Function.hs
+++ /dev/null
@@ -1,59 +0,0 @@
--- | "Data.Function" related functions.
-module Music.Theory.Function where
-
--- | 'const' of 'const'.
---
--- > const2 5 undefined undefined == 5
--- > const (const 5) undefined undefined == 5
-const2 :: a -> b -> c -> a
-const2 x _ _ = x
-
--- * Predicate composition.
-
--- | '&&' of predicates.
-predicate_and :: (t -> Bool) -> (t -> Bool) -> t -> Bool
-predicate_and f g x = f x && g x
-
--- | 'all' of predicates.
---
--- > let r = [False,False,True,False,True,False]
--- > in map (predicate_all [(> 0),(< 5),even]) [0..5] == r
-predicate_all :: [t -> Bool] -> t -> Bool
-predicate_all p x = all id (map ($ x) p)
-
--- | '||' of predicates.
-predicate_or :: (t -> Bool) -> (t -> Bool) -> t -> Bool
-predicate_or f g x = f x || g x
-
--- | 'any' of predicates, ie. logical /or/ of list of predicates.
---
--- > let r = [True,False,True,False,True,True]
--- > in map (predicate_any [(== 0),(== 5),even]) [0..5] == r
-predicate_any :: [t -> Bool] -> t -> Bool
-predicate_any p x = any id (map ($ x) p)
-
--- * Function composition.
-
--- . is infixr 9, this allows f . g .: h
-infixr 8 .:, .::, .:::, .::::, .:::::
-
--- | 'fmap' '.' 'fmap', ie. @(t -> c) -> (a -> b -> t) -> a -> b -> c@.
-(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
-(.:) = fmap . fmap
-
--- | 'fmap' '.' '.:', ie. @(t -> d) -> (a -> b -> c -> t) -> a -> b -> c -> d@.
-(.::) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
-(.::) = fmap . (.:)
-
--- | 'fmap' '.' '.::'.
-(.:::) :: (Functor f, Functor g, Functor h,Functor i) => (a -> b) -> f (g (h (i a))) -> f (g (h (i b)))
-(.:::) = fmap . (.::)
-
--- | 'fmap' '.' '.:::'.
-(.::::) :: (Functor f, Functor g, Functor h,Functor i,Functor j) => (a -> b) -> f (g (h (i (j a)))) -> f (g (h (i (j b))))
-(.::::) = fmap . (.:::)
-
--- | 'fmap' '.' '.::::'.
-(.:::::) :: (Functor f, Functor g, Functor h,Functor i,Functor j,Functor k) => (a -> b) -> f (g (h (i (j (k a))))) -> f (g (h (i (j (k b)))))
-(.:::::) = fmap . (.::::)
-
diff --git a/Music/Theory/Gamelan.hs b/Music/Theory/Gamelan.hs
--- a/Music/Theory/Gamelan.hs
+++ b/Music/Theory/Gamelan.hs
@@ -1,3 +1,4 @@
+-- | Gamelan instruments and pitch structures.
 module Music.Theory.Gamelan where
 
 import Data.Char {- base -}
@@ -7,11 +8,12 @@
 import Data.Ratio {- base -}
 import Text.Printf {- base -}
 
+import qualified Music.Theory.Enum as T {- hmt-base -}
+
 import qualified Music.Theory.Clef as T {- hmt -}
-import qualified Music.Theory.Enum as T {- hmt -}
 import qualified Music.Theory.Pitch as T {- hmt -}
 import qualified Music.Theory.Tuning as T {- hmt -}
-import qualified Music.Theory.Tuning.ET as T {- hmt-diagrams -}
+import qualified Music.Theory.Tuning.Et as T {- hmt-diagrams -}
 
 -- | 'fromJust' with error message.
 fromJust_err :: String -> Maybe a -> a
@@ -26,6 +28,7 @@
 -- | Enumeration of gamelan instrument families.
 data Instrument_Family
     = Bonang
+    | Gambang
     | Gender
     | Gong
     | Saron
@@ -39,6 +42,7 @@
 data Instrument_Name
     = Bonang_Barung -- ^ Bonang Barung (horizontal gong, middle)
     | Bonang_Panerus -- ^ Bonang Panerus (horizontal gong, high)
+    | Gambang_Kayu -- ^ Gambang Kayu (wooden key&resonator)
     | Gender_Barung -- ^ Gender Barung (key&resonator, middle)
     | Gender_Panerus -- ^ Gender Panembung (key&resonator, high)
     | Gender_Panembung -- ^ Gender Panembung, Slenthem (key&resonator, low)
@@ -47,29 +51,30 @@
     | Kempul -- ^ Kempul (hanging gong, middle)
     | Kempyang -- ^ Kempyang (horizontal gong, high)
     | Kenong -- ^ Kenong (horizontal gong, low)
-    | Ketuk -- ^ Ketuk (horizontal gong, middle)
+    | Ketuk -- ^ Ketuk, Kethuk (horizontal gong, middle)
     | Saron_Barung -- ^ Saron Barung, Saron (key, middle)
     | Saron_Demung -- ^ Saron Demung, Demung (key, low)
     | Saron_Panerus -- ^ Saron Panerus, Peking (key, high)
       deriving (Enum,Bounded,Eq,Ord,Show,Read)
 
-instrument_family :: Instrument_Name -> Maybe Instrument_Family
+instrument_family :: Instrument_Name -> Instrument_Family
 instrument_family nm =
     case nm of
-      Bonang_Barung -> Just Bonang
-      Bonang_Panerus -> Just Bonang
-      Gender_Barung -> Just Gender
-      Gender_Panerus -> Just Gender
-      Gender_Panembung -> Just Gender
-      Gong_Ageng -> Just Gong
-      Gong_Suwukan -> Just Gong
-      Kempul -> Just Gong
-      Kempyang -> Nothing
-      Kenong -> Nothing
-      Ketuk -> Nothing
-      Saron_Barung -> Just Saron
-      Saron_Demung -> Just Saron
-      Saron_Panerus -> Just Saron
+      Bonang_Barung -> Bonang
+      Bonang_Panerus -> Bonang
+      Gambang_Kayu -> Gambang
+      Gender_Barung -> Gender
+      Gender_Panerus -> Gender
+      Gender_Panembung -> Gender
+      Gong_Ageng -> Gong
+      Gong_Suwukan -> Gong
+      Kempul -> Gong
+      Kempyang -> Gong
+      Kenong -> Gong
+      Ketuk -> Gong
+      Saron_Barung -> Saron
+      Saron_Demung -> Saron
+      Saron_Panerus -> Saron
 
 instrument_name_pp :: Instrument_Name -> String
 instrument_name_pp =
@@ -82,6 +87,7 @@
     case nm of
       Bonang_Barung -> T.Clef T.Treble 0
       Bonang_Panerus -> T.Clef T.Treble 1
+      Gambang_Kayu -> T.Clef T.Treble 0
       Gender_Barung -> T.Clef T.Treble 0
       Gender_Panerus -> T.Clef T.Treble 1
       Gender_Panembung -> T.Clef T.Bass 0
@@ -101,15 +107,26 @@
 -- | Enumeration of Gamelan scales.
 data Scale = Pelog | Slendro deriving (Enum,Eq,Ord,Show,Read)
 
+-- | Octaves are zero-indexed and may be negative.
 type Octave = Integer
+
+-- | Degrees are one-indexed.
 type Degree = Integer
+
+-- | Frequency in hertz.
 type Frequency = Double
+
+-- | A text annotation.
 type Annotation = String
 
+-- | 'Octave' and 'Degree'.
 data Pitch = Pitch {pitch_octave :: Octave
                    ,pitch_degree :: Degree}
              deriving (Eq,Ord,Show)
 
+-- | Octaves are written as repeated @-@ or @+@, degrees are printed ordinarily.
+--
+-- > map pitch_pp_ascii (zipWith Pitch [-2 .. 2] [1 .. 5]) == ["--1","-2","3","+4","++5"]
 pitch_pp_ascii :: Pitch -> String
 pitch_pp_ascii (Pitch o d) =
     let d' = intToDigit (fromIntegral d)
@@ -121,97 +138,121 @@
 pitch_pp_duple :: Pitch -> String
 pitch_pp_duple (Pitch o d) = printf "(%d,%d)" o d
 
+-- | 'Scale' and 'Pitch'.
 data Note = Note {note_scale :: Scale
                  ,note_pitch :: Pitch}
-             deriving (Eq,Ord,Show)
+             deriving (Eq,Show)
 
+-- | 'pitch_degree' of 'note_pitch'.
 note_degree :: Note -> Degree
 note_degree = pitch_degree . note_pitch
 
-data Tone = Tone {tone_instrument_name :: Instrument_Name
-                 ,tone_note :: Maybe Note
-                 ,tone_frequency :: Maybe Frequency
-                 ,tone_annotation :: Maybe Annotation}
-             deriving (Eq,Show)
+-- | It is an error to compare notes from different scales.
+note_compare :: Note -> Note -> Ordering
+note_compare (Note s1 p1) (Note s2 p2) =
+  if s1 /= s2
+  then error "note_compare?"
+  else compare p1 p2
 
-tone_frequency_err :: Tone -> Frequency
+-- | Orderable if scales are equal.
+instance Ord Note where compare = note_compare
+
+-- | Ascending sequence of 'Note' for 'Scale' from /p1/ to /p2/ inclusive.
+note_range_elem :: Scale -> Pitch -> Pitch -> [Note]
+note_range_elem scl p1@(Pitch o1 _d1) p2@(Pitch o2 _d2) =
+  let univ = [Note scl (Pitch o d) | o <- [o1 .. o2], d <- scale_degrees scl]
+  in filter (\n -> note_pitch n >= p1 && note_pitch n <= p2) univ
+
+-- | Ascending sequence of 'Note' from /n1/ to /n2/ inclusive.
+--
+-- > note_gamut_elem (Note Slendro (Pitch 0 5)) (Note Slendro (Pitch 1 2))
+note_gamut_elem :: Note -> Note -> [Note]
+note_gamut_elem (Note s1 p1) (Note s2 p2) =
+  if s1 /= s2
+  then error "note_gamut_elem?"
+  else note_range_elem s1 p1 p2
+
+data Tone t = Tone {tone_instrument_name :: Instrument_Name
+                   ,tone_note :: Maybe Note
+                   ,tone_frequency :: Maybe Frequency
+                   ,tone_annotation :: Maybe t}
+              deriving (Eq,Show)
+
+tone_frequency_err :: Tone t -> Frequency
 tone_frequency_err = fromJust_err "tone_frequency" . tone_frequency
 
 -- | Orderable if frequency is given.
-instance Ord Tone where compare = tone_compare_frequency
+instance Eq t => Ord (Tone t) where compare = tone_compare_frequency
 
 -- | Constructor for 'Tone' without /frequency/ or /annotation/.
-plain_tone :: Instrument_Name -> Scale -> Octave -> Degree -> Tone
+plain_tone :: Instrument_Name -> Scale -> Octave -> Degree -> Tone t
 plain_tone nm sc o d = Tone nm (Just (Note sc (Pitch o d))) Nothing Nothing
 
 -- | Tones are considered /equivalent/ if they have the same
 -- 'Instrument_Name' and 'Note'.
-tone_equivalent :: Tone -> Tone -> Bool
+tone_equivalent :: Tone t -> Tone t -> Bool
 tone_equivalent p q =
     let Tone nm nt _ _ = p
         Tone nm' nt' _ _ = q
     in nm == nm' && nt == nt'
 
-tone_24et_pitch :: Tone -> Maybe T.Pitch
+tone_24et_pitch :: Tone t -> Maybe T.Pitch
 tone_24et_pitch =
-    let f i = let (_,pt,_,_,_) = T.nearest_24et_tone i in pt
+    let f i = let (_,pt,_,_,_) = T.nearest_24et_tone_k0 (69,440) i in pt
     in fmap f . tone_frequency
 
-tone_24et_pitch' :: Tone -> T.Pitch
+tone_24et_pitch' :: Tone t -> T.Pitch
 tone_24et_pitch' = fromJust_err "tone_24et_pitch" . tone_24et_pitch
 
-tone_24et_pitch_detune :: Tone -> Maybe T.Pitch_Detune
-tone_24et_pitch_detune = fmap T.nearest_pitch_detune_24et . tone_frequency
+tone_24et_pitch_detune :: Tone t -> Maybe T.Pitch_Detune
+tone_24et_pitch_detune = fmap (T.nearest_pitch_detune_24et_k0 (69,440)) . tone_frequency
 
-tone_24et_pitch_detune' :: Tone -> T.Pitch_Detune
+tone_24et_pitch_detune' :: Tone t -> T.Pitch_Detune
 tone_24et_pitch_detune' = fromJust_err "tone_24et_pitch_detune" . tone_24et_pitch_detune
 
-tone_fmidi :: Tone -> Double
+tone_fmidi :: Tone t -> Double
 tone_fmidi = T.cps_to_fmidi . tone_frequency_err
 
 -- | Fractional (rational) 24-et midi note number of 'Tone'.
-tone_24et_fmidi :: Tone -> Rational
+tone_24et_fmidi :: Tone t -> Rational
 tone_24et_fmidi = near_rat . T.pitch_to_fmidi . tone_24et_pitch'
 
-tone_12et_pitch :: Tone -> Maybe T.Pitch
+tone_12et_pitch :: Tone t -> Maybe T.Pitch
 tone_12et_pitch =
-    let f i = let (_,pt,_,_,_) = T.nearest_12et_tone i in pt
+    let f i = let (_,pt,_,_,_) = T.nearest_12et_tone_k0 (69,440) i in pt
     in fmap f . tone_frequency
 
-tone_12et_pitch' :: Tone -> T.Pitch
+tone_12et_pitch' :: Tone t -> T.Pitch
 tone_12et_pitch' = fromJust_err "tone_12et_pitch" . tone_12et_pitch
 
-tone_12et_pitch_detune :: Tone -> Maybe T.Pitch_Detune
-tone_12et_pitch_detune = fmap T.nearest_pitch_detune_12et . tone_frequency
+tone_12et_pitch_detune :: Tone t -> Maybe T.Pitch_Detune
+tone_12et_pitch_detune = fmap (T.nearest_pitch_detune_12et_k0 (69,440)) . tone_frequency
 
-tone_12et_pitch_detune' :: Tone -> T.Pitch_Detune
+tone_12et_pitch_detune' :: Tone t -> T.Pitch_Detune
 tone_12et_pitch_detune' = fromJust_err "tone_12et_pitch_detune" . tone_12et_pitch_detune
 
 -- | Fractional (rational) 24-et midi note number of 'Tone'.
-tone_12et_fmidi :: Tone -> Rational
+tone_12et_fmidi :: Tone t -> Rational
 tone_12et_fmidi = near_rat . T.pitch_to_fmidi . tone_12et_pitch'
 
-tone_family :: Tone -> Maybe Instrument_Family
+tone_family :: Tone t -> Instrument_Family
 tone_family = instrument_family . tone_instrument_name
 
-tone_family_err :: Tone -> Instrument_Family
-tone_family_err = fromJust_err "tone_family" . tone_family
-
-tone_in_family :: Instrument_Family -> Tone -> Bool
-tone_in_family c t = tone_family t == Just c
+tone_in_family :: Instrument_Family -> Tone t -> Bool
+tone_in_family c t = tone_family t == c
 
-select_tones :: Instrument_Family -> [Tone] -> [Maybe Tone]
+select_tones :: Instrument_Family -> [Tone t] -> [Maybe (Tone t)]
 select_tones c =
-    let f t = if tone_family t == Just c then Just t else Nothing
+    let f t = if tone_family t == c then Just t else Nothing
     in map f
 
 -- | Specify subset as list of families and scales.
 type Tone_Subset = ([Instrument_Family],[Scale])
 
 -- | Extract subset of 'Tone_Set'.
-tone_subset :: Tone_Subset -> Tone_Set -> Tone_Set
+tone_subset :: Tone_Subset -> Tone_Set t -> Tone_Set t
 tone_subset (fm,sc) =
-    let f t = fromJust_err "tone_subset" (tone_family t) `elem` fm &&
+    let f t = tone_family t `elem` fm &&
               fromJust_err "tone_subset" (tone_scale t) `elem` sc
     in filter f
 
@@ -221,43 +262,43 @@
                              ,instrument_frequencies :: Maybe [Frequency]}
                   deriving (Eq,Show)
 
-type Tone_Set = [Tone]
-type Tone_Group = [Tone_Set]
+type Tone_Set t = [Tone t]
+type Tone_Group t = [Tone_Set t]
 type Gamelan = [Instrument]
 
-tone_scale :: Tone -> Maybe Scale
+tone_scale :: Tone t -> Maybe Scale
 tone_scale = fmap note_scale . tone_note
 
-tone_pitch :: Tone -> Maybe Pitch
+tone_pitch :: Tone t -> Maybe Pitch
 tone_pitch = fmap note_pitch . tone_note
 
-tone_degree :: Tone -> Maybe Degree
+tone_degree :: Tone t -> Maybe Degree
 tone_degree = fmap pitch_degree . tone_pitch
 
-tone_degree' :: Tone -> Degree
+tone_degree' :: Tone t -> Degree
 tone_degree' = fromJust_err "tone_degree" . tone_degree
 
-tone_octave :: Tone -> Maybe Octave
+tone_octave :: Tone t -> Maybe Octave
 tone_octave = fmap pitch_octave . tone_pitch
 
-tone_class :: Tone -> (Instrument_Name,Maybe Scale)
+tone_class :: Tone t -> (Instrument_Name,Maybe Scale)
 tone_class t = (tone_instrument_name t,tone_scale t)
 
 instrument_class :: Instrument -> (Instrument_Name,Maybe Scale)
 instrument_class i = (instrument_name i,instrument_scale i)
 
-tone_class_p :: (Instrument_Name, Scale) -> Tone -> Bool
+tone_class_p :: (Instrument_Name, Scale) -> Tone t -> Bool
 tone_class_p (nm,sc) t =
     tone_instrument_name t == nm &&
     tone_scale t == Just sc
 
-tone_family_class_p :: (Instrument_Family,Scale) -> Tone -> Bool
+tone_family_class_p :: (Instrument_Family,Scale) -> Tone t -> Bool
 tone_family_class_p (fm,sc) t =
-    instrument_family (tone_instrument_name t) == Just fm &&
+    instrument_family (tone_instrument_name t) == fm &&
     tone_scale t == Just sc
 
 -- | Given a 'Tone_Set', find those 'Tone's that are within 'T.Cents' of 'Frequency'.
-tone_set_near_frequency :: Tone_Set -> T.Cents -> Frequency -> Tone_Set
+tone_set_near_frequency :: Tone_Set t -> T.Cents -> Frequency -> Tone_Set t
 tone_set_near_frequency t k n =
     let near i = abs (T.cps_difference_cents i n) <= k
         near_t i = maybe False near (tone_frequency i)
@@ -265,8 +306,8 @@
 
 -- | Compare 'Tone's by frequency.  'Tone's without frequency compare
 -- as if at frequency @0@.
-tone_compare_frequency :: Tone -> Tone -> Ordering
-tone_compare_frequency = compare `on` (maybe 0 id . tone_frequency)
+tone_compare_frequency :: Tone t -> Tone t -> Ordering
+tone_compare_frequency = compare `on` (fromMaybe 0 . tone_frequency)
 
 -- | If all /f/ of /a/ are 'Just' /b/, then 'Just' /[b]/, else
 -- 'Nothing'.
@@ -275,7 +316,7 @@
     let x' = map f x
     in if any isNothing x' then Nothing else Just (catMaybes x')
 
-instrument :: Tone_Set -> Instrument
+instrument :: Tone_Set t -> Instrument
 instrument c =
     let sf = fmap note_scale . tone_note
         pf = fmap note_pitch . tone_note
@@ -289,7 +330,7 @@
          t:_ -> Instrument (tone_instrument_name t) (sf t) p f
          [] -> undefined
 
-instruments :: Tone_Set -> [Instrument]
+instruments :: Tone_Set t -> [Instrument]
 instruments c =
     let c' = sortBy (compare `on` tone_instrument_name) c
         c'' = groupBy ((==) `on` tone_class) c'
@@ -300,26 +341,32 @@
     let f p = (head p,last p)
     in fmap f . instrument_pitches
 
+-- | Pelog has seven degrees, numbered one to seven.
+--   Slendro has five degrees, numbered one to six excluding four.
+--
+-- > map scale_degrees [Pelog,Slendro] == [[1,2,3,4,5,6,7],[1,2,3,5,6]]
 scale_degrees :: Scale -> [Degree]
 scale_degrees s =
     case s of
       Pelog -> [1..7]
       Slendro -> [1,2,3,5,6]
 
+-- | Zero based index of scale degree, or Nothing.
+--
 -- > degree_index Slendro 4 == Nothing
 -- > degree_index Pelog 4 == Just 3
 degree_index :: Scale -> Degree -> Maybe Int
-degree_index s d = findIndex (== d) (scale_degrees s)
+degree_index s d = elemIndex d (scale_degrees s)
 
 -- * Tone set
 
-tone_set_gamut :: Tone_Set -> Maybe (Pitch,Pitch)
+tone_set_gamut :: Tone_Set t -> Maybe (Pitch,Pitch)
 tone_set_gamut g =
     case mapMaybe (fmap note_pitch . tone_note) g of
       [] -> Nothing
       p -> Just (minimum p,maximum p)
 
-tone_set_instrument :: Tone_Set -> (Instrument_Name,Maybe Scale) -> Tone_Set
+tone_set_instrument :: Tone_Set t -> (Instrument_Name,Maybe Scale) -> Tone_Set t
 tone_set_instrument db (i,s) =
     let f t = tone_class t == (i,s)
     in filter f db
diff --git a/Music/Theory/Graph/Deacon_1934.hs b/Music/Theory/Graph/Deacon_1934.hs
--- a/Music/Theory/Graph/Deacon_1934.hs
+++ b/Music/Theory/Graph/Deacon_1934.hs
@@ -6,25 +6,27 @@
 -- Ireland, 64:129—175, 1934.
 module Music.Theory.Graph.Deacon_1934 where
 
+import Data.Bifunctor {- base -}
 import Data.List {- base -}
 
-import qualified Music.Theory.Array.Cell_Ref as T {- hmt -}
+import qualified Music.Theory.Array.Cell_Ref as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
+
 import qualified Music.Theory.Array.Direction as T {- hmt -}
 import qualified Music.Theory.Graph.Dot as T {- hmt -}
-import qualified Music.Theory.Graph.FGL as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Tuple as T {- hmt -}
+import qualified Music.Theory.Graph.Fgl as T {- hmt -}
 
-gen_graph :: Ord v => [T.DOT_ATTR] -> T.GR_PP v e -> [T.EDGE_L v e] -> [String]
-gen_graph opt pp es = T.g_to_udot opt pp (T.g_from_edges_l es)
+gen_graph :: Ord v => [T.Dot_Attr] -> T.Graph_Pp v e -> [T.Edge_Lbl v e] -> [String]
+gen_graph opt pp es = T.fgl_to_udot opt pp (T.g_from_edges_l es)
 
-gen_graph_ul :: Ord v => [T.DOT_ATTR] -> (v -> String) -> [T.EDGE v] -> [String]
-gen_graph_ul opt pp es = T.g_to_udot opt (T.gr_pp_lift_node_f pp) (T.g_from_edges es)
+gen_graph_ul :: Ord v => [T.Dot_Attr] -> (v -> String) -> [T.Edge v] -> [String]
+gen_graph_ul opt pp es = T.fgl_to_udot opt (T.gr_pp_label_v pp) (T.g_from_edges es)
 
-gen_digraph :: Ord v => [T.DOT_ATTR] -> T.GR_PP v e -> [T.EDGE_L v e] -> [String]
-gen_digraph opt pp es = T.g_to_dot T.G_DIGRAPH opt pp Nothing (T.g_from_edges_l es)
+gen_digraph :: Ord v => [T.Dot_Attr] -> T.Graph_Pp v e -> [T.Edge_Lbl v e] -> [String]
+gen_digraph opt pp es = T.fgl_to_dot T.Graph_Digraph opt pp (T.g_from_edges_l es)
 
-type G = (T.GRAPH String,[T.DOT_ATTR],FilePath)
+type G = ([T.Edge String],[T.Dot_Attr],FilePath)
 
 -- * E
 g1 :: G
@@ -66,7 +68,7 @@
 g9 :: G
 g9 =
     let d9' = ("E6",words "U R D LL (03/D6) U R R U L D D LL (11/C6) U R R U U R D L L D D LL (22/B6) U R R U U R R U L D D L L D D LL (38/A6) U R R U U R R U U R D L L D D L L D D LUU (56/A4) R R U U R R U L D D L L D D L UU (71/A3) R R U U R D L L D D L UU (83/A2) R R U L D D L UU (91/A1) R D L")
-        d9 = (fst d9',filter T.is_direction (snd d9'))
+        d9 = second (filter T.is_direction) d9'
         c9 = T.dir_seq_to_cell_seq d9
         o9 = [("node:shape","circle"),("edge:len","1.5"),("edge:fontsize","7")]
     in (T.adj2 1 c9,o9,"F")
@@ -74,7 +76,7 @@
 g10 :: G
 g10 =
     let d10' = ("B7",words "U R LL (03/A6) R R U L D D LUU (10/A5) R R U L D D L UU (18/A4) R R U L D D L UU (26/A3) R R U L D D L UU (34/A2) R R U L D D L UU (41/A1) R D L")
-        d10 = (fst d10',filter T.is_direction (snd d10'))
+        d10 = second (filter T.is_direction) d10'
         c10 = T.dir_seq_to_cell_seq d10
         e10 = T.adj2 1 c10
         o10 = [("node:shape","circle"),("edge:len","1.5"),("edge:fontsize","7")]
@@ -83,7 +85,7 @@
 g11 :: G
 g11 =
     let d11' = ("C3",words "DR DDL UUR U L (05/C3) DL DDR UUL U R (10/C3) D D U UL UUR DDL (16/B3) DL R U (18/B3) L DR R (21/C4) UR UUL DDR DR L (26/D4) U R DL L U (31/C3) U D (33/C3) R UUR DDDDD UUL L . (40/C4) L DDL UUUUU DDR R (44/C3)")
-        d11 = (fst d11',filter T.is_direction (snd d11'))
+        d11 = second (filter T.is_direction) d11'
         c11 = T.dir_seq_to_cell_seq d11
         e11 = T.adj2 1 c11
         o11 = [("node:shape","circle"),("edge:len","1.5"),("edge:fontsize","7")]
@@ -92,7 +94,7 @@
 g12 :: G
 g12 =
     let d12' = ("C2",words "DR UR (02/E2) L DL UL L (06/A2) DR UR UR DR (10/E2) L UL DL L (14/A2) UR DR (16/C2)")
-        d12 = (fst d12',filter T.is_direction (snd d12'))
+        d12 = second (filter T.is_direction) d12'
         c12 = T.dir_seq_to_cell_seq d12
         e12 = T.adj2 1 c12
         o12 = [("node:shape","circle"),("edge:len","1.5"),("edge:fontsize","7")]
@@ -101,7 +103,7 @@
 g13 :: G
 g13 =
     let d13' = ("B3",words "U D D U R DDL UUL R (07/C3) R UU DDL L UU DDR (11/C3)")
-        d13 = (fst d13',filter T.is_direction (snd d13'))
+        d13 = second (filter T.is_direction) d13'
         c13 = T.dir_seq_to_cell_seq d13
         e13 = T.adj2 1 c13
         o13 = [("node:shape","circle"),("edge:len","1.5"),("edge:fontsize","7")]
@@ -118,10 +120,10 @@
   let mk_nm ty = "/home/rohan/sw/hmt/data/dot/deacon/" ++ nm ++ "_" ++ ty ++ ".dot"
       wr_f ty g = writeFile (mk_nm ty) (unlines g)
   wr_f "G" (gen_graph_ul o id e)
-  wr_f "GL" (gen_graph o T.gr_pp_id_show (T.e_label_seq e))
-  wr_f "GC" (gen_graph o T.gr_pp_id_br_csl (T.e_collate_normalised_l (T.e_label_seq e)))
+  wr_f "GL" (gen_graph o (T.gr_pp_label id show) (T.e_label_seq e))
+  wr_f "GC" (gen_graph o (T.gr_pp_label id T.br_csl_pp) (T.e_collate_normalised_l (T.e_label_seq e)))
   wr_f "GF" (gen_graph_ul o id (nub (map T.t2_sort e)))
-  wr_f "GD" (gen_digraph o T.gr_pp_id_br_csl (T.e_collate_normalised_l (T.e_label_seq e)))
+  wr_f "GD" (gen_digraph o (T.gr_pp_label id T.br_csl_pp) (T.e_collate_normalised_l (T.e_label_seq e)))
 {-
   let o' = ("graph:layout","fdp") : o
   wr_f "GC_" (gen_graph o' T.gr_pp_id_br_csl (T.e_collate_normalised_l (T.e_label_seq e)))
diff --git a/Music/Theory/Graph/Dot.hs b/Music/Theory/Graph/Dot.hs
--- a/Music/Theory/Graph/Dot.hs
+++ b/Music/Theory/Graph/Dot.hs
@@ -1,131 +1,213 @@
 -- | Graph (dot) functions.
 module Music.Theory.Graph.Dot where
 
+import Control.Monad {- base -}
 import Data.Char {- base -}
 import Data.List {- base -}
+import System.FilePath {- filepath -}
+import System.Process {- process -}
 
 import qualified Data.Graph.Inductive.Graph as G {- fgl -}
-import qualified Data.Graph.Inductive.PatriciaTree as G {- fgl -}
 
-import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+import qualified Music.Theory.List as List {- hmt-base -}
+import qualified Music.Theory.Show as Show {- hmt-base -}
 
--- * UTIL
+import qualified Music.Theory.Graph.Fgl as T {- hmt -}
 
--- | Separate at element.
+-- * Util
+
+-- | Classify /s/ using a first element predicate, a remainder predicate and a unit predicate.
+s_classify :: (t -> Bool) -> (t -> Bool) -> ([t] -> Bool) -> [t] -> Bool
+s_classify p q r s =
+  case s of
+    c0:s' -> p c0 && all q s' && r s
+    [] -> False
+
+-- | Symbol rule.
 --
--- > sep1 ':' "graph:layout"
-sep1 :: Eq t => t -> [t] -> ([t],[t])
-sep1 e l =
-    case break (== e) l of
-      (p,_:q) -> (p,q)
-      _ -> error "sep1"
+-- > map is_symbol ["sym","Sym2","3sym","1",""] == [True,True,False,False,False]
+is_symbol :: String -> Bool
+is_symbol = s_classify isAlpha isAlphaNum (const True)
 
--- | Quote /s/ if it includes white space.
+-- | Number rule.
 --
--- > map maybe_quote ["abc","a b c"] == ["abc","\"a b c\""]
+-- > map is_number ["123","123.45",".25","1.","1.2.3",""] == [True,True,False,True,False,False]
+is_number :: String -> Bool
+is_number = s_classify isDigit (\c -> isDigit c || c == '.') ((< 2) . length . filter ('.' ==))
+
+-- | Quote /s/ if 'is_symbol' or 'is_number'.
+--
+-- > map maybe_quote ["abc","a b c","12","12.3"] == ["abc","\"a b c\"","12","12.3"]
 maybe_quote :: String -> String
-maybe_quote s = if any isSpace s then concat ["\"",s,"\""] else s
+maybe_quote s = if is_symbol s || is_number s then s else concat ["\"",s,"\""]
 
--- | Left biased union of association lists /p/ and /q/.
+-- * Attr/Key
+
+type Dot_Key = String
+type Dot_Value = String
+type Dot_Attr = (Dot_Key,Dot_Value)
+
+-- | Format 'Dot_Attr'.
+dot_attr_pp :: Dot_Attr -> String
+dot_attr_pp (lhs,rhs) = concat [lhs,"=",maybe_quote rhs]
+
+-- | Format sequence of Dot_Attr.
 --
--- > assoc_union [(5,"a"),(3,"b")] [(5,"A"),(7,"C")] == [(5,"a"),(3,"b"),(7,"C")]
-assoc_union :: Eq k => [(k,v)] -> [(k,v)] -> [(k,v)]
-assoc_union p q =
-    let p_k = map fst p
-        q' = filter ((`notElem` p_k) . fst) q
-    in p ++ q'
+-- > dot_attr_seq_pp [("layout","neato"),("epsilon","0.0001")]
+dot_attr_seq_pp :: [Dot_Attr] -> String
+dot_attr_seq_pp opt =
+  if null opt
+  then ""
+  else concat ["[",intercalate "," (map dot_attr_pp opt),"]"]
 
--- * ATTR
+-- | Merge attributes, left-biased.
+dot_attr_ext :: [Dot_Attr] -> [Dot_Attr] -> [Dot_Attr]
+dot_attr_ext = List.assoc_merge
 
--- | area:opt (area = graph|node|edge)
-type DOT_KEY = String
-type DOT_OPT = String
-type DOT_VALUE = String
-type DOT_ATTR = (DOT_OPT,DOT_VALUE)
-type DOT_ATTR_SET = (String,[DOT_ATTR])
+-- | graph|node|edge
+type Dot_Type = String
 
--- > dot_key_sep "graph:layout"
-dot_key_sep :: String -> (String,String)
-dot_key_sep = sep1 ':'
+-- | (type,[attr])
+type Dot_Attr_Set = (Dot_Type,[Dot_Attr])
 
-dot_attr_pp :: DOT_ATTR -> String
-dot_attr_pp (lhs,rhs) = concat [lhs,"=",maybe_quote rhs]
+-- | Format Dot_Attr_Set.
+--
+-- > a = ("graph",[("layout","neato"),("epsilon","0.0001")])
+-- > dot_attr_set_pp a == "graph [layout=neato,epsilon=0.0001]"
+dot_attr_set_pp :: Dot_Attr_Set -> String
+dot_attr_set_pp (ty,opt) = concat [ty," ",dot_attr_seq_pp opt]
 
-dot_attr_set_pp :: DOT_ATTR_SET -> String
-dot_attr_set_pp (ty,opt) = concat [ty," [",intercalate "," (map dot_attr_pp opt),"];"]
+-- | type:attr (type = graph|node|edge)
+type Dot_Meta_Key = String
 
-dot_attr_collate :: [DOT_ATTR] -> [DOT_ATTR_SET]
+type Dot_Meta_Attr = (Dot_Meta_Key,Dot_Value)
+
+-- | Keys are given as "type:attr".
+--
+-- > dot_key_sep "graph:layout" == ("graph","layout")
+dot_key_sep :: Dot_Meta_Key -> (Dot_Type,Dot_Key)
+dot_key_sep = List.split_on_1_err ":"
+
+-- | Collate Dot_Key attribute set to Dot_Attr_Set.
+dot_attr_collate :: [Dot_Meta_Attr] -> [Dot_Attr_Set]
 dot_attr_collate opt =
     let f (k,v) = let (ty,nm) = dot_key_sep k in (ty,(nm,v))
         c = map f opt
-    in T.collate c
+    in List.collate c
 
-dot_attr_ext :: [DOT_ATTR] -> [DOT_ATTR] -> [DOT_ATTR]
-dot_attr_ext = assoc_union
+-- | Default values for default meta-keys.
+--
+-- > k = dot_attr_def ("neato","century schoolbook",10,"plaintext")
+-- > map dot_attr_set_pp (dot_attr_collate k)
+dot_attr_def :: (String,String,Double,String) -> [Dot_Meta_Attr]
+dot_attr_def (ly,fn,fs,sh) =
+    [("graph:layout",ly)
+    ,("node:fontname",fn)
+    ,("node:fontsize",show fs)
+    ,("node:shape",sh)]
 
--- > map dot_attr_set_pp (dot_attr_collate dot_attr_def)
-dot_attr_def :: [DOT_ATTR]
-dot_attr_def =
-    [("graph:layout","neato")
-    ,("graph:epsilon","0.000001")
-    ,("node:shape","plaintext")
-    ,("node:fontsize","10")
-    ,("node:fontname","century schoolbook")]
+-- * Graph
 
--- * GRAPH
+-- | Graph pretty-printer, (v -> [attr],e -> [attr])
+type Graph_Pp v e = ((Int,v) -> [Dot_Attr],((Int,Int),e) -> [Dot_Attr])
 
--- | Graph pretty-printer, (node->shape,node->label,edge->label)
-type GR_PP v e = (v -> Maybe String,v -> Maybe String,e -> Maybe String)
+-- | Make Graph_Pp value given label functions for vertices and edges.
+gr_pp_label_m :: Maybe (v -> Dot_Value) -> Maybe (e -> Dot_Value) -> Graph_Pp v e
+gr_pp_label_m f_v f_e =
+  let lift m (_,x) = case m of
+                       Nothing -> []
+                       Just f -> [("label",f x)]
+  in (lift f_v,lift f_e)
 
-gr_pp_lift_node_f :: (v -> String) -> GR_PP v e
-gr_pp_lift_node_f f = (const Nothing, Just . f, const Nothing)
+-- | Label V & E.
+gr_pp_label :: (v -> Dot_Value) -> (e -> Dot_Value) -> Graph_Pp v e
+gr_pp_label f_v f_e = gr_pp_label_m (Just f_v) (Just f_e)
 
-gr_pp_id_show :: Show e => GR_PP String e
-gr_pp_id_show = (const Nothing,Just . id,Just . show)
+-- | Label V only.
+gr_pp_label_v :: (v -> Dot_Value) -> Graph_Pp v e
+gr_pp_label_v f = gr_pp_label_m (Just f) Nothing
 
 -- | br = brace, csl = comma separated list
 br_csl_pp :: Show t => [t] -> String
 br_csl_pp l =
     case l of
       [e] -> show e
-      _ -> T.bracket ('{','}') (intercalate "," (map show l))
-
-gr_pp_id_br_csl :: Show e => GR_PP String [e]
-gr_pp_id_br_csl = (const Nothing,Just . id,Just . br_csl_pp)
+      _ -> List.bracket ('{','}') (intercalate "," (map show l))
 
 -- | Graph type, directed or un-directed.
-data G_TYPE = G_DIGRAPH | G_UGRAPH
+data Graph_Type = Graph_Digraph | Graph_Ugraph
 
-g_type_to_string :: G_TYPE -> String
+g_type_to_string :: Graph_Type -> String
 g_type_to_string ty =
     case ty of
-      G_DIGRAPH -> "digraph"
-      G_UGRAPH -> "graph"
+      Graph_Digraph -> "digraph"
+      Graph_Ugraph -> "graph"
 
-g_type_to_edge_symbol :: G_TYPE -> String
+g_type_to_edge_symbol :: Graph_Type -> String
 g_type_to_edge_symbol ty =
     case ty of
-      G_DIGRAPH -> " -> "
-      G_UGRAPH -> " -- "
+      Graph_Digraph -> " -> "
+      Graph_Ugraph -> " -- "
 
+-- | Generate node position attribute given (x,y) coordinate.
+node_pos_attr :: (Show n, Real n) => (n,n) -> Dot_Attr
+node_pos_attr (x,y) = let pp = Show.real_pp_trunc 2 in ("pos",concat [pp x,",",pp y])
+
+-- | Edge POS attributes are sets of cubic bezier control points.
+edge_pos_attr :: Real t => [(t,t)] -> Dot_Attr
+edge_pos_attr pt =
+  let r_pp = Show.real_pp_trunc 2
+      pt_pp (x,y) = concat [r_pp x,",",r_pp y]
+  in ("pos",unwords (map pt_pp pt))
+
+-- | Variant that accepts single cubic bezier data set.
+edge_pos_attr_1 :: Real t => ((t,t),(t,t),(t,t),(t,t)) -> Dot_Attr
+edge_pos_attr_1 (p1,p2,p3,p4) = edge_pos_attr [p1,p2,p3,p4]
+
+{-
 -- | Vertex position function.
 type POS_FN v = (v -> (Int,Int))
 
-g_to_dot :: G_TYPE -> [DOT_ATTR] -> GR_PP v e -> Maybe (POS_FN v) -> G.Gr v e -> [String]
-g_to_dot g_typ opt (n_sh,n_pp,e_pp) pos_f gr =
-    let p_f (c,r) = concat [",pos=\"",show (c * 100),",",show (r * 100),"\""]
-        l_f p x = concat [" [label=\"",x,"\"",p,"]"]
-        n_f (k,n) = let p = maybe "" (\f -> p_f (f n)) pos_f
-                        p' = maybe p (\z -> p ++ ",shape=\"" ++ z ++ "\"") (n_sh n)
-                        a = maybe "" (l_f p') (n_pp n)
-                    in concat [show k,a,";"]
-        e_f (lhs,rhs,e) = let l = maybe "" (l_f "") (e_pp e)
-                          in concat [show lhs,g_type_to_edge_symbol g_typ,show rhs,l,";"]
+g_lift_pos_fn :: (v -> (Int,Int)) -> v -> [Dot_Attr]
+g_lift_pos_fn f v = let (c,r) = f v in [node_pos_attr (c * 100,r * 100)]
+-}
+
+lbl_to_dot :: Graph_Type -> [Dot_Meta_Attr] -> Graph_Pp v e -> T.Lbl v e -> [String]
+lbl_to_dot g_typ opt (v_attr,e_attr) (v,e) =
+    let ws s = if null s then "" else " " ++ s
+        v_f (k,lbl) = concat [show k,ws (dot_attr_seq_pp (v_attr (k,lbl))),";"]
+        e_f ((lhs,rhs),lbl) = concat [show lhs,g_type_to_edge_symbol g_typ,show rhs
+                                     ,ws (dot_attr_seq_pp (e_attr ((lhs,rhs),lbl))),";"]
     in concat [[g_type_to_string g_typ," g {"]
-              ,map dot_attr_set_pp (dot_attr_collate (assoc_union opt dot_attr_def))
-              ,map n_f (G.labNodes gr)
-              ,map e_f (G.labEdges gr)
+              ,map dot_attr_set_pp (dot_attr_collate opt)
+              ,map v_f v
+              ,map e_f e
               ,["}"]]
 
-g_to_udot :: [DOT_ATTR] -> GR_PP v e -> G.Gr v e -> [String]
-g_to_udot o pp = g_to_dot G_UGRAPH o pp Nothing
+lbl_to_udot :: [Dot_Meta_Attr] -> Graph_Pp v e -> T.Lbl v e -> [String]
+lbl_to_udot = lbl_to_dot Graph_Ugraph
+
+-- | 'writeFile' of 'lbl_to_udot'
+lbl_to_udot_wr :: FilePath -> [Dot_Meta_Attr] -> Graph_Pp v e -> T.Lbl v e -> IO ()
+lbl_to_udot_wr fn o pp  = writeFile fn . unlines . lbl_to_udot o pp
+
+fgl_to_dot :: G.Graph gr => Graph_Type -> [Dot_Meta_Attr] -> Graph_Pp v e -> gr v e -> [String]
+fgl_to_dot typ opt pp gr = lbl_to_dot typ opt pp (T.fgl_to_lbl gr)
+
+fgl_to_udot :: G.Graph gr => [Dot_Meta_Attr] -> Graph_Pp v e -> gr v e -> [String]
+fgl_to_udot opt pp gr = lbl_to_udot opt pp (T.fgl_to_lbl gr)
+
+-- * Dot-Process
+
+{- | Run /dot/ to generate a file type based on the output file extension (ie. .svg, .png, .jpeg, .gif)
+     /-n/ must be given to not run the layout algorithm and to use position data in the /dot/ file.
+-}
+dot_to_ext :: [String] -> FilePath -> FilePath -> IO ()
+dot_to_ext opt dot_fn ext_fn =
+  let arg = opt ++ ["-T",tail (takeExtension ext_fn),"-o",ext_fn,dot_fn]
+  in void (rawSystem "dot" arg)
+
+-- | 'dot_to_ext' generating .svg filename by replacing .dot extension with .svg
+dot_to_svg :: [String] -> FilePath -> IO ()
+dot_to_svg opt dot_fn = dot_to_ext opt dot_fn (replaceExtension dot_fn "svg")
diff --git a/Music/Theory/Graph/FGL.hs b/Music/Theory/Graph/FGL.hs
deleted file mode 100644
--- a/Music/Theory/Graph/FGL.hs
+++ /dev/null
@@ -1,141 +0,0 @@
--- | Graph (fgl) functions.
-module Music.Theory.Graph.FGL where
-
-import Data.List {- base -}
-import Data.Maybe {- base -}
-
-import qualified Data.Map as M {- containers -}
-
-import qualified Data.Graph.Inductive.Graph as G {- fgl -}
-import qualified Data.Graph.Inductive.Query as G {- fgl -}
-import qualified Data.Graph.Inductive.PatriciaTree as G {- fgl -}
-
-import qualified Control.Monad.Logic as L {- logict -}
-
-import qualified Music.Theory.List as T {- hmt -}
-
--- | Synonym for 'G.noNodes'.
-g_degree :: G.Gr v e -> Int
-g_degree = G.noNodes
-
--- | 'G.subgraph' of each of 'G.components'.
-g_partition :: G.Gr v e -> [G.Gr v e]
-g_partition gr = map (\n -> G.subgraph n gr) (G.components gr)
-
--- | Find first 'G.Node' with given label.
-g_node_lookup :: (Eq v,G.Graph gr) => gr v e -> v -> Maybe G.Node
-g_node_lookup gr l = fmap fst (find ((== l) . snd) (G.labNodes gr))
-
--- | Erroring variant.
-g_node_lookup_err :: (Eq v,G.Graph gr) => gr v e -> v -> G.Node
-g_node_lookup_err gr = fromMaybe (error "g_node_lookup") . g_node_lookup gr
-
--- | Set of nodes with given labels, plus all neighbours of these nodes.
--- (impl = implications)
-ug_node_set_impl :: (Eq v,G.DynGraph gr) => gr v e -> [v] -> [G.Node]
-ug_node_set_impl gr nl =
-    let n = map (g_node_lookup_err gr) nl
-    in nub (sort (n ++ concatMap (G.neighbors gr) n))
-
--- * Hamiltonian
-
-type G_NODE_SEL_F v e = G.Gr v e -> G.Node -> [G.Node]
-
--- | 'L.msum' '.' 'map' 'return'.
-ml_from_list :: L.MonadLogic m => [t] -> m t
-ml_from_list = L.msum . map return
-
--- | Use /sel_f/ of 'G.pre' for directed graphs and 'G.neighbors' for undirected.
-g_hamiltonian_path_ml :: L.MonadLogic m => G_NODE_SEL_F v e -> G.Gr v e -> G.Node -> m [G.Node]
-g_hamiltonian_path_ml sel_f gr =
-    let n_deg = g_degree gr
-        recur r c =
-            if length r == n_deg - 1
-            then return (c:r)
-            else do i <- ml_from_list (sel_f gr c)
-                    L.guard (i `notElem` r)
-                    recur (c:r) i
-    in recur []
-
--- > map (L.observeAll . ug_hamiltonian_path_ml_0) (g_partition gr)
-ug_hamiltonian_path_ml_0 :: L.MonadLogic m => G.Gr v e -> m [G.Node]
-ug_hamiltonian_path_ml_0 gr = g_hamiltonian_path_ml G.neighbors gr (G.nodes gr !! 0)
-
--- * G (from edges)
-
--- | Edge, no label.
-type EDGE v = (v,v)
-
--- | Graph as set of edges.
-type GRAPH v = [EDGE v]
-
--- | Edge, with label.
-type EDGE_L v l = (EDGE v,l)
-
--- | Graph as set of labeled edges.
-type GRAPH_L v l = [EDGE_L v l]
-
--- | Generate a graph given a set of labelled edges.
-g_from_edges_l :: (Eq v,Ord v) => GRAPH_L v e -> G.Gr v e
-g_from_edges_l e =
-    let n = nub (concatMap (\((lhs,rhs),_) -> [lhs,rhs]) e)
-        n_deg = length n
-        n_id = [0 .. n_deg - 1]
-        m = M.fromList (zip n n_id)
-        m_get k = M.findWithDefault (error "g_from_edges: m_get") k m
-        e' = map (\((lhs,rhs),label) -> (m_get lhs,m_get rhs,label)) e
-    in G.mkGraph (zip n_id n) e'
-
--- | Variant that supplies '()' as the (constant) edge label.
---
--- > let g = G.mkGraph [(0,'a'),(1,'b'),(2,'c')] [(0,1,()),(1,2,())]
--- > in g_from_edges_ul [('a','b'),('b','c')] == g
-g_from_edges :: Ord v => GRAPH v -> G.Gr v ()
-g_from_edges = let f e = (e,()) in g_from_edges_l . map f
-
--- * Edges
-
--- | Label sequence of edges starting at one.
-e_label_seq :: [EDGE v] -> [EDGE_L v Int]
-e_label_seq = map (\(k,e) -> (e,k)) . zip [1..]
-
--- | Normalised undirected labeled edge (ie. order nodes).
-e_normalise_l :: Ord v => EDGE_L v l -> EDGE_L v l
-e_normalise_l ((p,q),r) = ((min p q,max p q),r)
-
--- | Collate labels for edges that are otherwise equal.
-e_collate_l :: Ord v => [EDGE_L v l] -> [EDGE_L v [l]]
-e_collate_l = T.collate
-
--- | 'e_collate_l' of 'e_normalise_l'.
-e_collate_normalised_l :: Ord v => [EDGE_L v l] -> [EDGE_L v [l]]
-e_collate_normalised_l = e_collate_l . map e_normalise_l
-
--- | Apply predicate to universe of possible edges.
-e_univ_select_edges :: (t -> t -> Bool) -> [t] -> [EDGE t]
-e_univ_select_edges f l = [(p,q) | p <- l, q <- l, f p q]
-
--- | Consider only edges (p,q) where p < q.
-e_univ_select_u_edges :: Ord t => (t -> t -> Bool) -> [t] -> [EDGE t]
-e_univ_select_u_edges f = let g p q = p < q && f p q in e_univ_select_edges g
-
--- | Sequence of connected vertices to edges.
---
--- > e_path_to_edges "abcd" == [('a','b'),('b','c'),('c','d')]
-e_path_to_edges :: [t] -> [EDGE t]
-e_path_to_edges = T.adj2 1
-
--- | Undirected edge equality.
-e_undirected_eq :: Eq t => EDGE t -> EDGE t -> Bool
-e_undirected_eq (a,b) (c,d) = (a == c && b == d) || (a == d && b == c)
-
-elem_by :: (p -> q -> Bool) -> p -> [q] -> Bool
-elem_by f = any . f
-
--- | Is the sequence of vertices a path at the graph, ie. are all
--- adjacencies in the sequence edges.
-e_is_path :: Eq t => GRAPH t -> [t] -> Bool
-e_is_path e sq =
-    case sq of
-      p:q:sq' -> elem_by e_undirected_eq (p,q) e && e_is_path e (q:sq')
-      _ -> True
diff --git a/Music/Theory/Graph/Fgl.hs b/Music/Theory/Graph/Fgl.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/Fgl.hs
@@ -0,0 +1,175 @@
+-- | Graph (fgl) functions.
+module Music.Theory.Graph.Fgl where
+
+import Control.Monad {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Data.Map as M {- containers -}
+
+import qualified Data.Graph.Inductive.Graph as G {- fgl -}
+import qualified Data.Graph.Inductive.Query as G {- fgl -}
+import qualified Data.Graph.Inductive.PatriciaTree as G {- fgl -}
+
+import qualified Control.Monad.Logic as L {- logict -}
+
+import qualified Music.Theory.Graph.Type as T {- hmt -}
+import qualified Music.Theory.List as T {- hmt -}
+
+-- | 'T.Lbl' to FGL graph
+lbl_to_fgl :: G.Graph gr => T.Lbl v e -> gr v e
+lbl_to_fgl (v,e) = let f ((i,j),k) = (i,j,k) in G.mkGraph v (map f e)
+
+-- | Type-specialised.
+lbl_to_fgl_gr :: T.Lbl v e -> G.Gr v e
+lbl_to_fgl_gr = lbl_to_fgl
+
+-- | FGL graph to 'T.Lbl'
+fgl_to_lbl :: G.Graph gr => gr v e -> T.Lbl v e
+fgl_to_lbl gr = (G.labNodes gr,map (\(i,j,k) -> ((i,j),k)) (G.labEdges gr))
+
+-- | Synonym for 'G.noNodes'.
+g_degree :: G.Gr v e -> Int
+g_degree = G.noNodes
+
+-- | 'G.subgraph' of each of 'G.components'.
+g_partition :: G.Gr v e -> [G.Gr v e]
+g_partition gr = map (`G.subgraph` gr) (G.components gr)
+
+-- | Find first 'G.Node' with given label.
+g_node_lookup :: (Eq v,G.Graph gr) => gr v e -> v -> Maybe G.Node
+g_node_lookup gr l = fmap fst (find ((== l) . snd) (G.labNodes gr))
+
+-- | Erroring variant.
+g_node_lookup_err :: (Eq v,G.Graph gr) => gr v e -> v -> G.Node
+g_node_lookup_err gr = fromMaybe (error "g_node_lookup") . g_node_lookup gr
+
+-- | Set of nodes with given labels, plus all neighbours of these nodes.
+-- (impl = implications)
+ug_node_set_impl :: (Eq v,G.DynGraph gr) => gr v e -> [v] -> [G.Node]
+ug_node_set_impl gr nl =
+    let n = map (g_node_lookup_err gr) nl
+    in nub (sort (n ++ concatMap (G.neighbors gr) n))
+
+-- * Hamiltonian
+
+-- | Node select function, ie. given a graph /g/ and a node /n/ select a set of related nodes from /g/
+type G_Node_Sel_f v e = G.Gr v e -> G.Node -> [G.Node]
+
+-- | 'msum' '.' 'map' 'return'.
+ml_from_list :: MonadPlus m => [t] -> m t
+ml_from_list = msum . map return
+
+-- | Use /sel_f/ of 'G.pre' for directed graphs and 'G.neighbors' for undirected.
+g_hamiltonian_path_ml :: (MonadPlus m, L.MonadLogic m) => G_Node_Sel_f v e -> G.Gr v e -> G.Node -> m [G.Node]
+g_hamiltonian_path_ml sel_f gr =
+    let n_deg = g_degree gr
+        recur r c =
+            if length r == n_deg - 1
+            then return (c:r)
+            else do i <- ml_from_list (sel_f gr c)
+                    guard (i `notElem` r)
+                    recur (c:r) i
+    in recur []
+
+-- | 'g_hamiltonian_path_ml' of 'G.neighbors' starting at first node.
+--
+-- > map (L.observeAll . ug_hamiltonian_path_ml_0) (g_partition gr)
+ug_hamiltonian_path_ml_0 :: (MonadPlus m, L.MonadLogic m) => G.Gr v e -> m [G.Node]
+ug_hamiltonian_path_ml_0 gr = g_hamiltonian_path_ml G.neighbors gr (G.nodes gr !! 0)
+
+-- * G (from edges)
+
+-- | Edge, no label.
+type Edge v = (v,v)
+
+-- | Edge, with label.
+type Edge_Lbl v l = (Edge v,l)
+
+-- | Generate a graph given a set of labelled edges.
+g_from_edges_l :: (Eq v,Ord v) => [Edge_Lbl v e] -> G.Gr v e
+g_from_edges_l e =
+    let n = nub (concatMap (\((lhs,rhs),_) -> [lhs,rhs]) e)
+        n_deg = length n
+        n_id = [0 .. n_deg - 1]
+        m = M.fromList (zip n n_id)
+        m_get k = M.findWithDefault (error "g_from_edges: m_get") k m
+        e' = map (\((lhs,rhs),label) -> (m_get lhs,m_get rhs,label)) e
+    in G.mkGraph (zip n_id n) e'
+
+-- | Variant that supplies '()' as the (constant) edge label.
+--
+-- > let g = G.mkGraph [(0,'a'),(1,'b'),(2,'c')] [(0,1,()),(1,2,())]
+-- > in g_from_edges_ul [('a','b'),('b','c')] == g
+g_from_edges :: Ord v => [Edge v] -> G.Gr v ()
+g_from_edges = let f e = (e,()) in g_from_edges_l . map f
+
+-- * Edges
+
+-- | Label sequence of edges starting at one.
+e_label_seq :: [Edge v] -> [Edge_Lbl v Int]
+e_label_seq = zipWith (\k e -> (e,k)) [1..]
+
+-- | Normalised undirected labeled edge (ie. order nodes).
+e_normalise_l :: Ord v => Edge_Lbl v l -> Edge_Lbl v l
+e_normalise_l ((p,q),r) = ((min p q,max p q),r)
+
+-- | Collate labels for edges that are otherwise equal.
+e_collate_l :: Ord v => [Edge_Lbl v l] -> [Edge_Lbl v [l]]
+e_collate_l = T.collate
+
+-- | 'e_collate_l' of 'e_normalise_l'.
+e_collate_normalised_l :: Ord v => [Edge_Lbl v l] -> [Edge_Lbl v [l]]
+e_collate_normalised_l = e_collate_l . map e_normalise_l
+
+-- | Apply predicate to universe of possible edges.
+e_univ_select_edges :: (t -> t -> Bool) -> [t] -> [Edge t]
+e_univ_select_edges f l = [(p,q) | p <- l, q <- l, f p q]
+
+-- | Consider only edges (p,q) where p < q.
+e_univ_select_u_edges :: Ord t => (t -> t -> Bool) -> [t] -> [Edge t]
+e_univ_select_u_edges f = let g p q = p < q && f p q in e_univ_select_edges g
+
+-- | Sequence of connected vertices to edges.
+--
+-- > e_path_to_edges "abcd" == [('a','b'),('b','c'),('c','d')]
+e_path_to_edges :: [t] -> [Edge t]
+e_path_to_edges = T.adj2 1
+
+-- | Undirected edge equality.
+e_undirected_eq :: Eq t => Edge t -> Edge t -> Bool
+e_undirected_eq (a,b) (c,d) = (a == c && b == d) || (a == d && b == c)
+
+-- | /any/ of /f/.
+elem_by :: (p -> q -> Bool) -> p -> [q] -> Bool
+elem_by f = any . f
+
+-- | Is the sequence of vertices a path at the graph, ie. are all
+-- adjacencies in the sequence edges.
+e_is_path :: Eq t => [Edge t] -> [t] -> Bool
+e_is_path e sq =
+    case sq of
+      p:q:sq' -> elem_by e_undirected_eq (p,q) e && e_is_path e (q:sq')
+      _ -> True
+
+-- * Analysis
+
+-- | <https://github.com/ivan-m/Graphalyze/blob/master/Data/Graph/Analysis/Algorithms/Common.hs>
+--   Graphalyze has pandoc as a dependency...
+pathTree             :: (G.DynGraph g) => G.Decomp g a b -> [[G.Node]]
+pathTree (Nothing,_) = []
+pathTree (Just ct,g)
+    | G.isEmpty g = []
+    | null sucs = [[n]]
+    | otherwise = (:) [n] . map (n:) . concatMap (subPathTree g') $ sucs
+    where
+      n = G.node' ct
+      sucs = G.suc' ct
+      ct' = makeLeaf ct
+      g' = ct' G.& g
+      subPathTree gr n' = pathTree $ G.match n' gr
+
+-- | Remove all outgoing edges
+makeLeaf           :: G.Context a b -> G.Context a b
+makeLeaf (p,n,a,_) = (p', n, a, [])
+    where p' = filter (\(_,n') -> n' /= n) p
diff --git a/Music/Theory/Graph/Johnson_2014.hs b/Music/Theory/Graph/Johnson_2014.hs
--- a/Music/Theory/Graph/Johnson_2014.hs
+++ b/Music/Theory/Graph/Johnson_2014.hs
@@ -2,26 +2,34 @@
 module Music.Theory.Graph.Johnson_2014 where
 
 import Control.Monad {- base -}
+import Data.Int {- base -}
 import Data.List {- base -}
-import qualified Data.Map as M {- containers -}
 import Data.Maybe {- base -}
 
-import qualified Music.Theory.Combinations as T {- hmt -}
+import qualified Control.Monad.Logic as L {- logict -}
+import qualified Data.Map as M {- containers -}
+import qualified Data.Graph.Inductive as G {- fgl -}
+--import qualified Data.Graph.Inductive.PatriciaTree as G {- fgl -}
+
+import qualified Music.Theory.Combinations as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
+
 import qualified Music.Theory.Graph.Dot as T {- hmt -}
-import qualified Music.Theory.Graph.FGL as T {- hmt -}
+import qualified Music.Theory.Graph.Fgl as T {- hmt -}
 import qualified Music.Theory.Key as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
 import qualified Music.Theory.Pitch.Note as T {- hmt -}
+import qualified Music.Theory.Set.List as T {- hmt -}
 import qualified Music.Theory.Tuning as T {- hmt -}
-import qualified Music.Theory.Tuning.Euler as T {- hmt -}
-import qualified Music.Theory.Z.SRO as T {- hmt -}
+import qualified Music.Theory.Tuning.Graph.Euler as T {- hmt -}
+import qualified Music.Theory.Z as T {- hmt -}
+import qualified Music.Theory.Z.Forte_1973 as T {- hmt -}
+import qualified Music.Theory.Z.Tto as T {- hmt -}
+import qualified Music.Theory.Z.Sro as T {- hmt -}
 
 -- * Common
 
-type Z12 = Int
-
-mod12 :: Integral a => a -> a
-mod12 n = n `mod` 12
+type Z12 = Int8
 
 dif :: Num a => (a, a) -> a
 dif = uncurry (-)
@@ -67,7 +75,7 @@
 -- > min_vl [6,11,13] [6,10,14] == 2
 min_vl :: (Num a,Ord a) => [a] -> [a] -> a
 min_vl p q =
-    let f x = sum (map absdif (zip p x))
+    let f x = sum (zipWith (curry absdif) p x)
     in minimum (map f (permutations q))
 
 min_vl_of :: (Num a, Ord a) => a -> [a] -> [a] -> Bool
@@ -82,6 +90,12 @@
 set_pp :: Show t => [t] -> String
 set_pp = intercalate "," . map show
 
+tto_rel_to :: Integral t => T.Z t -> [t] -> [t] -> [T.Tto t]
+tto_rel_to z p q = T.z_tto_rel 5 z (T.set p) (T.set q)
+
+set_pp_tto_rel :: (Integral t, Show t) => T.Z t -> [t] -> [t] -> String
+set_pp_tto_rel z p = intercalate "," . map T.tto_pp . tto_rel_to z p
+
 -- * Map
 
 m_get :: Ord k => M.Map k v -> k -> v
@@ -91,20 +105,78 @@
 m_doi_of :: M.Map Int [Z12] -> Int -> Int -> Int -> Bool
 m_doi_of m n p q = doi_of n (m_get m p) (m_get m q)
 
+-- * Edge
+
+-- | Add /k/ as prefix to both left and right hand sides of edge.
+e_add_id :: k -> [(t,u)] -> [((k,t),(k,u))]
+e_add_id k = map (\(lhs,rhs) -> ((k,lhs),(k,rhs)))
+
+gen_edges :: (t -> t -> Bool) -> [t] -> [(t,t)]
+gen_edges f l = [(p,q) | p <- l, q <- l, f p q]
+
+gen_u_edges :: Ord a => (a -> a -> Bool) -> [a] -> [(a, a)]
+gen_u_edges = T.e_univ_select_u_edges
+
 -- * Graph
 
-gen_graph_ul :: Ord v => [T.DOT_ATTR] -> (v -> String) -> [T.EDGE v] -> [String]
-gen_graph_ul opt pp es = T.g_to_udot opt (T.gr_pp_lift_node_f pp) (T.g_from_edges es)
+oh_def_opt :: [T.Dot_Meta_Attr]
+oh_def_opt =
+  [("graph:layout","neato")
+  ,("graph:epsilon","0.000001")
+  ,("node:shape","plaintext")
+  ,("node:fontsize","10")
+  ,("node:fontname","century schoolbook")]
 
-gen_graph_ul_ty :: Ord v => String -> (v -> String) -> [T.EDGE v] -> [String]
+gen_graph :: Ord v => [T.Dot_Meta_Attr] -> T.Graph_Pp v e -> [T.Edge_Lbl v e] -> [String]
+gen_graph opt pp es = T.fgl_to_udot (oh_def_opt ++ opt) pp (T.g_from_edges_l es)
+
+gen_graph_ul :: Ord v => [T.Dot_Meta_Attr] -> (v -> String) -> [T.Edge v] -> [String]
+gen_graph_ul opt pp es = T.fgl_to_udot (oh_def_opt ++ opt) (T.gr_pp_label_v pp) (T.g_from_edges es)
+
+gen_graph_ul_ty :: Ord v => String -> (v -> String) -> [T.Edge v] -> [String]
 gen_graph_ul_ty ty = gen_graph_ul [("graph:layout",ty)]
 
-gen_flt_graph :: (Ord t, Show t) => [T.DOT_ATTR] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
-gen_flt_graph o f p = gen_graph_ul o set_pp (T.e_univ_select_u_edges f p)
+gen_flt_graph_pp :: Ord t => [T.Dot_Meta_Attr] -> ([t] -> String) -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
+gen_flt_graph_pp opt pp f p = gen_graph_ul opt pp (gen_u_edges f p)
 
+gen_flt_graph :: (Ord t, Show t) => [T.Dot_Meta_Attr] -> ([t] -> [t] -> Bool) -> [[t]] -> [String]
+gen_flt_graph opt = gen_flt_graph_pp opt set_pp
+
 -- * P.12
 
--- | <http://localhost/rd/?t=j&e=2016-04-04.md>
+-- > circ_5 12 0 == [0,7,2,9,4,11,6,1,8,3,10,5]
+circ_5 :: Integral a => Int -> a -> [a]
+circ_5 l n = take l (iterate (T.z_mod T.z12 . (+ 7)) (T.z_mod T.z12 n))
+
+all_pairs :: [t] -> [u] -> [(t,u)]
+all_pairs x y = [(p,q) | p <- x, q <- y]
+
+adj :: [t] -> [(t,t)]
+adj = T.adj2 1
+
+adj_cyc :: [t] -> [(t,t)]
+adj_cyc = T.adj2_cyclic 1
+
+p12_c5_eset :: [(Int,Int)]
+p12_c5_eset =
+    let l1 = circ_5 4 9 -- [9,4,11,6]
+        l2 = circ_5 5 10 -- [10,5,0,7,2]
+        l3 = circ_5 3 1 -- [1,8,3]
+        align p q = filter ((== 4) . T.z_mod T.z12 . dif) (all_pairs p q)
+    in concatMap adj [l1,l2,l3] ++ align l1 l2 ++ align l2 l3
+
+e_add_label :: (T.Edge v -> l) -> [T.Edge v] -> [T.Edge_Lbl v l]
+e_add_label f = let g (p,q) = ((p,q),f (p,q)) in map g
+
+p12_c5_gr :: [String]
+p12_c5_gr =
+    let o = [("graph:start","187623")
+            ,("node:fontsize","10")
+            ,("edge:fontsize","9")]
+        e_l = e_add_label (i_to_ic . absdif) p12_c5_eset
+    in gen_graph o (\(_,v) -> [("label",T.pc_pp v)],\(_,e) -> [("label",show e)]) e_l
+
+-- > T.euler_plane_r p12_euler_plane == [1/1,16/15,9/8,6/5,5/4,4/3,45/32,3/2,8/5,5/3,16/9,15/8]
 p12_euler_plane :: T.Euler_Plane Rational
 p12_euler_plane =
     let f = T.fold_ratio_to_octave_err
@@ -119,36 +191,90 @@
 
 -- * P.14
 
+p14_eset :: ([(Int, Int)], [(Int, Int)], [(Int, Int)])
+p14_eset =
+  let univ = [0 .. 11]
+      trs n = map (T.z_mod T.z12 . (+ n))
+      e_par = zip univ univ
+      e_rel = zip univ (trs 9 univ)
+      e_med = zip univ (trs 4 univ)
+  in (e_par,e_rel,e_med)
+
+p14_mk_e :: [(Int, Int)] -> [(T.Key,T.Key)]
+p14_mk_e =
+  let pc_to_key m pc = let (n,a) = fromMaybe (error "p14_mk_e?") (T.pc_to_note_alteration_ks pc) in (n,a,m)
+      e_lift (lhs,rhs) = (pc_to_key T.Major_Mode lhs,pc_to_key T.Minor_Mode rhs)
+  in map e_lift
+
+p14_edges_u :: [(T.Key,T.Key)]
+p14_edges_u =
+  let (e_par,e_rel,e_med) = p14_eset
+  in p14_mk_e (concat [e_par,e_rel,e_med])
+
 p14_edges :: [(T.Key,T.Key)]
 p14_edges =
-    let univ = [0::Int .. 11]
-        trs n = map (mod12 . (+ n))
-        e_par = zip univ univ
-        e_rel = zip univ (trs 9 univ)
-        e_med = zip univ (trs 4 univ)
-        del_par = [10]
-        del_rel = [5,6]
-        del_med = [2,5,8,11]
-        rem_set r = filter (\(lhs,_) -> lhs `notElem` r)
-        pc_to_key m pc = let Just (n,a) = T.pc_to_note_alteration_ks pc in (n,a,m)
-        e_lift (lhs,rhs) = (pc_to_key T.Major_Mode lhs,pc_to_key T.Minor_Mode rhs)
-        e_mod = concat [rem_set del_par e_par,rem_set del_rel e_rel,rem_set del_med e_med]
-    in map e_lift e_mod
+  let (e_par,e_rel,e_med) = p14_eset
+      del_par = [10]
+      del_rel = [5,6]
+      del_med = [2,5,8,11]
+      rem_set r = filter (\(lhs,_) -> lhs `notElem` r)
+      e_mod = concat [rem_set del_par e_par,rem_set del_rel e_rel,rem_set del_med e_med]
+  in p14_mk_e e_mod
 
+p14_mk_gr :: [T.Dot_Meta_Attr] -> [T.Edge T.Key] -> [String]
+p14_mk_gr opt e =
+    let opt' = ("graph:start","168732") : opt
+        pp = T.gr_pp_label_v T.key_lc_uc_pp
+        gr = T.g_from_edges e
+    in T.fgl_to_udot opt' pp gr
+
+p14_gr_u :: [String]
+p14_gr_u =
+  p14_mk_gr
+  [("edge:len","1.5")
+  ,("edge:fontsize","6")
+  ,("node:shape","box")
+  ,("node:fontsize","10")
+  ,("node:fontname","century schoolbook")]
+  p14_edges_u
+
 p14_gr :: [String]
-p14_gr =
-    let opt = [("graph:start","168732")]
-        pp = T.gr_pp_lift_node_f T.key_lc_uc_pp
-        gr = T.g_from_edges p14_edges
-    in T.g_to_udot opt pp gr
+p14_gr = p14_mk_gr [] p14_edges
 
+p14_gen_tonnetz_n :: Int -> [Int] -> [Int] -> [Int]
+p14_gen_tonnetz_n n k x =
+  let gen_neighbours_n l z = map (+ z) l ++ map (z -) l
+  in if n == 0
+     then x
+     else let r = nub (x ++ concatMap (gen_neighbours_n k) x)
+          in p14_gen_tonnetz_n (n - 1) k r
+
+p14_gen_tonnetz_e :: Int -> [Int] -> [Int] -> [((Int, Int), Int)]
+p14_gen_tonnetz_e n k =
+    let gen_e x y = ((min x y,max x y),abs (x - y))
+        gen_e_n d_set x y = if abs (x - y) `elem` d_set then Just (gen_e x y) else Nothing
+        f [p,q] = gen_e_n k p q
+        f _ = error "p14_gen_tonnetz_e"
+    in mapMaybe f . T.combinations 2 . p14_gen_tonnetz_n n k
+
+-- Neo-Riemannian Tonnettz
+p14_nrt_gr :: [String]
+p14_nrt_gr =
+  let e = p14_gen_tonnetz_e 3 [7,9,16] [48]
+      o = [("node:shape","circle")
+          ,("node:fontsize","10")
+          ,("node:fontname","century schoolbook")
+          ,("edge:len","1")]
+      pp = (\(_,v) -> [("label",T.pc_pp (T.z_mod T.z12 v))],const [])
+  in gen_graph o pp e
+
 -- * P.31
 
 p31_f_4_22 :: [Z12]
 p31_f_4_22 = [0,2,4,7]
 
 p31_e_set :: [([Z12],[Z12])]
-p31_e_set = T.e_univ_select_u_edges (doi_of 3) (map sort (T.z_sro_ti_related mod12 p31_f_4_22))
+p31_e_set = T.e_univ_select_u_edges (doi_of 3) (map sort (T.z_sro_ti_related T.z12 p31_f_4_22))
 
 p31_gr :: [String]
 p31_gr = gen_graph_ul [] set_pp p31_e_set
@@ -158,15 +284,32 @@
 p114_f_3_7 :: [Z12]
 p114_f_3_7 = [0,2,5]
 
+p114_mk_o :: Show t => t -> [T.Dot_Meta_Attr]
+p114_mk_o el =
+  [("node:shape","box")
+  ,("edge:len",show el)
+  ,("edge:fontsize","10")]
+
 p114_mk_gr :: Double -> ([Z12] -> [Z12] -> Bool) -> [String]
 p114_mk_gr el flt =
-    let o = [("node:shape","box")
-            ,("edge:len",show el)]
-    in gen_flt_graph o flt (map sort (T.z_sro_ti_related mod12 p114_f_3_7))
+  let n = map sort (T.z_sro_ti_related T.z12 p114_f_3_7)
+  in gen_flt_graph (p114_mk_o el) flt n
 
+p114_f37_sc_pp :: [Z12] -> String
+p114_f37_sc_pp = set_pp_tto_rel T.z12 [0,2,5]
+
+p114_g0 :: [String]
+p114_g0 =
+  let mk_e flt = gen_u_edges flt (map sort (T.z_sro_ti_related T.z12 p114_f_3_7))
+  in gen_graph_ul (p114_mk_o (2.5::Double)) p114_f37_sc_pp (mk_e (doi_of 2))
+
+p114_g1 :: [String]
+p114_g1 = p114_mk_gr 2.5 (doi_of 2)
+
 p114_gr_set :: [(String,[String])]
 p114_gr_set =
-  [("p114.1.dot",p114_mk_gr 2.5 (doi_of 2))
+  [("p114.0.dot",p114_g0)
+  ,("p114.1.dot",p114_g1)
   ,("p114.2.dot"
    ,let o = [("edge:len","1.25")]
     in gen_flt_graph o (loc_dif_of 1) (T.combinations 3 [1::Int .. 6]))
@@ -184,7 +327,7 @@
 p125_gr :: [String]
 p125_gr =
     let t :: [[Int]]
-        t = [[p,q,r] | p <- [0 .. 11], q <- [0 .. 11], r <- [0 ..11], q > p, r > q]
+        t = [[p,q,r] | p <- [0 .. 11], q <- [0 .. 11], q > p, r <- [0 ..11], r > q]
         c = T.collate (zip (map sum t) t)
         with_h n = lookup n c
         ch = fromJust (liftM2 (++) (with_h 15) (with_h 16))
@@ -195,7 +338,7 @@
 p131_gr :: [String]
 p131_gr =
     let c = let u = [6::Int .. 14]
-            in [[p,q,r] | p <- u, q <- u, r <- u, q > p, r > q, p + q + r == 30]
+            in [[p,q,r] | p <- u, q <- u, q > p, r <- u, r > q, p + q + r == 30]
     in gen_graph_ul [] set_pp (T.e_univ_select_u_edges (min_vl_of 2) c)
 
 -- * P.148
@@ -223,35 +366,103 @@
 
 -- * P.162
 
+-- > length p162_ch == 30
+p162_ch :: [[Int]]
+p162_ch =
+  let n = [0::Int,1,2,3,4,5,6,7,8]
+      c = T.combinations 4 n
+  in filter ((== 1) . (`mod` 4) . sum) c
+
+-- > length p162_e == 47
+p162_e :: [T.Edge [Int]]
+p162_e = T.e_univ_select_u_edges (doi_of 3) p162_ch
+
 p162_gr :: [String]
 p162_gr =
-    let n = [0::Int,1,2,3,4,5,6,7,8]
-        c = T.combinations 4 n
-        ch = filter ((== 1) . (`mod` 4) . sum) c
-        opt = [("graph:layout","neato")
+    let opt = [("graph:layout","neato")
               ,("edge:len","1.75")]
-    in gen_graph_ul opt set_pp (T.e_univ_select_u_edges (doi_of 3) ch)
+    in gen_graph_ul opt set_pp p162_e
 
 -- * P.172
 
+-- > M.size p172_nd_map == 24
 p172_nd_map :: M.Map Int [Z12]
 p172_nd_map =
-    let nd_exp = map sort (T.z_sro_ti_related mod12 [0,1,3,7])
+    let nd_exp = map sort (T.z_sro_ti_related T.z12 [0,1,3,7])
     in M.fromList (zip [0..] nd_exp)
 
+p172_nd_e_set :: [(Int,Int)]
+p172_nd_e_set = T.e_univ_select_u_edges (m_doi_of p172_nd_map 0) [0..23]
+
+p172_nd_e_set_alt :: [T.Edge Int]
+p172_nd_e_set_alt = concatMap (T.e_path_to_edges . T.close 1) p172_cyc0
+
+p172_gr :: G.Gr () ()
+p172_gr = G.mkUGraph [0..23] p172_nd_e_set
+
 p172_set_pp :: Int -> String
 p172_set_pp = set_pp . m_get p172_nd_map
 
+-- > let (c0,c1) = p172_all_cyc p172_gr
+-- > (length c0,length c1) == (48,48)
+p172_all_cyc :: ([[Int]], [[Int]])
+p172_all_cyc =
+    let (a, b) = T.firstSecond (T.g_partition p172_gr)
+    in (L.observeAll (T.ug_hamiltonian_path_ml_0 a)
+       ,L.observeAll (T.ug_hamiltonian_path_ml_0 b))
+
+p172_cyc0 :: [[Int]]
+p172_cyc0 = map (!! 0) [fst p172_all_cyc,snd p172_all_cyc]
+
+p172_g1 :: [String]
+p172_g1 = gen_graph_ul [("edge:len","2.0")] p172_set_pp p172_nd_e_set
+
+p172_g2 :: [String]
+p172_g2 = gen_graph_ul [] p172_set_pp p172_nd_e_set_alt
+
+p172_g3 :: [String]
+p172_g3 =
+  let m_set_pp_tto_rel = set_pp_tto_rel T.z12 [0,1,3,7] . m_get p172_nd_map
+  in gen_graph_ul [("node:shape","box"),("edge:len","2.0")] m_set_pp_tto_rel p172_nd_e_set
+
+-- | 'T.Tto' T/n/.
+tto_tn :: Integral t => t -> T.Tto t
+tto_tn n = T.Tto (T.z_mod T.z12 n) 1 False
+
+-- | 'Z.Tto' T/n/I.
+tto_tni :: Integral t => t -> T.Tto t
+tto_tni n = T.Tto (T.z_mod T.z12 n) 1 True
+
+gen_tto_alt_seq :: Integral t => (t -> T.Tto t,t -> T.Tto t) -> Int -> t -> t -> t -> [T.Tto t]
+gen_tto_alt_seq (f,g) k n m x =
+    let t = map f (take k [x,x + n ..])
+        i = map g (take k [x + m,x + m + n ..])
+    in T.interleave t i
+
+-- | /k/ is length of the T & I sequences, /n/ is the T & I sequence
+-- interval, /m/ is the interval between the T & I sequence.
+--
+-- > r = ["T0 T5I T3 T8I T6 T11I T9 T2I","T1 T6I T4 T9I T7 T0I T10 T3I"]
+-- > map (unwords . map T.tto_pp . gen_tni_seq 4 3 5) [0,1] == r
+gen_tni_seq :: Integral t => Int -> t -> t -> t -> [T.Tto t]
+gen_tni_seq = gen_tto_alt_seq (tto_tn,tto_tni)
+
+-- > putStrLn $ unlines $ map (unwords . map Z.tto_pp) c4
+p172_c4 :: [[T.Tto Int]]
+p172_c4 = map (gen_tni_seq 3 4 9) [0 .. 3] ++ map (gen_tni_seq 2 6 11) [0 .. 5]
+
+tto_seq_edges :: (Show t,Num t,Eq t) => [[T.Tto t]] -> [(String, String)]
+tto_seq_edges = nub . sort . concatMap (map T.t2_sort . adj_cyc . map T.tto_pp)
+
+p172_g4 :: [String]
+p172_g4 = gen_graph_ul [("edge:len","2.0")] id (tto_seq_edges p172_c4)
+
 p172_gr_set :: [(String,[String])]
 p172_gr_set =
-    [("p172.0.dot"
-     ,let nd_e_set = T.e_univ_select_u_edges (m_doi_of p172_nd_map 0) [0..23]
-      in gen_graph_ul_ty "circo" p172_set_pp nd_e_set)
-    ,("p172.1.dot"
-     ,let nd_e_set = concatMap T.e_path_to_edges
-                     [[22,11,20,9,18,7,16,5,14,3,12,1,22]
-                     ,[23,2,13,8,19,10,21,4,15,6,17,0,23]]
-      in gen_graph_ul_ty "circo" p172_set_pp nd_e_set)]
+    [("p172.0.dot",p172_g1)
+    ,("p172.1.dot",p172_g2)
+    ,("p172.2.dot",p172_g3)
+    ,("p172.3.dot",p172_g4)]
 
 -- * P.177
 
@@ -265,21 +476,149 @@
 
 p177_gr_set :: [(String,[String])]
 p177_gr_set =
-    let p_set = concatMap (T.z_sro_ti_related mod12) [[0::Int,1,4,6],[0,1,3,7]]
+    let p_set = concatMap (T.z_sro_ti_related T.z12) [[0::Int,1,4,6],[0,1,3,7]]
     in [("p177.0.dot",gen_graph_ul [] set_pp (map (partition_ic 4) p_set))
        ,("p177.1.dot",gen_graph_ul_ty "circo" set_pp (map (partition_ic 6) p_set))
        ,("p177.2.dot"
-        ,let gr_pp = T.gr_pp_lift_node_f set_pp
+        ,let gr_pp = T.gr_pp_label_v set_pp
              gr = T.g_from_edges (map (partition_ic 6) p_set)
-         in T.g_to_udot [("edge:len","1.5")] gr_pp gr)]
+         in T.fgl_to_udot [("edge:len","1.5")] gr_pp gr)]
 
+-- * P.178
+
+type SC = [Int]
+type PCSET = [Int]
+
+ait :: [SC]
+ait = map T.sc ["4-Z15","4-Z29"]
+
+-- | List of pcsets /s/ where /prime(p+s)=r/ and /prime(q+s)=r/.
+-- /#p/ and /#q/ must be equal, and less than /#r/.
+--
+-- > mk_bridge (T.sc "4-Z15") [0,6] [1,7] == [[2,5],[8,11]]
+-- > mk_bridge (T.sc "4-Z29") [0,6] [1,7] == [[2,11],[5,8]]
+mk_bridge :: SC -> PCSET -> PCSET -> [PCSET]
+mk_bridge r p q =
+    let n = length r - length p
+        c = T.combinations n [0..11]
+        f s = T.z_forte_prime T.z12 (p ++ s) == r && T.z_forte_prime T.z12 (q ++ s) == r
+    in filter f c
+
+-- | 'concatMap' of 'mk_bridge'.
+--
+-- > mk_bridge_set ait [0,6] [1,7] == [[2,5],[8,11],[2,11],[5,8]]
+mk_bridge_set :: [SC] -> PCSET -> PCSET -> [PCSET]
+mk_bridge_set r_set p q = concatMap (\r -> mk_bridge r p q) r_set
+
+mk_bridge_set_seq :: [SC] -> [PCSET] -> [[PCSET]]
+mk_bridge_set_seq r_set k_seq =
+    case k_seq of
+      p:q:k_seq' -> mk_bridge_set r_set p q : mk_bridge_set_seq r_set (q : k_seq')
+      _ -> []
+
+-- > zip [0..] (mk_bridge_set_seq ait p178_i6_seq)
+p178_i6_seq :: [PCSET]
+p178_i6_seq = map (sort . (\n -> T.z_pcset T.z12 [n,n+6])) [0..6]
+
+p178_ch :: [(PCSET,[PCSET],PCSET)]
+p178_ch = zip3 p178_i6_seq (mk_bridge_set_seq ait p178_i6_seq) (tail p178_i6_seq)
+
+type ID = Char
+
+-- | Add 'ID' to vertices, the @2,11@ the is between @0,6@ and @1,7@
+-- is /not/ the same @2,11@ that is between @3,9@ and @4,10@.
+p178_e :: [((ID,PCSET),(ID,PCSET))]
+p178_e =
+    let f k (p,c,q) = map (\x -> (('.',p),(k,x))) c ++ map (\x -> ((k,x),('.',q))) c
+    in concat (zipWith f ['a'..] p178_ch)
+
+p178_gr_1 :: [String]
+p178_gr_1 =
+    let opt = [("node:shape","rectangle")
+              ,("node:start","1362874")
+              ,("edge:len","2")]
+    in gen_graph_ul opt (set_pp . snd) p178_e
+
+p178_gr_2 :: [String]
+p178_gr_2 =
+    let opt = [("node:shape","point")]
+    in gen_graph_ul opt (const "") p178_e
+
+-- * P.196
+
+p196_gr :: [String]
+p196_gr = gen_flt_graph [("edge:len","1.25")] (loc_dif_of 1) (T.combinations 3 [1::Int .. 6])
+
+-- * P.201
+
+type SET = [Int]
+type E = (SET,SET)
+
+bd_9_3_2_12 :: [SET]
+bd_9_3_2_12 =
+    [[0,1,2],[0,1,2],[0,3,4],[0,3,4],[0,5,6],[0,5,7],[0,6,8],[0,7,8]
+    ,[1,3,5],[1,3,8],[1,4,5],[1,4,8],[1,6,7],[1,6,7]
+    ,[2,3,6],[2,3,7],[2,4,6],[2,4,7],[2,5,8],[2,5,8]
+    ,[3,5,6],[3,7,8]
+    ,[4,5,7],[4,6,8]]
+
+p201_mk_e :: [Int] -> [E]
+p201_mk_e =
+    let f n s = if n `elem` s then Just ([n],sort (n `delete` s)) else Nothing
+        g n = mapMaybe (f n) bd_9_3_2_12
+    in concatMap g
+
+p201_e :: [[E]]
+p201_e = map p201_mk_e [[0,3,4],[1,6,7],[2,5,8]]
+
+p201_o :: [T.Dot_Meta_Attr]
+p201_o =
+  [("graph:splines","false")
+  ,("node:shape","box")
+  ,("edge:len","1.75")]
+
+-- > length p201_gr_set
+p201_gr_set :: [[String]]
+p201_gr_set = map (gen_graph_ul p201_o set_pp) p201_e
+
+p201_gr_join :: [String]
+p201_gr_join =
+    let e = zipWith e_add_id [0::Int ..] p201_e
+    in gen_graph_ul p201_o (set_pp . snd) (concat e)
+
+-- * P.205
+
+bd_9_3_2_34 :: [SET]
+bd_9_3_2_34 =
+    [[0,1,2],[0,1,3],[0,2,4],[0,3,4]
+    ,[0,5,6],[0,5,7],[0,6,8],[0,7,8]
+    ,[1,2,5],[1,3,6],[1,4,5],[1,4,8]
+    ,[1,6,7],[1,7,8],[2,3,6],[2,3,7]
+    ,[2,4,7],[2,5,8],[2,6,8],[3,4,8]
+    ,[3,5,7],[3,5,8],[4,5,6],[4,6,7]]
+
+p205_mk_e :: [Int] -> [E]
+p205_mk_e =
+    let f n s = if n `elem` s then Just ([n],sort (n `delete` s)) else Nothing
+        g n = mapMaybe (f n) bd_9_3_2_34
+    in concatMap g
+
+p205_gr :: [String]
+p205_gr =
+    let o = [("graph:splines","false"),("node:shape","box"),("edge:len","2.25")]
+    in gen_graph_ul o set_pp (p205_mk_e [0..8])
+
 -- * IO
 
-wr_graphs :: IO ()
-wr_graphs = do
-  let f (nm,gr) = writeFile ("/home/rohan/sw/hmt/data/dot/tj_oh_" ++ nm) (unlines gr)
-  f ("p012.dot",p12_euler_plane_gr)
-  f ("p014.dot",p14_gr)
+-- > wr_graphs "/home/rohan/sw/hmt/data/dot/tj/oh/"
+wr_graphs :: FilePath -> IO ()
+wr_graphs dir = do
+  let f (nm,gr) = writeFile (dir ++ "tj_oh_" ++ nm) (unlines gr)
+  f ("p012.1.dot",p12_c5_gr)
+  f ("p012.2.dot",p12_euler_plane_gr)
+  f ("p014.1.dot",p14_gr_u)
+  f ("p014.2.dot",p14_gr)
+  f ("p014.3.dot",p14_nrt_gr)
   f ("p031.dot",p31_gr)
   mapM_ f p114_gr_set
   f ("p125.dot",p125_gr)
@@ -288,3 +627,9 @@
   f ("p162.dot",p162_gr)
   mapM_ f p172_gr_set
   mapM_ f p177_gr_set
+  f ("p178.1.dot",p178_gr_1)
+  f ("p178.2.dot",p178_gr_2)
+  f ("p196.dot",p196_gr)
+  mapM_ f (zip ["p201.1.dot","p201.2.dot","p201.3.dot"] p201_gr_set)
+  f ("p201.4.dot",p201_gr_join)
+  f ("p205.dot",p205_gr)
diff --git a/Music/Theory/IO.hs b/Music/Theory/IO.hs
deleted file mode 100644
--- a/Music/Theory/IO.hs
+++ /dev/null
@@ -1,34 +0,0 @@
--- | "System.IO" related functions.
-module Music.Theory.IO where
-
-import qualified Data.ByteString as B {- bytestring -}
-import qualified Data.Text as T {- text -}
-import qualified Data.Text.Encoding as T {- text -}
-import qualified Data.Text.IO as T {- text -}
-import qualified System.Directory as D {- directory -}
-
--- | 'T.decodeUtf8' of 'B.readFile'.
-read_file_utf8_text :: FilePath -> IO T.Text
-read_file_utf8_text = fmap T.decodeUtf8 . B.readFile
-
--- | Read (strictly) a UTF-8 encoded text file, implemented via "Data.Text".
-read_file_utf8 :: FilePath -> IO String
-read_file_utf8 = fmap T.unpack . read_file_utf8_text
-
--- | 'read_file_utf8', or a default value if the file doesn't exist.
-read_file_utf8_or :: String -> FilePath -> IO String
-read_file_utf8_or def f = do
-  x <- D.doesFileExist f
-  if x then read_file_utf8 f else return def
-
--- | Write UTF8 string as file, via "Data.Text".
-write_file_utf8 :: FilePath -> String -> IO ()
-write_file_utf8 fn = B.writeFile fn . T.encodeUtf8 . T.pack
-
--- | 'readFile' variant using 'Text' for @ISO 8859-1@ (Latin 1) encoding.
-read_file_iso_8859_1 :: FilePath -> IO String
-read_file_iso_8859_1 = fmap (T.unpack . T.decodeLatin1) . B.readFile
-
--- | 'readFile' variant using 'Text' for local encoding.
-read_file_locale :: FilePath -> IO String
-read_file_locale = fmap T.unpack . T.readFile
diff --git a/Music/Theory/Instrument/Choir.hs b/Music/Theory/Instrument/Choir.hs
--- a/Music/Theory/Instrument/Choir.hs
+++ b/Music/Theory/Instrument/Choir.hs
@@ -1,9 +1,9 @@
 module Music.Theory.Instrument.Choir where
 
 import Data.List.Split {- split -}
-import Data.Maybe {- base -}
 
 import qualified Music.Theory.Clef as T {- hmt -}
+import qualified Music.Theory.List as T {- hmt -}
 import qualified Music.Theory.Pitch as T {- hmt -}
 import qualified Music.Theory.Pitch.Name as T {- hmt -}
 
@@ -43,13 +43,9 @@
     ,(Alto,(T.g3,T.c5))
     ,(Soprano,(T.c4,T.f5))]
 
--- | Erroring variant.
-lookup_err :: Eq a => a -> [(a,b)] -> b
-lookup_err e = fromMaybe (error "lookup_err") . lookup e
-
 -- | Lookup voice range table.
 voice_rng :: Voice_Rng_Tbl -> Voice -> (T.Pitch,T.Pitch)
-voice_rng tbl v = lookup_err v tbl
+voice_rng tbl v = T.lookup_err v tbl
 
 -- | Lookup 'voice_rng_tbl_std'.
 voice_rng_std :: Voice -> (T.Pitch,T.Pitch)
diff --git a/Music/Theory/Instrument/Names.hs b/Music/Theory/Instrument/Names.hs
--- a/Music/Theory/Instrument/Names.hs
+++ b/Music/Theory/Instrument/Names.hs
@@ -2,7 +2,7 @@
 
 import Data.List.Split {- split -}
 
--- (family,abbreviations,names,transpositions)
+-- | (family,abbreviations,names,transpositions)
 instrument_db' :: [(String,String,String,String)]
 instrument_db' =
     [("br","b.tbn","bass trombone","")
@@ -106,7 +106,7 @@
     ,("ww","oca","ocarina","")
     ]
 
--- (family,[abbreviations],[names],[transpositions])
+-- | (family,[abbreviations],[names],[transpositions])
 instrument_db :: [(String,[String],[String],[String])]
 instrument_db =
     let sep = splitOn ";"
diff --git a/Music/Theory/Interval.hs b/Music/Theory/Interval.hs
--- a/Music/Theory/Interval.hs
+++ b/Music/Theory/Interval.hs
@@ -4,17 +4,17 @@
 import Data.List {- base -}
 import Data.Maybe {- base -}
 
-import qualified Music.Theory.Ord as T
-import qualified Music.Theory.Pitch as T
-import qualified Music.Theory.Pitch.Note as T
+import qualified Music.Theory.Ord as T {- hmt -}
+import qualified Music.Theory.Pitch as T {- hmt -}
+import qualified Music.Theory.Pitch.Note as T {- hmt -}
 
 -- | Interval type or degree.
-data Interval_T = Unison | Second | Third | Fourth
+data Interval_Type = Unison | Second | Third | Fourth
                 | Fifth | Sixth | Seventh
                   deriving (Eq,Enum,Bounded,Ord,Show)
 
 -- | Interval quality.
-data Interval_Q = Diminished | Minor
+data Interval_Quality = Diminished | Minor
                 | Perfect
                 | Major | Augmented
                   deriving (Eq,Enum,Bounded,Ord,Show)
@@ -22,23 +22,23 @@
 -- | Common music notation interval.  An 'Ordering' of 'LT' indicates
 -- an ascending interval, 'GT' a descending interval, and 'EQ' a
 -- unison.
-data Interval = Interval {interval_type :: Interval_T
-                         ,interval_quality :: Interval_Q
+data Interval = Interval {interval_type :: Interval_Type
+                         ,interval_quality :: Interval_Quality
                          ,interval_direction :: Ordering
                          ,interval_octave :: T.Octave}
                 deriving (Eq,Show)
 
--- | Interval type between 'Note_T' values.
+-- | Interval type between 'Note' values.
 --
 -- > map (interval_ty C) [E,B] == [Third,Seventh]
-interval_ty :: T.Note_T -> T.Note_T -> Interval_T
+interval_ty :: T.Note -> T.Note -> Interval_Type
 interval_ty n1 n2 = toEnum ((fromEnum n2 - fromEnum n1) `mod` 7)
 
--- | Table of interval qualities.  For each 'Interval_T' gives
--- directed semitone interval counts for each allowable 'Interval_Q'.
+-- | Table of interval qualities.  For each 'Interval_Type' gives
+-- directed semitone interval counts for each allowable 'Interval_Quality'.
 -- For lookup function see 'interval_q', for reverse lookup see
 -- 'interval_q_reverse'.
-interval_q_tbl :: Integral n => [(Interval_T, [(n,Interval_Q)])]
+interval_q_tbl :: Integral n => [(Interval_Type, [(n,Interval_Quality)])]
 interval_q_tbl =
     [(Unison,[(11,Diminished)
              ,(0,Perfect)
@@ -66,20 +66,20 @@
               ,(11,Major)
               ,(12,Augmented)])]
 
--- | Lookup 'Interval_Q' for given 'Interval_T' and semitone count.
+-- | Lookup 'Interval_Quality' for given 'Interval_Type' and semitone count.
 --
 -- > interval_q Unison 11 == Just Diminished
 -- > interval_q Third 5 == Just Augmented
 -- > interval_q Fourth 5 == Just Perfect
 -- > interval_q Unison 3 == Nothing
-interval_q :: Interval_T -> Int -> Maybe Interval_Q
+interval_q :: Interval_Type -> Int -> Maybe Interval_Quality
 interval_q i n = lookup i interval_q_tbl >>= lookup n
 
--- | Lookup semitone difference of 'Interval_T' with 'Interval_Q'.
+-- | Lookup semitone difference of 'Interval_Type' with 'Interval_Quality'.
 --
 -- > interval_q_reverse Third Minor == Just 3
 -- > interval_q_reverse Unison Diminished == Just 11
-interval_q_reverse :: Interval_T -> Interval_Q -> Maybe Int
+interval_q_reverse :: Interval_Type -> Interval_Quality -> Maybe Int
 interval_q_reverse ty qu =
     case lookup ty interval_q_tbl of
       Nothing -> Nothing
@@ -98,8 +98,8 @@
 
 -- | Determine 'Interval' between two 'Pitch'es.
 --
--- > interval (Pitch C Sharp 4) (Pitch D Flat 4) == Interval Second Diminished EQ 0
--- > interval (Pitch C Sharp 4) (Pitch E Sharp 5) == Interval Third Major LT 1
+-- > interval (T.Pitch T.C T.Sharp 4) (T.Pitch T.D T.Flat 4) == Interval Second Diminished EQ 0
+-- > interval (T.Pitch T.C T.Sharp 4) (T.Pitch T.E T.Sharp 5) == Interval Third Major LT 1
 interval :: T.Pitch -> T.Pitch -> Interval
 interval p1 p2 =
     let c = compare p1 p2
@@ -109,7 +109,7 @@
         p2' = T.pitch_to_pc p2
         st = (p2' - p1') `mod` 12
         ty = interval_ty n1 n2
-        (Just qu) = interval_q ty (fromIntegral st)
+        qu = fromMaybe (error "interval?") (interval_q ty (fromIntegral st))
         o_a = if n1 > n2 then -1 else 0
     in case c of
          GT -> (interval p2 p1) { interval_direction = GT }
@@ -121,14 +121,14 @@
 invert_interval :: Interval -> Interval
 invert_interval (Interval t qu d o) = Interval t qu (T.ord_invert d) o
 
--- | The signed difference in semitones between two 'Interval_Q'
--- values when applied to the same 'Interval_T'.  Can this be written
--- correctly without knowing the Interval_T?
+-- | The signed difference in semitones between two 'Interval_Quality'
+-- values when applied to the same 'Interval_Type'.  Can this be written
+-- correctly without knowing the Interval_Type?
 --
 -- > quality_difference_m Minor Augmented == Just 2
 -- > quality_difference_m Augmented Diminished == Just (-3)
 -- > quality_difference_m Major Perfect == Nothing
-quality_difference_m :: Interval_Q -> Interval_Q -> Maybe Int
+quality_difference_m :: Interval_Quality -> Interval_Quality -> Maybe Int
 quality_difference_m a b =
     let rule (x,y) =
             if x == y
@@ -152,7 +152,7 @@
                       Nothing -> Nothing
 
 -- | Erroring variant of 'quality_difference_m'.
-quality_difference :: Interval_Q -> Interval_Q -> Int
+quality_difference :: Interval_Quality -> Interval_Quality -> Int
 quality_difference a b =
     let err = error ("quality_difference: " ++ show (a,b))
     in fromMaybe err (quality_difference_m a b)
@@ -203,7 +203,7 @@
 -- displacement.
 --
 -- > mapMaybe parse_interval_type (map show [1 .. 15])
-parse_interval_type :: String -> Maybe (Interval_T,T.Octave)
+parse_interval_type :: String -> Maybe (Interval_Type,T.Octave)
 parse_interval_type n =
     case reads n of
       [(n',[])] -> if n' == 0
@@ -215,7 +215,7 @@
 -- | Parse interval quality notation.
 --
 -- > mapMaybe parse_interval_quality "dmPMA" == [minBound .. maxBound]
-parse_interval_quality :: Char -> Maybe Interval_Q
+parse_interval_quality :: Char -> Maybe Interval_Quality
 parse_interval_quality q =
     let c = zip "dmPMA" [0..]
     in fmap toEnum (lookup q c)
@@ -224,11 +224,11 @@
 -- 'parse_interval_type'.
 --
 -- > map interval_type_degree [(Third,0),(Second,1),(Unison,2)] == [3,9,15]
-interval_type_degree :: (Interval_T,T.Octave) -> Int
+interval_type_degree :: (Interval_Type,T.Octave) -> Int
 interval_type_degree (t,o) = fromEnum t + 1 + (fromIntegral o * 7)
 
 -- | Inverse of 'parse_interval_quality.
-interval_quality_pp :: Interval_Q -> Char
+interval_quality_pp :: Interval_Quality -> Char
 interval_quality_pp q = "dmPMA" !! fromEnum q
 
 -- | Parse standard common music interval notation.
diff --git a/Music/Theory/Interval/Barlow_1987.hs b/Music/Theory/Interval/Barlow_1987.hs
--- a/Music/Theory/Interval/Barlow_1987.hs
+++ b/Music/Theory/Interval/Barlow_1987.hs
@@ -4,12 +4,11 @@
 module Music.Theory.Interval.Barlow_1987 where
 
 import Data.List {- base -}
-import Data.Maybe {- base -}
 import Data.Ratio {- base -}
 import Text.Printf {- base -}
 
-import qualified Data.Numbers.Primes as P {- primes -}
-
+import qualified Music.Theory.Math as T {- hmt -}
+import qualified Music.Theory.Math.Prime as T {- hmt -}
 import qualified Music.Theory.Tuning as T {- hmt -}
 
 -- | Barlow's /indigestibility/ function for prime numbers.
@@ -21,118 +20,49 @@
         square n = n * n
     in 2 * (square (p' - 1) / p')
 
--- | Generate list of factors of /n/ from /x/.
---
--- > factor P.primes 315 == [3,3,5,7]
--- > P.primeFactors 315 == [3,3,5,7]
-factor :: Integral a => [a] -> a -> [a]
-factor x n =
-    case x of
-      [] -> undefined
-      i:x' -> if n < i
-              then [] -- ie. prime factors of 1...
-              else if i * i > n
-                   then [n]
-                   else if rem n i == 0
-                        then i : factor x (quot n i)
-                        else factor x' n
-
--- | 'factor' /n/ from 'primes'.
---
--- > map prime_factors [1,4,231,315] == [[],[2,2],[3,7,11],[3,3,5,7]]
--- > map P.primeFactors [1,4,231,315] == [[],[2,2],[3,7,11],[3,3,5,7]]
-prime_factors :: Integral a => a -> [a]
-prime_factors = factor P.primes
-
--- | Collect number of occurences of each element of a sorted list.
---
--- > multiplicities [1,1,1,2,2,3] == [(1,3),(2,2),(3,1)]
-multiplicities :: (Eq a,Integral n) => [a] -> [(a,n)]
-multiplicities =
-    let f x = case x of
-                [] -> undefined
-                e:_ -> (e,genericLength x)
-    in map f . group
-
--- | 'multiplicities' '.' 'P.primeFactors'.
---
--- > prime_factors_m 315 == [(3,2),(5,1),(7,1)]
-prime_factors_m :: Integral a => a -> [(a,a)]
-prime_factors_m = multiplicities . P.primeFactors
-
--- | Merging function for 'rational_prime_factors_m'.
-merge :: (Ord a,Num b,Eq b) => [(a,b)] -> [(a,b)] -> [(a,b)]
-merge p q =
-    case (p,q) of
-      (_,[]) -> p
-      ([],_) -> map (\(i,j) -> (i,-j)) q
-      ((a,b):p',(c,d):q') ->
-          if a < c
-          then (a,b) : merge p' q
-          else if a > c
-               then (c,-d) : merge p q'
-               else if b /= d
-                    then (a,b-d) : merge p' q'
-                    else merge p' q'
-
--- | Collect the prime factors in a rational number given as a
--- numerator/ denominator pair (n,m). Prime factors are listed in
--- ascending order with their positive or negative multiplicities,
--- depending on whether the prime factor occurs in the numerator or
--- the denominator (after cancelling out common factors).
---
--- > rational_prime_factors_m (16,15) == [(2,4),(3,-1),(5,-1)]
--- > rational_prime_factors_m (10,9) == [(2,1),(3,-2),(5,1)]
--- > rational_prime_factors_m (81,64) == [(2,-6),(3,4)]
--- > rational_prime_factors_m (27,16) == [(2,-4),(3,3)]
--- > rational_prime_factors_m (12,7) == [(2,2),(3,1),(7,-1)]
-rational_prime_factors_m :: Integral b => (b,b) -> [(b,b)]
-rational_prime_factors_m (n,m) =
-    let n' = prime_factors_m n
-        m' = prime_factors_m m
-    in merge n' m'
-
--- | Variant of 'rational_prime_factors_m' giving results in a table
--- up to the /n/th prime.
---
--- > rational_prime_factors_t 6 (12,7) == [2,1,0,-1,0,0]
--- > rational_prime_factors_t 6 (32,9) == [5,-2,0,0,0,0]
-rational_prime_factors_t :: Integral b => Int -> (b,b) -> [b]
-rational_prime_factors_t n x =
-    let r = rational_prime_factors_m x
-    in map (\i -> fromMaybe 0 (lookup i r)) (take n P.primes)
-
 -- | Compute the disharmonicity of the interval /(p,q)/ using the
 -- prime valuation function /pv/.
 --
--- > map (disharmonicity barlow) [(9,10),(8,9)] ~= [12.733333,8.333333]
+-- > map (disharmonicity barlow) [(9,10),(8,9)] == ([12 + 11/15,8 + 1/3] :: [Rational])
 disharmonicity :: (Integral a,Num b) => (a -> b) -> (a,a) -> b
 disharmonicity pv (p,q) =
-    let n = rational_prime_factors_m (p,q)
+    let n = T.rat_prime_factors_m (p,q)
     in sum [abs (fromIntegral j) * pv i | (i,j) <- n]
 
 -- | The reciprocal of 'disharmonicity'.
 --
--- > map (harmonicity barlow) [(9,10),(8,9)] ~= [0.078534,0.120000]
+-- > map (harmonicity barlow) [(9,10),(8,9),(2,1)] == ([15/191,3/25,1] :: [Rational])
 harmonicity :: (Integral a,Fractional b) => (a -> b) -> (a,a) -> b
 harmonicity pv = recip . disharmonicity pv
 
+harmonicity_m :: (Eq b,Integral a,Fractional b) => (a -> b) -> (a,a) -> Maybe b
+harmonicity_m pv = T.recip_m . disharmonicity pv
+
 -- | Variant of 'harmonicity' with 'Ratio' input.
+--
+-- > harmonicity_r barlow 1 == 1/0
 harmonicity_r :: (Integral a,Fractional b) => (a -> b) -> Ratio a -> b
-harmonicity_r pv = harmonicity pv . from_rational
-
--- | 'uncurry' ('%').
-to_rational :: Integral a => (a,a) -> Ratio a
-to_rational = uncurry (%)
+harmonicity_r pv = harmonicity pv . T.rational_nd
 
--- | Make 'numerator' 'denominator' pair of /n/.
-from_rational :: Ratio t -> (t, t)
-from_rational n = (numerator n,denominator n)
+-- | Variant of 'harmonicity_r' with output in (0,100), infinity maps to 100.
+harmonicity_r_100 :: (RealFrac b, Integral a) => (a -> b) -> Ratio a -> Int
+harmonicity_r_100 pv x =
+  case harmonicity_m pv (T.rational_nd x) of
+    Nothing -> 100
+    Just y -> round (y * 100)
 
 -- | Set of 1. interval size (cents), 2. intervals as product of
 -- powers of primes, 3. frequency ratio and 4. harmonicity value.
-type Table_2_Row = (Double,[Integer],Rational,Double)
+type Table_2_Row = (Double,[Int],Rational,Double)
 
+-- | Given ratio /r/ generate 'Table_2_Row'
+mk_table_2_row :: Rational -> Table_2_Row
+mk_table_2_row r =
+  (T.fratio_to_cents r
+  ,T.rat_prime_factors_t 6 (T.rational_nd r)
+  ,r
+  ,harmonicity_r barlow r)
+
 -- | Table 2 (p.45)
 --
 -- > length (table_2 0.06) == 24
@@ -141,43 +71,42 @@
 table_2 z =
     let g n = n <= 2 && n >= 1
         r = nub (sort (filter g [p % q | p <- [1..81],q <- [1..81]]))
-        h = map (harmonicity_r barlow) r
-        f = (> z) . snd
-        k (i,j) = (T.fratio_to_cents i,rational_prime_factors_t 6 (from_rational i),i,j)
-    in map k (filter f (zip r h))
+        f (_,_,_,h) = h > z
+    in filter f (map mk_table_2_row r)
 
--- | Pretty printer for 'Table_2_Row' values.
---
--- > mapM_ (putStrLn . table_2_pp) (table_2 0.06)
---
--- >    0.000 |  0  0  0  0  0  0 |  1:1  | Infinity
--- >  111.731 |  4 -1 -1  0  0  0 | 15:16 | 0.076531
--- >  182.404 |  1 -2  1  0  0  0 |  9:10 | 0.078534
--- >  203.910 | -3  2  0  0  0  0 |  8:9  | 0.120000
--- >  231.174 |  3  0  0 -1  0  0 |  7:8  | 0.075269
--- >  266.871 | -1 -1  0  1  0  0 |  6:7  | 0.071672
--- >  294.135 |  5 -3  0  0  0  0 | 27:32 | 0.076923
--- >  315.641 |  1  1 -1  0  0  0 |  5:6  | 0.099338
--- >  386.314 | -2  0  1  0  0  0 |  4:5  | 0.119048
--- >  407.820 | -6  4  0  0  0  0 | 64:81 | 0.060000
--- >  435.084 |  0  2  0 -1  0  0 |  7:9  | 0.064024
--- >  498.045 |  2 -1  0  0  0  0 |  3:4  | 0.214286
--- >  519.551 | -2  3 -1  0  0  0 | 20:27 | 0.060976
--- >  701.955 | -1  1  0  0  0  0 |  2:3  | 0.272727
--- >  764.916 |  1 -2  0  1  0  0 |  9:14 | 0.060172
--- >  813.686 |  3  0 -1  0  0  0 |  5:8  | 0.106383
--- >  884.359 |  0 -1  1  0  0  0 |  3:5  | 0.110294
--- >  905.865 | -4  3  0  0  0  0 | 16:27 | 0.083333
--- >  933.129 |  2  1  0 -1  0  0 |  7:12 | 0.066879
--- >  968.826 | -2  0  0  1  0  0 |  4:7  | 0.081395
--- >  996.090 |  4 -2  0  0  0  0 |  9:16 | 0.107143
--- > 1017.596 |  0  2 -1  0  0  0 |  5:9  | 0.085227
--- > 1088.269 | -3  1  1  0  0  0 |  8:15 | 0.082873
--- > 1200.000 |  1  0  0  0  0  0 |  1:2  | 1.000000
+{- | Pretty printer for 'Table_2_Row' values.
+
+> mapM_ (putStrLn . table_2_pp) (table_2 0.06)
+
+> >    0.000 |  0  0  0  0  0  0 |  1:1  | Infinity
+> >  111.731 |  4 -1 -1  0  0  0 | 15:16 | 0.076531
+> >  182.404 |  1 -2  1  0  0  0 |  9:10 | 0.078534
+> >  203.910 | -3  2  0  0  0  0 |  8:9  | 0.120000
+> >  231.174 |  3  0  0 -1  0  0 |  7:8  | 0.075269
+> >  266.871 | -1 -1  0  1  0  0 |  6:7  | 0.071672
+> >  294.135 |  5 -3  0  0  0  0 | 27:32 | 0.076923
+> >  315.641 |  1  1 -1  0  0  0 |  5:6  | 0.099338
+> >  386.314 | -2  0  1  0  0  0 |  4:5  | 0.119048
+> >  407.820 | -6  4  0  0  0  0 | 64:81 | 0.060000
+> >  435.084 |  0  2  0 -1  0  0 |  7:9  | 0.064024
+> >  498.045 |  2 -1  0  0  0  0 |  3:4  | 0.214286
+> >  519.551 | -2  3 -1  0  0  0 | 20:27 | 0.060976
+> >  701.955 | -1  1  0  0  0  0 |  2:3  | 0.272727
+> >  764.916 |  1 -2  0  1  0  0 |  9:14 | 0.060172
+> >  813.686 |  3  0 -1  0  0  0 |  5:8  | 0.106383
+> >  884.359 |  0 -1  1  0  0  0 |  3:5  | 0.110294
+> >  905.865 | -4  3  0  0  0  0 | 16:27 | 0.083333
+> >  933.129 |  2  1  0 -1  0  0 |  7:12 | 0.066879
+> >  968.826 | -2  0  0  1  0  0 |  4:7  | 0.081395
+> >  996.090 |  4 -2  0  0  0  0 |  9:16 | 0.107143
+> > 1017.596 |  0  2 -1  0  0  0 |  5:9  | 0.085227
+> > 1088.269 | -3  1  1  0  0  0 |  8:15 | 0.082873
+> > 1200.000 |  1  0  0  0  0  0 |  1:2  | 1.000000
+-}
 table_2_pp :: Table_2_Row -> String
 table_2_pp (i,j,k,l) =
     let i' = printf "%8.3f" i
         j' = unwords (map (printf "%2d") j)
-        k' = let (p,q) = from_rational k in printf "%2d:%-2d" q p
+        k' = let (p,q) = T.rational_nd k in printf "%2d:%-2d" q p
         l' = printf "%1.6f" l
     in intercalate " | " [i',j',k',l']
diff --git a/Music/Theory/Key.hs b/Music/Theory/Key.hs
--- a/Music/Theory/Key.hs
+++ b/Music/Theory/Key.hs
@@ -13,35 +13,35 @@
 import qualified Music.Theory.Interval as T
 
 -- | Enumeration of common music notation modes.
-data Mode_T = Minor_Mode | Major_Mode
+data Mode = Minor_Mode | Major_Mode
               deriving (Eq,Ord,Show)
 
--- | Pretty printer for 'Mode_T'.
-mode_pp :: Mode_T -> String
+-- | Pretty printer for 'Mode'.
+mode_pp :: Mode -> String
 mode_pp m =
     case m of
       Minor_Mode -> "Minor"
       Major_Mode -> "Major"
 
 -- | Lower-cased 'mode_pp'.
-mode_identifier_pp :: Mode_T -> String
+mode_identifier_pp :: Mode -> String
 mode_identifier_pp = map toLower . mode_pp
 
 -- | There are two modes, given one return the other.
-mode_parallel :: Mode_T -> Mode_T
+mode_parallel :: Mode -> Mode
 mode_parallel m = if m == Minor_Mode then Major_Mode else Minor_Mode
 
-mode_pc_seq :: Num t => Mode_T -> [t]
+mode_pc_seq :: Num t => Mode -> [t]
 mode_pc_seq md =
     case md of
       Major_Mode -> [0,2,4,5,7,9,11]
       Minor_Mode -> [0,2,3,5,7,8,10]
 
--- | A common music notation key is a 'Note_T', 'Alteration_T', 'Mode_T' triple.
-type Key = (T.Note_T,T.Alteration_T,Mode_T)
+-- | A common music notation key is a 'Note', 'Alteration', 'Mode' triple.
+type Key = (T.Note,T.Alteration,Mode)
 
--- | 'Mode_T' of 'Key'.
-key_mode :: Key -> Mode_T
+-- | 'Mode' of 'Key'.
+key_mode :: Key -> Mode
 key_mode (_,_,m) = m
 
 -- | Enumeration of 42 CMN keys.
@@ -58,7 +58,7 @@
 --
 -- > length key_sequence_30 == 30
 key_sequence_30 :: [Key]
-key_sequence_30 = filter (\k -> maybe False ((< 8) . abs) (key_fifths k)) key_sequence_42
+key_sequence_30 = filter (maybe False ((< 8) . abs) . key_fifths) key_sequence_42
 
 -- | Parallel key, ie. 'mode_parallel' of 'Key'.
 key_parallel :: Key -> Key
@@ -67,8 +67,8 @@
 -- | Transposition of 'Key'.
 key_transpose :: Key -> Int -> Key
 key_transpose (n,a,m) x =
-    let Just pc = T.note_alteration_to_pc (n,a)
-        Just (n',a') = T.pc_to_note_alteration_ks ((pc + x) `mod` 12)
+    let pc = fromMaybe (error "key_transpose?") (T.note_alteration_to_pc (n,a))
+        (n',a') = fromMaybe (error "key_transpose?") (T.pc_to_note_alteration_ks ((pc + x) `mod` 12))
     in (n',a',m)
 
 -- | Relative key (ie. 'mode_parallel' with the same number of and type of alterations.
@@ -98,7 +98,7 @@
 
 -- | Pretty-printer where 'Minor_Mode' is written in lower case (lc) and
 -- alteration symbol is shown using indicated function.
-key_lc_pp :: (T.Alteration_T -> String) -> Key -> String
+key_lc_pp :: (T.Alteration -> String) -> Key -> String
 key_lc_pp a_pp (n,a,m) =
     let c = T.note_pp n
         c' = if m == Minor_Mode then toLower c else c
@@ -121,7 +121,7 @@
 key_lc_tonh_pp = key_lc_pp T.alteration_tonh
 
 -- > map key_identifier_pp [(T.C,T.Sharp,Minor_Mode),(T.E,T.Flat,Major_Mode)]
-key_identifier_pp :: (Show a, Show a1) => (a, a1, Mode_T) -> [Char]
+key_identifier_pp :: (Show a, Show a1) => (a, a1, Mode) -> [Char]
 key_identifier_pp (n,a,m) = map toLower (intercalate "_" [show n,show a,mode_pp m])
 
 -- > import Data.Maybe
@@ -133,17 +133,15 @@
 
 -- | Parse 'Key' from /lc-uc/ string.
 --
--- > import Data.Maybe
---
 -- > let k = mapMaybe key_lc_uc_parse ["c","E","f♯","ab","G#"]
--- > in map key_lc_uc_pp k == ["c♮","E♮","f♯","a♭","G♯"]
+-- > map key_lc_uc_pp k == ["c♮","E♮","f♯","a♭","G♯"]
 key_lc_uc_parse :: String -> Maybe Key
 key_lc_uc_parse k =
     let with_k a (n,_,m) = (n,a,m)
         with_a n a = fmap (with_k a) (note_char_to_key n)
     in case k of
          [c] -> note_char_to_key c
-         [n,a] -> join (fmap (with_a n) (T.symbol_to_alteration_iso a))
+         [n,a] -> with_a n =<< T.symbol_to_alteration_unicode_plus_iso a
          _ -> Nothing
 
 -- | Distance along circle of fifths path of indicated 'Key'.  A
@@ -170,7 +168,7 @@
 -- | Table mapping 'Key' to 'key_fifths' value.
 key_fifths_tbl :: [(Key,Int)]
 key_fifths_tbl =
-    let f (k,n) = maybe Nothing (\n' -> Just (k,n')) n
+    let f (k,n) = fmap (\n' -> (k,n')) n
     in mapMaybe f (zip key_sequence_42 (map key_fifths key_sequence_42))
 
 -- | Lookup 'key_fifths' value in 'key_fifths_tbl'.
@@ -179,7 +177,7 @@
 -- > let f md = map key_lc_iso_pp . mapMaybe (fifths_to_key md)
 -- > f Minor_Mode a
 -- > f Major_Mode a
-fifths_to_key :: Mode_T -> Int -> Maybe Key
+fifths_to_key :: Mode -> Int -> Maybe Key
 fifths_to_key md n =
     let eq_f = (\((_,_,md'),n') -> md == md' && n == n')
     in fmap fst (find eq_f key_fifths_tbl)
@@ -188,18 +186,18 @@
 --
 -- > mapMaybe (implied_key Major_Mode) [[0,2,4],[1,3],[4,10],[3,9],[8,9]]
 -- > map (implied_key Major_Mode) [[0,1,2],[0,1,3,4]] == [Nothing,Nothing]
-implied_key :: Integral i => Mode_T -> [i] -> Maybe Key
+implied_key :: Integral i => Mode -> [i] -> Maybe Key
 implied_key md pc_set =
     let a_seq = [0,1,-1,2,-2,3,-3,4,-4,5,-5,6,-6]
         key_seq = mapMaybe (fifths_to_key md) a_seq
     in find (\k -> pc_set `T.is_subset` key_pc_set k) key_seq
 
 -- | 'key_fifths' of 'implied_key'.
-implied_fifths :: Integral i => Mode_T -> [i] -> Maybe Int
-implied_fifths md = join . fmap key_fifths . implied_key md
+implied_fifths :: Integral i => Mode -> [i] -> Maybe Int
+implied_fifths md = key_fifths <=< implied_key md
 
-implied_key_err :: Integral i => Mode_T -> [i] -> Key
+implied_key_err :: Integral i => Mode -> [i] -> Key
 implied_key_err md = fromMaybe (error "implied_key") . implied_key md
 
-implied_fifths_err :: Integral i => Mode_T -> [i] -> Int
+implied_fifths_err :: Integral i => Mode -> [i] -> Int
 implied_fifths_err md = fromMaybe (error "implied_fifths") . key_fifths . implied_key_err md
diff --git a/Music/Theory/List.hs b/Music/Theory/List.hs
deleted file mode 100644
--- a/Music/Theory/List.hs
+++ /dev/null
@@ -1,1103 +0,0 @@
--- | List functions.
-module Music.Theory.List where
-
-import Data.Either {- base -}
-import Data.Function {- base -}
-import qualified Data.IntMap as Map {- containers -}
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Data.Tree {- containers -}
-import qualified Data.Traversable as T {- base -}
-
-import qualified Data.List.Ordered as O {- data-ordlist -}
-import qualified Data.List.Split as S {- split -}
-import qualified Data.List.Split.Internals as S {- split -}
-
-import qualified Control.Monad.Logic as L {- logict -}
-
--- | Data.Vector.slice, ie. starting index (zero-indexed) and number of elements.
---
--- > slice 4 5 [1..] == [5,6,7,8,9]
-slice :: Int -> Int -> [a] -> [a]
-slice i n = take n . drop i
-
--- | Variant of slice with start and end indices (zero-indexed).
---
--- > section 4 8 [1..] == [5,6,7,8,9]
-section :: Int -> Int -> [a] -> [a]
-section l r = take (r - l + 1) . drop l
-
--- | Bracket sequence with left and right values.
---
--- > bracket ('<','>') "1,2,3" == "<1,2,3>"
-bracket :: (a,a) -> [a] -> [a]
-bracket (l,r) x = l : x ++ [r]
-
-unbracket' :: [a] -> (Maybe a,[a],Maybe a)
-unbracket' x =
-    case x of
-      [] -> (Nothing,[],Nothing)
-      l:x' -> let (m,r) = separate_last' x' in (Just l,m,r)
-
--- | The first & middle & last elements of a list.
---
--- > unbracket "[12]" == Just ('[',"12",']')
-unbracket :: [t] -> Maybe (t,[t],t)
-unbracket x =
-    case unbracket' x of
-      (Just l,m,Just r) -> Just (l,m,r)
-      _ -> Nothing
-
-unbracket_err :: [t] -> (t,[t],t)
-unbracket_err = fromMaybe (error "unbracket") . unbracket
-
--- | Variant where brackets are sequences.
---
--- > bracket_l ("<:",":>") "1,2,3" == "<:1,2,3:>"
-bracket_l :: ([a],[a]) -> [a] -> [a]
-bracket_l (l,r) s = l ++ s ++ r
-
--- * Split
-
--- | Relative of 'splitOn', but only makes first separation.
---
--- > splitOn "//" "lhs//rhs//rem" == ["lhs","rhs","rem"]
--- > separate_at "//" "lhs//rhs//rem" == Just ("lhs","rhs//rem")
-separate_at :: Eq a => [a] -> [a] -> Maybe ([a],[a])
-separate_at x =
-    let n = length x
-        f lhs rhs =
-            if null rhs
-            then Nothing
-            else if x == take n rhs
-                 then Just (reverse lhs,drop n rhs)
-                 else f (head rhs : lhs) (tail rhs)
-    in f []
-
--- | 'Splitter' comparing single element.
-on_elem :: Eq a => a -> S.Splitter a
-on_elem e = S.defaultSplitter { S.delimiter = S.Delimiter [(==) e] }
-
--- | Split before the indicated element.
---
--- > split_before 'x' "axbcxdefx" == ["a","xbc","xdef","x"]
--- > split_before 'x' "xa" == ["","xa"]
---
--- > map (flip split_before "abcde") "ae_" == [["","abcde"],["abcd","e"],["abcde"]]
--- > map (flip break "abcde" . (==)) "ae_" == [("","abcde"),("abcd","e"),("abcde","")]
-split_before :: Eq a => a -> [a] -> [[a]]
-split_before = S.split . S.keepDelimsL . on_elem
-
--- * Rotate
-
--- | Generic form of 'rotate_left'.
-genericRotate_left :: Integral i => i -> [a] -> [a]
-genericRotate_left n =
-    let f (p,q) = q ++ p
-    in f . genericSplitAt n
-
--- | Left rotation.
---
--- > rotate_left 1 [1..3] == [2,3,1]
--- > rotate_left 3 [1..5] == [4,5,1,2,3]
-rotate_left :: Int -> [a] -> [a]
-rotate_left = genericRotate_left
-
--- | Generic form of 'rotate_right'.
-genericRotate_right :: Integral n => n -> [a] -> [a]
-genericRotate_right n = reverse . genericRotate_left n . reverse
-
--- | Right rotation.
---
--- > rotate_right 1 [1..3] == [3,1,2]
-rotate_right :: Int -> [a] -> [a]
-rotate_right = genericRotate_right
-
--- | Rotate left by /n/ 'mod' /#p/ places.
---
--- > rotate 1 [1..3] == [2,3,1]
--- > rotate 8 [1..5] == [4,5,1,2,3]
-rotate :: (Integral n) => n -> [a] -> [a]
-rotate n p =
-    let m = n `mod` genericLength p
-    in genericRotate_left m p
-
--- | Rotate right by /n/ places.
---
--- > rotate_r 8 [1..5] == [3,4,5,1,2]
-rotate_r :: (Integral n) => n -> [a] -> [a]
-rotate_r = rotate . negate
-
--- | All rotations.
---
--- > rotations [0,1,3] == [[0,1,3],[1,3,0],[3,0,1]]
-rotations :: [a] -> [[a]]
-rotations p = map (`rotate_left` p) [0 .. length p - 1]
-
--- | Rotate list so that is starts at indicated element.
---
--- > rotate_starting_from 'c' "abcde" == Just "cdeab"
--- > rotate_starting_from '_' "abc" == Nothing
-rotate_starting_from :: Eq a => a -> [a] -> Maybe [a]
-rotate_starting_from x l =
-    case break (== x) l of
-      (_,[]) -> Nothing
-      (lhs,rhs) -> Just (rhs ++ lhs)
-
--- | Erroring variant.
-rotate_starting_from_err :: Eq a => a -> [a] -> [a]
-rotate_starting_from_err x =
-    fromMaybe (error "rotate_starting_from: non-element") .
-    rotate_starting_from x
-
--- | Sequence of /n/ adjacent elements, moving forward by /k/ places.
--- The last element may have fewer than /n/ places, but will reach the
--- end of the input sequence.
---
--- > adj 3 2 "adjacent" == ["adj","jac","cen","nt"]
-adj :: Int -> Int -> [a] -> [[a]]
-adj n k l =
-    case take n l of
-      [] -> []
-      r -> r : adj n k (drop k l)
-
--- | Variant of 'adj' where the last element has /n/ places but may
--- not reach the end of the input sequence.
---
--- > adj' 3 2 "adjacent" == ["adj","jac","cen"]
-adj' :: Int -> Int -> [a] -> [[a]]
-adj' n k l =
-    let r = take n l
-    in if length r == n then r : adj' n k (drop k l) else []
-
--- | Generic form of 'adj2'.
-genericAdj2 :: (Integral n) => n -> [t] -> [(t,t)]
-genericAdj2 n l =
-    case l of
-      p:q:_ -> (p,q) : genericAdj2 n (genericDrop n l)
-      _ -> []
-
--- | Adjacent elements of list, at indicated distance, as pairs.
---
--- > adj2 1 [1..5] == [(1,2),(2,3),(3,4),(4,5)]
--- > let l = [1..5] in zip l (tail l) == adj2 1 l
--- > adj2 2 [1..4] == [(1,2),(3,4)]
--- > adj2 3 [1..5] == [(1,2),(4,5)]
-adj2 :: Int -> [t] -> [(t,t)]
-adj2 = genericAdj2
-
--- | Append first element to end of list.
---
--- > close [1..3] == [1,2,3,1]
-close :: [a] -> [a]
-close x =
-    case x of
-      [] -> []
-      e:_ -> x ++ [e]
-
--- | 'adj2' '.' 'close'.
---
--- > adj2_cyclic 1 [1..3] == [(1,2),(2,3),(3,1)]
-adj2_cyclic :: Int -> [t] -> [(t,t)]
-adj2_cyclic n = adj2 n . close
-
--- | Interleave elements of /p/ and /q/.
---
--- > interleave [1..3] [4..6] == [1,4,2,5,3,6]
--- > interleave ".+-" "abc" == ".a+b-c"
--- > interleave [1..3] [] == []
-interleave :: [a] -> [a] -> [a]
-interleave p q =
-    let u (i,j) = [i,j]
-    in concatMap u (zip p q)
-
--- | Interleave list of lists.  Allows lists to be of non-equal lenghts.
---
--- > interleave_set ["abcd","efgh","ijkl"] == "aeibfjcgkdhl"
--- > interleave_set ["abc","defg","hijkl"] == "adhbeicfjgkl"
-interleave_set :: [[a]] -> [a]
-interleave_set = concat . transpose
-
-{-
-import Safe {- safe -}
-
-interleave_set l =
-    case mapMaybe headMay l of
-      [] -> []
-      r -> r ++ interleave_set (mapMaybe tailMay l)
--}
-
--- | De-interleave /n/ lists.
---
--- > deinterleave 2 ".a+b-c" == [".+-","abc"]
--- > deinterleave 3 "aeibfjcgkdhl" == ["abcd","efgh","ijkl"]
-deinterleave :: Int -> [a] -> [[a]]
-deinterleave n = transpose . S.chunksOf n
-
--- | Special case for two-part deinterleaving.
---
--- > deinterleave2 ".a+b-c" == (".+-","abc")
-deinterleave2 :: [t] -> ([t], [t])
-deinterleave2 =
-    let f l =
-            case l of
-              p:q:l' -> (p,q) : f l'
-              _ -> []
-    in unzip . f
-
-{-
-deinterleave2 =
-    let f p q l =
-            case l of
-              [] -> (reverse p,reverse q)
-              [a] -> (reverse (a:p),reverse q)
-              a:b:l' -> rec (a:p) (b:q) l'
-    in f [] []
--}
-
--- | Variant that continues with the longer input.
---
--- > interleave_continue ".+-" "abc" == ".a+b-c"
--- > interleave_continue [1..3] [] == [1..3]
--- > interleave_continue [] [1..3] == [1..3]
-interleave_continue :: [a] -> [a] -> [a]
-interleave_continue p q =
-    case (p,q) of
-      ([],_) -> q
-      (_,[]) -> p
-      (i:p',j:q') -> i : j : interleave_continue p' q'
-
--- | 'interleave' of 'rotate_left' by /i/ and /j/.
---
--- > interleave_rotations 9 3 [1..13] == [10,4,11,5,12,6,13,7,1,8,2,9,3,10,4,11,5,12,6,13,7,1,8,2,9,3]
-interleave_rotations :: Int -> Int -> [b] -> [b]
-interleave_rotations i j s = interleave (rotate_left i s) (rotate_left j s)
-
-generic_histogram :: (Ord a,Integral i) => [a] -> [(a,i)]
-generic_histogram x =
-    let g = group (sort x)
-    in zip (map head g) (map genericLength g)
-
-histogram_by :: Ord a => (a -> a -> Bool) -> [a] -> [(a,Int)]
-histogram_by f x =
-    let g = groupBy f (sort x)
-    in zip (map head g) (map length g)
-
--- | Count occurences of elements in list.
---
--- > map histogram ["","hohoh"] == [[],[('h',3),('o',2)]]
-histogram :: Ord a => [a] -> [(a,Int)]
-histogram = histogram_by (==)
-
-duplicates_by :: Ord a => (a -> a -> Bool) -> [a] -> [a]
-duplicates_by f = map fst . filter (\(_,n) -> n > 1) . histogram_by f
-
--- | Elements that appear more than once in the input.
---
--- > map duplicates ["duplicates","redundant"] == ["","dn"]
-duplicates :: Ord a => [a] -> [a]
-duplicates = duplicates_by (==)
-
--- | List segments of length /i/ at distance /j/.
---
--- > segments 2 1 [1..5] == [[1,2],[2,3],[3,4],[4,5]]
--- > segments 2 2 [1..5] == [[1,2],[3,4]]
-segments :: Int -> Int -> [a] -> [[a]]
-segments i j p =
-    let q = take i p
-        p' = drop j p
-    in if length q /= i then [] else q : segments i j p'
-
--- | 'foldl1' 'intersect'.
---
--- > intersect_l [[1,2],[1,2,3],[1,2,3,4]] == [1,2]
-intersect_l :: Eq a => [[a]] -> [a]
-intersect_l = foldl1 intersect
-
--- | 'foldl1' 'union'.
---
--- > sort (union_l [[1,3],[2,3],[3]]) == [1,2,3]
-union_l :: Eq a => [[a]] -> [a]
-union_l = foldl1 union
-
--- | Intersection of adjacent elements of list at distance /n/.
---
--- > adj_intersect 1 [[1,2],[1,2,3],[1,2,3,4]] == [[1,2],[1,2,3]]
-adj_intersect :: Eq a => Int -> [[a]] -> [[a]]
-adj_intersect n = map intersect_l . segments 2 n
-
--- | List of cycles at distance /n/.
---
--- > cycles 2 [1..6] == [[1,3,5],[2,4,6]]
--- > cycles 3 [1..9] == [[1,4,7],[2,5,8],[3,6,9]]
--- > cycles 4 [1..8] == [[1,5],[2,6],[3,7],[4,8]]
-cycles :: Int -> [a] -> [[a]]
-cycles n = transpose . S.chunksOf n
-
--- | Variant of 'filter' that has a predicate to halt processing,
--- ie. 'filter' of 'takeWhile'.
---
--- > filter_halt (even . fst) ((< 5) . snd) (zip [1..] [0..])
-filter_halt :: (a -> Bool) -> (a -> Bool) -> [a] -> [a]
-filter_halt sel end = filter sel . takeWhile end
-
--- | Replace all /p/ with /q/ in /s/.
---
--- > replace "_x_" "-X-" "an _x_ string" == "an -X- string"
--- > replace "ab" "cd" "ab ab cd ab" == "cd cd cd cd"
-replace :: Eq a => [a] -> [a] -> [a] -> [a]
-replace p q s =
-    let n = length p
-    in case s of
-         [] -> []
-         c:s' -> if p `isPrefixOf` s
-                 then q ++ replace p q (drop n s)
-                 else c : replace p q s'
-
--- | Replace the /i/th value at /ns/ with /x/.
---
--- > replace_at "test" 2 'n' == "tent"
-replace_at :: Integral i => [a] -> i -> a -> [a]
-replace_at ns i x =
-    let f j y = if i == j then x else y
-    in zipWith f [0..] ns
-
--- * Association lists
-
--- | Equivalent to 'groupBy' '==' 'on' /f/.
---
--- > let r = [[(1,'a'),(1,'b')],[(2,'c')],[(3,'d'),(3,'e')],[(4,'f')]]
--- > in group_on fst (zip [1,1,2,3,3,4] "abcdef") == r
-group_on :: Eq x => (a -> x) -> [a] -> [[a]]
-group_on f = map (map snd) . groupBy ((==) `on` fst) . map (\x -> (f x,x))
-
--- | Given accesors for /key/ and /value/ collate adjacent values.
-collate_on_adjacent :: (Eq k,Ord k) => (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
-collate_on_adjacent f g =
-    let h l = case l of
-                [] -> error "collate_on_adjacent"
-                l0:_ -> (f l0,map g l)
-    in map h . group_on f
-
--- | 'collate_on_adjacent' of 'fst' and 'snd'.
---
--- > collate_adjacent (zip "TDD" "xyz") == [('T',"x"),('D',"yz")]
-collate_adjacent :: Ord a => [(a,b)] -> [(a,[b])]
-collate_adjacent = collate_on_adjacent fst snd
-
--- | 'sortOn' prior to 'collate_on_adjacent'.
---
--- > let r = [('A',"a"),('B',"bd"),('C',"ce"),('D',"f")]
--- > in collate_on fst snd (zip "ABCBCD" "abcdef") == r
-collate_on :: Ord k => (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
-collate_on f g = collate_on_adjacent f g . sortOn f
-
--- | 'collate_on' of 'fst' and 'snd'.
---
--- > collate (zip "TDD" "xyz") == [('D',"yz"),('T',"x")]
--- > collate (zip [1,2,1] "abc") == [(1,"ac"),(2,"b")]
-collate :: Ord a => [(a,b)] -> [(a,[b])]
-collate = collate_on fst snd
-
--- | Reverse of 'collate', inverse if order is not considered.
---
--- > uncollate [(1,"ac"),(2,"b")] == zip [1,1,2] "acb"
-uncollate :: [(k,[v])] -> [(k,v)]
-uncollate = concatMap (\(k,v) -> zip (repeat k) v)
-
--- | Make /assoc/ list with given /key/.
---
--- > with_key 'a' [1..3] == [('a',1),('a',2),('a',3)]
-with_key :: k -> [v] -> [(k,v)]
-with_key h = zip (repeat h)
-
--- | Intervals to values, zero is /n/.
---
--- > dx_d 5 [1,2,3] == [5,6,8,11]
-dx_d :: (Num a) => a -> [a] -> [a]
-dx_d = scanl (+)
-
--- | Variant that takes initial value and separates final value.  This
--- is an appropriate function for 'mapAccumL'.
---
--- > dx_d' 5 [1,2,3] == (11,[5,6,8])
--- > dx_d' 0 [1,1,1] == (3,[0,1,2])
-dx_d' :: Num t => t -> [t] -> (t,[t])
-dx_d' n l =
-    case reverse (scanl (+) n l) of
-      e:r -> (e,reverse r)
-      _ -> error "dx_d'"
-
--- | Apply flip of /f/ between elements of /l/.
---
--- > d_dx_by (,) "abcd" == [('b','a'),('c','b'),('d','c')]
-d_dx_by :: (t -> t -> u) -> [t] -> [u]
-d_dx_by f l = if null l then [] else zipWith f (tail l) l
-
--- | Integrate, 'd_dx_by' '-', ie. pitch class segment to interval sequence.
---
--- > d_dx [5,6,8,11] == [1,2,3]
--- > d_dx [] == []
-d_dx :: (Num a) => [a] -> [a]
-d_dx = d_dx_by (-)
-
--- | Elements of /p/ not in /q/.
---
--- > [1,2,3] `difference` [1,2] == [3]
-difference :: (Eq a) => [a] -> [a] -> [a]
-difference p q =
-    let f e = e `notElem` q
-    in filter f p
-
--- | Is /p/ a subset of /q/, ie. is 'intersect' of /p/ and /q/ '==' /p/.
---
--- > is_subset [1,2] [1,2,3] == True
-is_subset :: Eq a => [a] -> [a] -> Bool
-is_subset p q = p `intersect` q == p
-
--- | Is /p/ a superset of /q/, ie. 'flip' 'is_subset'.
---
--- > is_superset [1,2,3] [1,2] == True
-is_superset :: Eq a => [a] -> [a] -> Bool
-is_superset = flip is_subset
-
--- | Is /p/ a subsequence of /q/, ie. synonym for 'isInfixOf'.
---
--- > subsequence [1,2] [1,2,3] == True
-subsequence :: (Eq a) => [a] -> [a] -> Bool
-subsequence = isInfixOf
-
--- | Variant of 'elemIndices' that requires /e/ to be unique in /p/.
---
--- > elem_index_unique 'a' "abcda" == undefined
-elem_index_unique :: (Eq a) => a -> [a] -> Int
-elem_index_unique e p =
-    case elemIndices e p of
-      [i] -> i
-      _ -> error "elem_index_unique"
-
--- | Lookup that errors and prints message.
-lookup_err_msg :: (Eq k,Show k) => String -> k -> [(k,v)] -> v
-lookup_err_msg err k = fromMaybe (error (err ++ ": " ++ show k)) . lookup k
-
--- | Error variant.
-lookup_err :: Eq k => k -> [(k,v)] -> v
-lookup_err n = fromMaybe (error "lookup") . lookup n
-
--- | 'lookup' variant with default value.
-lookup_def :: Eq k => k -> v -> [(k,v)] -> v
-lookup_def k d = fromMaybe d . lookup k
-
--- | Reverse lookup.
---
--- > reverse_lookup 'c' [] == Nothing
--- > reverse_lookup 'c' (zip [0..4] ['a'..]) == Just 2
-reverse_lookup :: Eq b => b -> [(a,b)] -> Maybe a
-reverse_lookup k = fmap fst . find ((== k) . snd)
-
-{-
-reverse_lookup :: Eq b => b -> [(a,b)] -> Maybe a
-reverse_lookup key ls =
-    case ls of
-      [] -> Nothing
-      (x,y):ls' -> if key == y then Just x else reverse_lookup key ls'
--}
-
-
--- | Basis of 'find_bounds_scl', indicates if /x/ is to the left or
--- right of the list, and it to the right whether equal or not.
--- 'Right' values will be correct if the list is not ascending,
--- however 'Left' values only make sense for ascending ranges.
---
--- > map (find_bounds' compare [(0,1),(1,2)]) [-1,0,1,2,3]
-find_bounds' :: (t -> s -> Ordering) -> [(t,t)] -> s -> Either ((t,t),Ordering) (t,t)
-find_bounds' f l x =
-    let g (p,q) = f p x /= GT && f q x == GT
-    in case l of
-         [] -> error "find_bounds': nil"
-         [(p,q)] -> if g (p,q) then Right (p,q) else Left ((p,q),f q x)
-         (p,q):l' -> if f p x == GT
-                     then Left ((p,q),GT)
-                     else if g (p,q) then Right (p,q) else find_bounds' f l' x
-
-decide_nearest' :: Ord o => (p -> o) -> (p,p) -> p
-decide_nearest' f (p,q) = if f p < f q then p else q
-
--- | Decide if value is nearer the left or right value of a range.
-decide_nearest :: (Num o,Ord o) => o -> (o, o) -> o
-decide_nearest x = decide_nearest' (abs . (x -))
-
--- | Find the number that is nearest the requested value in an
--- ascending list of numbers.
---
--- > map (find_nearest_err [0,3.5,4,7]) [-1,1,3,5,7,9] == [0,0,3.5,4,7,7]
-find_nearest_err :: (Num n,Ord n) => [n] -> n -> n
-find_nearest_err l x =
-    case find_bounds' compare (adj2 1 l) x of
-      Left ((p,_),GT) -> p
-      Left ((_,q),_) -> q
-      Right (p,q) -> decide_nearest x (p,q)
-
-find_nearest :: (Num n,Ord n) => [n] -> n -> Maybe n
-find_nearest l x = if null l then Nothing else Just (find_nearest_err l x)
-
--- | Basis of 'find_bounds'.  There is an option to consider the last
--- element specially, and if equal to the last span is given.
-find_bounds_scl :: Bool -> (t -> s -> Ordering) -> [(t,t)] -> s -> Maybe (t,t)
-find_bounds_scl scl f l x =
-    case find_bounds' f l x of
-         Right r -> Just r
-         Left (r,EQ) -> if scl then Just r else Nothing
-         _ -> Nothing
-
--- | Find adjacent elements of list that bound element under given
--- comparator.
---
--- > let {f = find_bounds True compare [1..5]
--- >     ;r = [Nothing,Just (1,2),Just (3,4),Just (4,5)]}
--- > in map f [0,1,3.5,5] == r
-find_bounds :: Bool -> (t -> s -> Ordering) -> [t] -> s -> Maybe (t,t)
-find_bounds scl f l = find_bounds_scl scl f (adj2 1 l)
-
--- | Special case of 'dropRight'.
---
--- > map drop_last ["","?","remove"] == ["","","remov"]
-drop_last :: [t] -> [t]
-drop_last l =
-    case l of
-      [] -> []
-      [_] -> []
-      e:l' -> e : drop_last l'
-
--- | Variant of 'drop' from right of list.
---
--- > dropRight 1 [1..9] == [1..8]
-dropRight :: Int -> [a] -> [a]
-dropRight n = reverse . drop n . reverse
-
--- | Variant of 'dropWhile' from right of list.
---
--- > dropWhileRight Data.Char.isDigit "A440" == "A"
-dropWhileRight :: (a -> Bool) -> [a] -> [a]
-dropWhileRight p = reverse . dropWhile p . reverse
-
--- | 'take' from right.
---
--- > take_right 3 "taking" == "ing"
-take_right :: Int -> [a] -> [a]
-take_right n = reverse . take n . reverse
-
--- | 'takeWhile' from right.
---
--- > take_while_right Data.Char.isDigit "A440" == "440"
-take_while_right :: (a -> Bool) -> [a] -> [a]
-take_while_right p = reverse . takeWhile p . reverse
-
--- | Apply /f/ at first element, and /g/ at all other elements.
---
--- > at_head negate id [1..5] == [-1,2,3,4,5]
-at_head :: (a -> b) -> (a -> b) -> [a] -> [b]
-at_head f g x =
-    case x of
-      [] -> []
-      e:x' -> f e : map g x'
-
--- | Apply /f/ at all but last element, and /g/ at last element.
---
--- > at_last (* 2) negate [1..4] == [2,4,6,-4]
-at_last :: (a -> b) -> (a -> b) -> [a] -> [b]
-at_last f g x =
-    case x of
-      [] -> []
-      [i] -> [g i]
-      i:x' -> f i : at_last f g x'
-
--- | Separate list into an initial list and perhaps the last element tuple.
---
--- > separate_last' [] == ([],Nothing)
-separate_last' :: [a] -> ([a],Maybe a)
-separate_last' x =
-    case reverse x of
-      [] -> ([],Nothing)
-      e:x' -> (reverse x',Just e)
-
--- | Error on null input.
---
--- > separate_last [1..5] == ([1..4],5)
-separate_last :: [a] -> ([a],a)
-separate_last = fmap (fromMaybe (error "separate_last")) . separate_last'
-
--- | Replace directly repeated elements with 'Nothing'.
---
--- > indicate_repetitions "abba" == [Just 'a',Just 'b',Nothing,Just 'a']
-indicate_repetitions :: Eq a => [a] -> [Maybe a]
-indicate_repetitions =
-    let f l = case l of
-                [] -> []
-                e:l' -> Just e : map (const Nothing) l'
-    in concatMap f . group
-
--- | 'zipWith' of list and it's own tail.
---
--- > zip_with_adj (,) "abcde" == [('a','b'),('b','c'),('c','d'),('d','e')]
-zip_with_adj :: (a -> a -> b) -> [a] -> [b]
-zip_with_adj f xs = zipWith f xs (tail xs)
-
--- | Type-specialised 'zip_with_adj'.
-compare_adjacent_by :: (a -> a -> Ordering) -> [a] -> [Ordering]
-compare_adjacent_by = zip_with_adj
-
--- | 'compare_adjacent_by' of 'compare'.
---
--- > compare_adjacent [0,1,3,2] == [LT,LT,GT]
-compare_adjacent :: Ord a => [a] -> [Ordering]
-compare_adjacent = compare_adjacent_by compare
-
--- | 'Data.List.groupBy' does not make adjacent comparisons, it
--- compares each new element to the start of the group.  This function
--- is the adjacent variant.
---
--- > groupBy (<) [1,2,3,2,4,1,5,9] == [[1,2,3,2,4],[1,5,9]]
--- > adjacent_groupBy (<) [1,2,3,2,4,1,5,9] == [[1,2,3],[2,4],[1,5,9]]
-adjacent_groupBy :: (a -> a -> Bool) -> [a] -> [[a]]
-adjacent_groupBy f p =
-    case p of
-      [] -> []
-      [x] -> [[x]]
-      x:y:p' -> let r = adjacent_groupBy f (y:p')
-                    r0:r' = r
-                in if f x y
-                   then (x:r0) : r'
-                   else [x] : r
-
--- | Reduce sequences of consecutive values to ranges.
---
--- > group_ranges [-1,0,3,4,5,8,9,12] == [(-1,0),(3,5),(8,9),(12,12)]
--- > group_ranges [3,2,3,4,3] == [(3,3),(2,4),(3,3)]
-group_ranges :: (Num t, Eq t) => [t] -> [(t,t)]
-group_ranges =
-    let f l = (head l,last l)
-    in map f . adjacent_groupBy (\p q -> p + 1 == q)
-
--- | 'groupBy' on /structure/ of 'Maybe', ie. all 'Just' compare equal.
---
--- > let r = [[Just 1],[Nothing,Nothing],[Just 4,Just 5]]
--- > in group_just [Just 1,Nothing,Nothing,Just 4,Just 5] == r
-group_just :: [Maybe a] -> [[Maybe a]]
-group_just = group_on isJust
-
--- | Predicate to determine if all elements of the list are '=='.
---
--- > all_equal "aaa" == True
-all_equal :: Eq a => [a] -> Bool
-all_equal l =
-    case l of
-      [] -> True
-      [_] -> True
-      x:xs -> all id (map (== x) xs)
-
--- | Variant using 'nub'.
-all_eq :: Eq n => [n] -> Bool
-all_eq = (== 1) . length . nub
-
--- | 'group_on' of 'sortOn'.
---
--- > let r = [[('1','a'),('1','c')],[('2','d')],[('3','b'),('3','e')]]
--- > in sort_group_on fst (zip "13123" "abcde") == r
-sort_group_on :: Ord b => (a -> b) -> [a] -> [[a]]
-sort_group_on f = group_on f . sortOn f
-
--- | Maybe cons element onto list.
---
--- > Nothing `mcons` "something" == "something"
--- > Just 's' `mcons` "omething" == "something"
-mcons :: Maybe a -> [a] -> [a]
-mcons e l = maybe l (:l) e
-
--- * Ordering
-
--- | Comparison function type.
-type Compare_F a = a -> a -> Ordering
-
--- | If /f/ compares 'EQ', defer to /g/.
-two_stage_compare :: Compare_F a -> Compare_F a -> Compare_F a
-two_stage_compare f g p q =
-    case f p q of
-      EQ -> g p q
-      r -> r
-
--- | Sequence of comparison functions, continue comparing until not EQ.
---
--- > compare (1,0) (0,1) == GT
--- > n_stage_compare [compare `on` snd,compare `on` fst] (1,0) (0,1) == LT
-n_stage_compare :: [Compare_F a] -> Compare_F a
-n_stage_compare l p q =
-    case l of
-      [] -> EQ
-      f:l' -> case f p q of
-                EQ -> n_stage_compare l' p q
-                r -> r
-
--- | Sort sequence /a/ based on ordering of sequence /b/.
---
--- > sort_to "abc" [1,3,2] == "acb"
--- > sort_to "adbce" [1,4,2,3,5] == "abcde"
-sort_to :: Ord i => [e] -> [i] -> [e]
-sort_to e = map fst . sortOn snd . zip e
-
--- | 'flip' of 'sort_to'.
---
--- > sort_on [1,4,2,3,5] "adbce" == "abcde"
-sort_on :: Ord i => [i] -> [e] -> [e]
-sort_on = flip sort_to
-
--- | 'sortBy' of 'two_stage_compare'.
-sort_by_two_stage :: (Ord b,Ord c) => (a -> b) -> (a -> c) -> [a] -> [a]
-sort_by_two_stage f g = sortBy (two_stage_compare (compare `on` f) (compare `on` g))
-
--- | 'sortBy' of 'n_stage_compare'.
-sort_by_n_stage :: Ord b => [a -> b] -> [a] -> [a]
-sort_by_n_stage f = sortBy (n_stage_compare (map (compare `on`) f))
-
--- | Given a comparison function, merge two ascending lists.
---
--- > mergeBy compare [1,3,5] [2,4] == [1..5]
-merge_by :: Compare_F a -> [a] -> [a] -> [a]
-merge_by = O.mergeBy
-
--- | 'merge_by' 'compare' 'on'.
-merge_on :: Ord x => (a -> x) -> [a] -> [a] -> [a]
-merge_on f = merge_by (compare `on` f)
-
--- | 'O.mergeBy' of 'two_stage_compare'.
-merge_by_two_stage :: Ord b => (a -> b) -> Compare_F c -> (a -> c) -> [a] -> [a] -> [a]
-merge_by_two_stage f cmp g = O.mergeBy (two_stage_compare (compare `on` f) (cmp `on` g))
-
--- | 'mergeBy' 'compare'.
-merge :: Ord a => [a] -> [a] -> [a]
-merge = O.merge
-
--- | Merge list of sorted lists given comparison function.  Note that
--- this is not equal to 'O.mergeAll'.
-merge_set_by :: (a -> a -> Ordering) -> [[a]] -> [a]
-merge_set_by f = foldr (merge_by f) []
-
--- | 'merge_set_by' of 'compare'.
---
--- > merge_set [[1,3,5,7,9],[2,4,6,8],[10]] == [1..10]
-merge_set :: Ord a => [[a]] -> [a]
-merge_set = merge_set_by compare
-
-{-| 'merge_by' variant that joins (resolves) equal elements.
-
-> let {left p _ = p
->     ;right _ q = q
->     ;cmp = compare `on` fst
->     ;p = zip [1,3,5] "abc"
->     ;q = zip [1,2,3] "ABC"
->     ;left_r = [(1,'a'),(2,'B'),(3,'b'),(5,'c')]
->     ;right_r = [(1,'A'),(2,'B'),(3,'C'),(5,'c')]}
-> in merge_by_resolve left cmp p q == left_r &&
->    merge_by_resolve right cmp p q == right_r
-
--}
-merge_by_resolve :: (a -> a -> a) -> Compare_F a -> [a] -> [a] -> [a]
-merge_by_resolve jn cmp =
-    let recur p q =
-            case (p,q) of
-              ([],_) -> q
-              (_,[]) -> p
-              (l:p',r:q') -> case cmp l r of
-                               LT -> l : recur p' q
-                               EQ -> jn l r : recur p' q'
-                               GT -> r : recur p q'
-    in recur
-
--- | First non-ascending pair of elements.
-find_non_ascending :: (a -> a -> Ordering) -> [a] -> Maybe (a,a)
-find_non_ascending cmp xs =
-    case xs of
-      p:q:xs' -> if cmp p q == GT then Just (p,q) else find_non_ascending cmp (q:xs')
-      _ -> Nothing
-
--- | 'isNothing' of 'find_non_ascending'.
-is_ascending_by :: (a -> a -> Ordering) -> [a] -> Bool
-is_ascending_by cmp = isNothing . find_non_ascending cmp
-
--- | 'is_ascending_by' 'compare'.
-is_ascending :: Ord a => [a] -> Bool
-is_ascending = is_ascending_by compare
-
--- | Variant of `elem` that operates on a sorted list, halting.
---   This is 'O.member'.
---
--- > 16 `elem_ordered` [1,3 ..] == False
--- > 16 `elem` [1,3 ..] == undefined
-elem_ordered :: Ord t => t -> [t] -> Bool
-elem_ordered = O.member
-
--- | Variant of `elemIndex` that operates on a sorted list, halting.
---
--- > 16 `elemIndex_ordered` [1,3 ..] == Nothing
--- > 16 `elemIndex_ordered` [0,1,4,9,16,25,36,49,64,81,100] == Just 4
-elemIndex_ordered :: Ord t => t -> [t] -> Maybe Int
-elemIndex_ordered e =
-    let recur k l =
-            case l of
-              [] -> Nothing
-              x:l' -> if e == x
-                      then Just k
-                      else if x > e
-                           then Nothing
-                           else recur (k + 1) l'
-    in recur 0
-
--- | Keep right variant of 'zipWith', where unused rhs values are returned.
---
--- > zip_with_kr (,) [1..3] ['a'..'e'] == ([(1,'a'),(2,'b'),(3,'c')],"de")
-zip_with_kr :: (a -> b -> c) -> [a] -> [b] -> ([c],[b])
-zip_with_kr f =
-    let go r p q =
-            case (p,q) of
-              (i:p',j:q') -> go (f i j : r) p' q'
-              _ -> (reverse r,q)
-    in go []
-
--- | A 'zipWith' variant that always consumes an element from the left
--- hand side (lhs), but only consumes an element from the right hand
--- side (rhs) if the zip function is 'Right' and not if 'Left'.
--- There's also a secondary function to continue if the rhs ends
--- before the lhs.
-zip_with_perhaps_rhs :: (a -> b -> Either c c) -> (a -> c) -> [a] -> [b] -> [c]
-zip_with_perhaps_rhs f g lhs rhs =
-    case (lhs,rhs) of
-      ([],_) -> []
-      (_,[]) -> map g lhs
-      (p:lhs',q:rhs') -> case f p q of
-                           Left r -> r : zip_with_perhaps_rhs f g lhs' rhs
-                           Right r -> r : zip_with_perhaps_rhs f g lhs' rhs'
-
--- | Fill gaps in a sorted association list, range is inclusive at both ends.
---
--- > let r = [(1,'a'),(2,'x'),(3,'x'),(4,'x'),(5,'b'),(6,'x'),(7,'c'),(8,'x'),(9,'x')]
--- > in fill_gaps_ascending' 'x' (1,9) (zip [1,5,7] "abc") == r
-fill_gaps_ascending :: (Enum n, Ord n) => t -> (n,n) -> [(n,t)] -> [(n,t)]
-fill_gaps_ascending def_e (l,r) =
-    let f i (j,e) = if j > i then Left (i,def_e) else Right (j,e)
-        g i = (i,def_e)
-    in zip_with_perhaps_rhs f g [l .. r]
-
--- | Direct definition.
-fill_gaps_ascending' :: (Num n,Enum n, Ord n) => t -> (n,n) -> [(n,t)] -> [(n,t)]
-fill_gaps_ascending' def (l,r) =
-    let recur n x =
-            if n > r
-            then []
-            else case x of
-                   [] -> zip [n .. r] (repeat def)
-                   (m,e):x' -> if n < m
-                               then (n,def) : recur (n + 1) x
-                               else (m,e) : recur (n + 1) x'
-    in recur l
-
--- | 'minimum' and 'maximum' in one pass.
---
--- > minmax "minimumandmaximum" == ('a','x')
-minmax :: Ord t => [t] -> (t,t)
-minmax inp =
-    case inp of
-      [] -> error "minmax: null"
-      x:xs -> let mm p (l,r) = (min p l,max p r) in foldr mm (x,x) xs
-
--- * Bimap
-
--- | Apply /f/ to both elements of a two-tuple, ie. 'bimap' /f/ /f/.
-bimap1 :: (t -> u) -> (t,t) -> (u,u)
-bimap1 f (p,q) = (f p,f q)
-
--- | Append /k/ to the right of /l/ until result has /n/ places.
---
--- > map (pad_right '0' 2 . return) ['0' .. '9']
--- > pad_right '0' 12 "1101" == "110100000000"
--- > map (pad_right ' '3) ["S","E-L"] == ["S  ","E-L"]
-pad_right :: a -> Int -> [a] -> [a]
-pad_right k n l = take n (l ++ repeat k)
-
--- | Append /k/ to the left of /l/ until result has /n/ places.
---
--- > map (pad_left '0' 2 . return) ['0' .. '9']
-pad_left :: a -> Int -> [a] -> [a]
-pad_left k n l = replicate (n - length l) k ++ l
-
--- * Embedding
-
--- | Locate first (leftmost) embedding of /q/ in /p/.
--- Return partial indices for failure at 'Left'.
---
--- > embedding ("embedding","ming") == Right [1,6,7,8]
--- > embedding ("embedding","mind") == Left [1,6,7]
-embedding :: Eq t => ([t],[t]) -> Either [Int] [Int]
-embedding =
-    let recur n r (p,q) =
-            case (p,q) of
-              (_,[]) -> Right (reverse r)
-              ([],_) -> Left (reverse r)
-              (x:p',y:q') ->
-                  let n' = n + 1
-                      r' = if x == y then n : r else r
-                  in recur n' r' (p',if x == y then q' else q)
-    in recur 0 []
-
-embedding_err :: Eq t => ([t],[t]) -> [Int]
-embedding_err = either (error "embedding_err") id . embedding
-
--- | Does /q/ occur in sequence, though not necessarily adjacently, in /p/.
---
--- > is_embedding [1 .. 9] [1,3,7] == True
--- > is_embedding "embedding" "ming" == True
--- > is_embedding "embedding" "mind" == False
-is_embedding :: Eq t => [t] -> [t] -> Bool
-is_embedding p q = isRight (embedding (p,q))
-
-all_embeddings_m :: (Eq t,L.MonadLogic m) => [t] -> [t] -> m [Int]
-all_embeddings_m p q =
-    let q_n = length q
-        recur p' q' n k = -- n = length k
-            if n == q_n
-            then return (reverse k)
-            else do (m,c) <- L.msum (map return p')
-                    let k0:_ = k
-                        c':_ = q'
-                    L.guard (c == c' && (null k || m > k0))
-                    let _:p'' = p'
-                        _:q'' = q'
-                    recur p'' q'' (n + 1) (m : k)
-    in recur (zip [0..] p) q 0 []
-
--- | Enumerate indices for all embeddings of /q/ in /p/.
---
--- > all_embeddings "all_embeddings" "leg" == [[1,4,12],[1,7,12],[2,4,12],[2,7,12]]
-all_embeddings :: Eq t => [t] -> [t] -> [[Int]]
-all_embeddings p = L.observeAll . all_embeddings_m p
-
--- * Un-list
-
--- | Unpack one element list.
-unlist1 :: [t] -> Maybe t
-unlist1 l =
-    case l of
-      [e] -> Just e
-      _ -> Nothing
-
--- | Erroring variant.
-unlist1_err :: [t] -> t
-unlist1_err = fromMaybe (error "unlist1") . unlist1
-
--- * Traversable
-
--- | Replace elements at 'Traversable' with result of joining with elements from list.
---
--- > let t = Node 0 [Node 1 [Node 2 [],Node 3 []],Node 4 []]
--- > putStrLn $ drawTree (fmap show t)
--- > let u = (adopt_shape (\_ x -> x) "abcde" t)
--- > putStrLn $ drawTree (fmap return u)
-adopt_shape :: T.Traversable t => (a -> b -> c) -> [b] -> t a -> t c
-adopt_shape jn l =
-    let f (i:j) k = (j,jn k i)
-        f [] _ = error "adopt_shape: rhs ends"
-    in snd . T.mapAccumL f l
-
--- | Variant of 'adopt_shape' that considers only 'Just' elements at 'Traversable'.
---
--- > let {s = "a(b(cd)ef)ghi"
--- >     ;t = group_tree (begin_end_cmp_eq '(' ')') s}
--- > in adopt_shape_m (,) [1..13] t
-adopt_shape_m :: T.Traversable t => (a -> b-> c) -> [b] -> t (Maybe a) -> t (Maybe c)
-adopt_shape_m jn l =
-    let f (i:j) k = case k of
-                      Nothing -> (i:j,Nothing)
-                      Just k' -> (j,Just (jn k' i))
-        f [] _ = error "adopt_shape_m: rhs ends"
-    in snd . T.mapAccumL f l
-
--- * Tree
-
-{- | Given an 'Ordering' predicate where 'LT' opens a group, 'GT'
-closes a group, and 'EQ' continues current group, construct tree
-from list.
-
-> let {l = "a {b {c d} e f} g h i"
->     ;t = group_tree ((==) '{',(==) '}') l}
-> in catMaybes (flatten t) == l
-
-> let {d = putStrLn . drawTree . fmap show}
-> in d (group_tree ((==) '(',(==) ')') "a(b(cd)ef)ghi")
-
--}
-group_tree :: (a -> Bool,a -> Bool) -> [a] -> Tree (Maybe a)
-group_tree (open_f,close_f) =
-    let unit e = Node (Just e) []
-        nil = Node Nothing []
-        insert_e (Node t l) e = Node t (e:l)
-        reverse_n (Node t l) = Node t (reverse l)
-        do_push (r,z) e =
-            case z of
-              h:z' -> (r,insert_e h (unit e) : z')
-              [] -> (unit e : r,[])
-        do_open (r,z) = (r,nil:z)
-        do_close (r,z) =
-            case z of
-              h0:h1:z' -> (r,insert_e h1 (reverse_n h0) : z')
-              h:z' -> (reverse_n h : r,z')
-              [] -> (r,z)
-        go st x =
-            case x of
-              [] -> Node Nothing (reverse (fst st))
-              e:x' -> if open_f e
-                      then go (do_push (do_open st) e) x'
-                      else if close_f e
-                           then go (do_close (do_push st e)) x'
-                           else go (do_push st e) x'
-    in go ([],[])
-
--- * Indexing
-
--- | Remove element at index.
---
--- > remove_ix 5 "remove" == "remov"
--- > remove_ix 5 "short" == undefined
-remove_ix :: Int -> [a] -> [a]
-remove_ix k l = let (p,q) = splitAt k l in p ++ tail q
-
-operate_ixs :: Bool -> [Int] -> [a] -> [a]
-operate_ixs mode k =
-    let sel = if mode then notElem else elem
-        f (n,e) = if n `sel` k then Nothing else Just e
-    in mapMaybe f . zip [0..]
-
--- > select_ixs [1,3] "select" == "ee"
-select_ixs :: [Int] -> [a] -> [a]
-select_ixs = operate_ixs True
-
--- > remove_ixs [1,3,5] "remove" == "rmv"
-remove_ixs :: [Int] -> [a] -> [a]
-remove_ixs = operate_ixs False
-
--- | Replace element at /i/ in /p/ by application of /f/.
---
--- > replace_ix negate 1 [1..3] == [1,-2,3]
-replace_ix :: (a -> a) -> Int -> [a] -> [a]
-replace_ix f i p =
-    let (q,r:s) = splitAt i p
-    in q ++ (f r : s)
-
--- | Cyclic indexing function.
---
--- > map (at_cyclic "cycle") [0..9] == "cyclecycle"
-at_cyclic :: [a] -> Int -> a
-at_cyclic l n =
-    let m = Map.fromList (zip [0..] l)
-        k = Map.size m
-        n' = n `mod` k
-    in fromMaybe (error "cyc_at") (Map.lookup n' m)
-
diff --git a/Music/Theory/List/Logic.hs b/Music/Theory/List/Logic.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/List/Logic.hs
@@ -0,0 +1,29 @@
+-- | List/Logic functions.
+module Music.Theory.List.Logic where
+
+import Control.Monad {- base -}
+
+import qualified Control.Monad.Logic as L {- logict -}
+
+-- | 'L.MonadLogic' value to enumerate indices for all embeddings of /q/ in /p/.
+all_embeddings_m :: (Eq t, MonadPlus m, L.MonadLogic m) => [t] -> [t] -> m [Int]
+all_embeddings_m p q =
+    let q_n = length q
+        recur p' q' n k = -- n = length k
+            if n == q_n
+            then return (reverse k)
+            else do (m,c) <- msum (map return p')
+                    let k0 = head k
+                        c' = head q'
+                    guard (c == c' && (null k || m > k0))
+                    let p'' = tail p'
+                        q'' = tail q'
+                    recur p'' q'' (n + 1) (m : k)
+    in recur (zip [0..] p) q 0 []
+
+-- | 'L.observeAll' of 'all_embeddings_m'
+--
+-- > all_embeddings "all_embeddings" "leg" == [[1,4,12],[1,7,12],[2,4,12],[2,7,12]]
+all_embeddings :: Eq t => [t] -> [t] -> [[Int]]
+all_embeddings p = L.observeAll . all_embeddings_m p
+
diff --git a/Music/Theory/Map.hs b/Music/Theory/Map.hs
deleted file mode 100644
--- a/Music/Theory/Map.hs
+++ /dev/null
@@ -1,17 +0,0 @@
--- | Map functions.
-module Music.Theory.Map where
-
-import qualified Data.Map as M {- containers -}
-import Data.Maybe {- base -}
-
--- | Erroring 'M.lookup'.
-map_lookup_err :: Ord k => k -> M.Map k c -> c
-map_lookup_err k = fromMaybe (error "M.lookup") . M.lookup k
-
--- | 'flip' of 'M.lookup'.
-map_ix :: Ord k => M.Map k c -> k -> Maybe c
-map_ix = flip M.lookup
-
--- | 'flip' of 'map_lookup_err'.
-map_ix_err :: Ord k => M.Map k c -> k -> c
-map_ix_err = flip map_lookup_err
diff --git a/Music/Theory/Math.hs b/Music/Theory/Math.hs
deleted file mode 100644
--- a/Music/Theory/Math.hs
+++ /dev/null
@@ -1,207 +0,0 @@
--- | Math functions.
-module Music.Theory.Math where
-
-import Data.Maybe {- base -}
-import Data.Ratio {- base -}
-import Numeric {- base -}
-
-import qualified Music.Theory.Math.Convert as T
-
--- | Real (alias for 'Double').
-type R = Double
-
--- | <http://reference.wolfram.com/mathematica/ref/FractionalPart.html>
---
--- > integral_and_fractional_parts 1.5 == (1,0.5)
-integral_and_fractional_parts :: (Integral i, RealFrac t) => t -> (i,t)
-integral_and_fractional_parts n =
-    if n >= 0
-    then let n' = floor n in (n',n - fromIntegral n')
-    else let n' = ceiling n in (n',n - fromIntegral n')
-
--- | Type specialised.
-integer_and_fractional_parts :: RealFrac t => t -> (Integer,t)
-integer_and_fractional_parts = integral_and_fractional_parts
-
--- | <http://reference.wolfram.com/mathematica/ref/FractionalPart.html>
---
--- > import Sound.SC3.Plot {- hsc3-plot -}
--- > plotTable1 (map fractional_part [-2.0,-1.99 .. 2.0])
-fractional_part :: RealFrac a => a -> a
-fractional_part = snd . integer_and_fractional_parts
-
--- | 'floor' of 'T.real_to_double'.
-real_floor :: (Real r,Integral i)  => r -> i
-real_floor = floor . T.real_to_double
-
--- | Type specialised 'real_floor'.
-real_floor_int :: Real r => r -> Int
-real_floor_int = real_floor
-
--- | 'round' of 'T.real_to_double'.
-real_round :: (Real r,Integral i)  => r -> i
-real_round = round . T.real_to_double
-
--- | Type specialised 'real_round'.
-real_round_int :: Real r => r -> Int
-real_round_int = real_round
-
--- | Is /r/ zero to /k/ decimal places.
---
--- > map (flip zero_to_precision 0.00009) [4,5] == [True,False]
--- > zero_to_precision 4 1.00009 == False
-zero_to_precision :: Real r => Int -> r -> Bool
-zero_to_precision k r = real_floor_int (r * (fromIntegral ((10::Int) ^ k))) == 0
-
--- | Is /r/ whole to /k/ decimal places.
---
--- > map (flip whole_to_precision 1.00009) [4,5] == [True,False]
-whole_to_precision :: Real r => Int -> r -> Bool
-whole_to_precision k = zero_to_precision k . fractional_part . T.real_to_double
-
--- | <http://reference.wolfram.com/mathematica/ref/SawtoothWave.html>
---
--- > plotTable1 (map sawtooth_wave [-2.0,-1.99 .. 2.0])
-sawtooth_wave :: RealFrac a => a -> a
-sawtooth_wave n = n - floor_f n
-
--- | Pretty printer for 'Rational' that elides denominators of @1@.
---
--- > map rational_pp [1,3/2,2] == ["1","3/2","2"]
-rational_pp :: (Show a,Integral a) => Ratio a -> String
-rational_pp r =
-    let n = numerator r
-        d = denominator r
-    in if d == 1
-       then show n
-       else concat [show n,"/",show d]
-
--- | Pretty print ratio as @:@ separated integers.
---
--- > map ratio_pp [1,3/2,2] == ["1:1","3:2","2:1"]
-ratio_pp :: Rational -> String
-ratio_pp r =
-    let (n,d) = rational_nd r
-    in concat [show n,":",show d]
-
--- | Predicate that is true if @n/d@ can be simplified, ie. where
--- 'gcd' of @n@ and @d@ is not @1@.
---
--- > let r = [False,True,False]
--- > in map rational_simplifies [(2,3),(4,6),(5,7)] == r
-rational_simplifies :: Integral a => (a,a) -> Bool
-rational_simplifies (n,d) = gcd n d /= 1
-
--- | 'numerator' and 'denominator' of rational.
-rational_nd :: Ratio t -> (t,t)
-rational_nd r = (numerator r,denominator r)
-
--- | Rational as a whole number, or 'Nothing'.
-rational_whole :: Integral a => Ratio a -> Maybe a
-rational_whole r = if denominator r == 1 then Just (numerator r) else Nothing
-
--- | Erroring variant.
-rational_whole_err :: Integral a => Ratio a -> a
-rational_whole_err = fromMaybe (error "rational_whole") . rational_whole
-
--- | Show rational to /n/ decimal places.
---
--- > let r = approxRational pi 1e-100
--- > r == 884279719003555 / 281474976710656
--- > show_rational_decimal 12 r == "3.141592653590"
-show_rational_decimal :: Int -> Rational -> String
-show_rational_decimal n r =
-    let d = round (abs r * 10^n)
-        s = show (d :: Integer)
-        s' = replicate (n - length s + 1) '0' ++ s
-        (h, f) = splitAt (length s' - n) s'
-    in  (if r < 0 then "-" else "") ++ h ++ "." ++ f
-
--- | Variant of 'showFFloat'.  The 'Show' instance for floats resorts
--- to exponential notation very readily.
---
--- > [show 0.01,realfloat_pp 2 0.01] == ["1.0e-2","0.01"]
-realfloat_pp :: RealFloat a => Int -> a -> String
-realfloat_pp k n = showFFloat (Just k) n ""
-
--- | Show /r/ as float to /k/ places.
-real_pp :: Real t => Int -> t -> String
-real_pp k t = showFFloat (Just k) (T.real_to_double t) ""
-
--- | Type specialised 'realfloat_pp'.
-float_pp :: Int -> Float -> String
-float_pp = realfloat_pp
-
--- | Type specialised 'realfloat_pp'.
-double_pp :: Int -> Double -> String
-double_pp = realfloat_pp
-
--- | Show /only/ positive and negative values, always with sign.
---
--- > map num_diff_str [-2,-1,0,1,2] == ["-2","-1","","+1","+2"]
--- > map show [-2,-1,0,1,2] == ["-2","-1","0","1","2"]
-num_diff_str :: (Num a, Ord a, Show a) => a -> String
-num_diff_str n =
-    case compare n 0 of
-      LT -> '-' : show (abs n)
-      EQ -> ""
-      GT -> '+' : show n
-
--- | 'fromInteger' . 'floor'.
-floor_f :: (RealFrac a, Num b) => a -> b
-floor_f = fromInteger . floor
-
--- | Round /b/ to nearest multiple of /a/.
---
--- > map (round_to 0.25) [0,0.1 .. 1] == [0.0,0.0,0.25,0.25,0.5,0.5,0.5,0.75,0.75,1.0,1.0]
--- > map (round_to 25) [0,10 .. 100] == [0,0,25,25,50,50,50,75,75,100,100]
-round_to :: RealFrac n => n -> n -> n
-round_to a b = if a == 0 then b else floor_f ((b / a) + 0.5) * a
-
--- * One-indexed
-
--- | One-indexed 'mod' function.
---
--- > map (`oi_mod` 5) [1..10] == [1,2,3,4,5,1,2,3,4,5]
-oi_mod :: Integral a => a -> a -> a
-oi_mod n m = ((n - 1) `mod` m) + 1
-
--- | One-indexed 'divMod' function.
---
--- > map (`oi_divMod` 5) [1,3 .. 9] == [(0,1),(0,3),(0,5),(1,2),(1,4)]
-oi_divMod :: Integral t => t -> t -> (t, t)
-oi_divMod n m = let (i,j) = (n - 1) `divMod` m in (i,j + 1)
-
--- * I = integral
-
--- | Integral square root function.
---
--- > map i_square_root [0,1,4,9,16,25,36,49,64,81,100] == [0 .. 10]
--- > map i_square_root [4 .. 16] == [2,2,2,2,2,3,3,3,3,3,3,3,4]
-i_square_root :: Integral t => t -> t
-i_square_root n =
-    let babylon a =
-            let b  = quot (a + quot n a) 2
-            in if a > b then babylon b else a
-    in case compare n 0 of
-         GT -> babylon n
-         EQ -> 0
-         _ -> error "i_square_root: negative?"
-
--- * Interval
-
--- | (0,1) = {x | 0 < x < 1}
-in_open_interval :: Ord a => (a, a) -> a -> Bool
-in_open_interval (p,q) n = p < n && n < q
-
--- | [0,1] = {x | 0 ≤ x ≤ 1}
-in_closed_interval :: Ord a => (a, a) -> a -> Bool
-in_closed_interval (p,q) n = p <= n && n <= q
-
--- | (p,q] (0,1] = {x | 0 < x ≤ 1}
-in_left_half_open_interval :: Ord a => (a, a) -> a -> Bool
-in_left_half_open_interval (p,q) n = p < n && n <= q
-
--- | [p,q) [0,1) = {x | 0 ≤ x < 1}
-in_right_half_open_interval :: Ord a => (a, a) -> a -> Bool
-in_right_half_open_interval (p,q) n = p <= n && n < q
diff --git a/Music/Theory/Math/Convert.hs b/Music/Theory/Math/Convert.hs
deleted file mode 100644
--- a/Music/Theory/Math/Convert.hs
+++ /dev/null
@@ -1,1121 +0,0 @@
-{- | Specialised type conversions, see mk/mk-convert.hs
-
-> map int_to_word8 [-1,0,255,256] == [255,0,255,0]
-> map int_to_word8_maybe [-1,0,255,256] == [Nothing,Just 0,Just 255,Nothing]
-
-> map integer_to_int64_maybe [-2 ^ 63 - 1,2 ^ 63] == [Nothing,Nothing]
-> map integer_to_word64_maybe [2 ^64 - 1,2 ^ 64] == [Just 18446744073709551615,Nothing]
-
-> map int16_to_float [-1,0,1] == [-1,0,1]
-
--}
-module Music.Theory.Math.Convert where
-
-import Data.Int {- base -}
-import Data.Word {- base -}
-
--- | Type specialised 'realToFrac'
-real_to_float :: Real t => t -> Float
-real_to_float = realToFrac
-
--- | Type specialised 'realToFrac'
-real_to_double :: Real t => t -> Double
-real_to_double = realToFrac
-
--- | Type specialised 'realToFrac'
-double_to_float :: Double -> Float
-double_to_float = realToFrac
-
--- | Type specialised 'realToFrac'
-float_to_double :: Float -> Double
-float_to_double = realToFrac
-
--- AUTOGEN (see mk/mk-convert.hs)
-
--- | Type specialised 'fromIntegral'
-word8_to_word16 :: Word8 -> Word16
-word8_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_word32 :: Word8 -> Word32
-word8_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_word64 :: Word8 -> Word64
-word8_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_int8 :: Word8 -> Int8
-word8_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_int16 :: Word8 -> Int16
-word8_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_int32 :: Word8 -> Int32
-word8_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_int64 :: Word8 -> Int64
-word8_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_int :: Word8 -> Int
-word8_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_integer :: Word8 -> Integer
-word8_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_float :: Word8 -> Float
-word8_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_double :: Word8 -> Double
-word8_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_word8 :: Word16 -> Word8
-word16_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_word32 :: Word16 -> Word32
-word16_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_word64 :: Word16 -> Word64
-word16_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_int8 :: Word16 -> Int8
-word16_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_int16 :: Word16 -> Int16
-word16_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_int32 :: Word16 -> Int32
-word16_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_int64 :: Word16 -> Int64
-word16_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_int :: Word16 -> Int
-word16_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_integer :: Word16 -> Integer
-word16_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_float :: Word16 -> Float
-word16_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word16_to_double :: Word16 -> Double
-word16_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_word8 :: Word32 -> Word8
-word32_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_word16 :: Word32 -> Word16
-word32_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_word64 :: Word32 -> Word64
-word32_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_int8 :: Word32 -> Int8
-word32_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_int16 :: Word32 -> Int16
-word32_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_int32 :: Word32 -> Int32
-word32_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_int64 :: Word32 -> Int64
-word32_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_int :: Word32 -> Int
-word32_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_integer :: Word32 -> Integer
-word32_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_float :: Word32 -> Float
-word32_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word32_to_double :: Word32 -> Double
-word32_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_word8 :: Word64 -> Word8
-word64_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_word16 :: Word64 -> Word16
-word64_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_word32 :: Word64 -> Word32
-word64_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_int8 :: Word64 -> Int8
-word64_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_int16 :: Word64 -> Int16
-word64_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_int32 :: Word64 -> Int32
-word64_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_int64 :: Word64 -> Int64
-word64_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_int :: Word64 -> Int
-word64_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_integer :: Word64 -> Integer
-word64_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_float :: Word64 -> Float
-word64_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word64_to_double :: Word64 -> Double
-word64_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_word8 :: Int8 -> Word8
-int8_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_word16 :: Int8 -> Word16
-int8_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_word32 :: Int8 -> Word32
-int8_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_word64 :: Int8 -> Word64
-int8_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_int16 :: Int8 -> Int16
-int8_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_int32 :: Int8 -> Int32
-int8_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_int64 :: Int8 -> Int64
-int8_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_int :: Int8 -> Int
-int8_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_integer :: Int8 -> Integer
-int8_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_float :: Int8 -> Float
-int8_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int8_to_double :: Int8 -> Double
-int8_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_word8 :: Int16 -> Word8
-int16_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_word16 :: Int16 -> Word16
-int16_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_word32 :: Int16 -> Word32
-int16_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_word64 :: Int16 -> Word64
-int16_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_int8 :: Int16 -> Int8
-int16_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_int32 :: Int16 -> Int32
-int16_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_int64 :: Int16 -> Int64
-int16_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_int :: Int16 -> Int
-int16_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_integer :: Int16 -> Integer
-int16_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_float :: Int16 -> Float
-int16_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int16_to_double :: Int16 -> Double
-int16_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_word8 :: Int32 -> Word8
-int32_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_word16 :: Int32 -> Word16
-int32_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_word32 :: Int32 -> Word32
-int32_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_word64 :: Int32 -> Word64
-int32_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_int8 :: Int32 -> Int8
-int32_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_int16 :: Int32 -> Int16
-int32_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_int64 :: Int32 -> Int64
-int32_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_int :: Int32 -> Int
-int32_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_integer :: Int32 -> Integer
-int32_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_float :: Int32 -> Float
-int32_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int32_to_double :: Int32 -> Double
-int32_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_word8 :: Int64 -> Word8
-int64_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_word16 :: Int64 -> Word16
-int64_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_word32 :: Int64 -> Word32
-int64_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_word64 :: Int64 -> Word64
-int64_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_int8 :: Int64 -> Int8
-int64_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_int16 :: Int64 -> Int16
-int64_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_int32 :: Int64 -> Int32
-int64_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_int :: Int64 -> Int
-int64_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_integer :: Int64 -> Integer
-int64_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_float :: Int64 -> Float
-int64_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int64_to_double :: Int64 -> Double
-int64_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_word8 :: Int -> Word8
-int_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_word16 :: Int -> Word16
-int_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_word32 :: Int -> Word32
-int_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_word64 :: Int -> Word64
-int_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_int8 :: Int -> Int8
-int_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_int16 :: Int -> Int16
-int_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_int32 :: Int -> Int32
-int_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_int64 :: Int -> Int64
-int_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_integer :: Int -> Integer
-int_to_integer = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_float :: Int -> Float
-int_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-int_to_double :: Int -> Double
-int_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_word8 :: Integer -> Word8
-integer_to_word8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_word16 :: Integer -> Word16
-integer_to_word16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_word32 :: Integer -> Word32
-integer_to_word32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_word64 :: Integer -> Word64
-integer_to_word64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_int8 :: Integer -> Int8
-integer_to_int8 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_int16 :: Integer -> Int16
-integer_to_int16 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_int32 :: Integer -> Int32
-integer_to_int32 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_int64 :: Integer -> Int64
-integer_to_int64 = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_int :: Integer -> Int
-integer_to_int = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_float :: Integer -> Float
-integer_to_float = fromIntegral
-
--- | Type specialised 'fromIntegral'
-integer_to_double :: Integer -> Double
-integer_to_double = fromIntegral
-
--- | Type specialised 'fromIntegral'
-word8_to_word16_maybe :: Word8 -> Maybe Word16
-word8_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_word32_maybe :: Word8 -> Maybe Word32
-word8_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_word64_maybe :: Word8 -> Maybe Word64
-word8_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_int8_maybe :: Word8 -> Maybe Int8
-word8_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_int16_maybe :: Word8 -> Maybe Int16
-word8_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_int32_maybe :: Word8 -> Maybe Int32
-word8_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_int64_maybe :: Word8 -> Maybe Int64
-word8_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word8_to_int_maybe :: Word8 -> Maybe Int
-word8_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_word8_maybe :: Word16 -> Maybe Word8
-word16_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_word32_maybe :: Word16 -> Maybe Word32
-word16_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_word64_maybe :: Word16 -> Maybe Word64
-word16_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_int8_maybe :: Word16 -> Maybe Int8
-word16_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_int16_maybe :: Word16 -> Maybe Int16
-word16_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_int32_maybe :: Word16 -> Maybe Int32
-word16_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_int64_maybe :: Word16 -> Maybe Int64
-word16_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word16_to_int_maybe :: Word16 -> Maybe Int
-word16_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_word8_maybe :: Word32 -> Maybe Word8
-word32_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_word16_maybe :: Word32 -> Maybe Word16
-word32_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_word64_maybe :: Word32 -> Maybe Word64
-word32_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_int8_maybe :: Word32 -> Maybe Int8
-word32_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_int16_maybe :: Word32 -> Maybe Int16
-word32_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_int32_maybe :: Word32 -> Maybe Int32
-word32_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_int64_maybe :: Word32 -> Maybe Int64
-word32_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word32_to_int_maybe :: Word32 -> Maybe Int
-word32_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_word8_maybe :: Word64 -> Maybe Word8
-word64_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_word16_maybe :: Word64 -> Maybe Word16
-word64_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_word32_maybe :: Word64 -> Maybe Word32
-word64_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_int8_maybe :: Word64 -> Maybe Int8
-word64_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_int16_maybe :: Word64 -> Maybe Int16
-word64_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_int32_maybe :: Word64 -> Maybe Int32
-word64_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_int64_maybe :: Word64 -> Maybe Int64
-word64_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-word64_to_int_maybe :: Word64 -> Maybe Int
-word64_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_word8_maybe :: Int8 -> Maybe Word8
-int8_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_word16_maybe :: Int8 -> Maybe Word16
-int8_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_word32_maybe :: Int8 -> Maybe Word32
-int8_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_word64_maybe :: Int8 -> Maybe Word64
-int8_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_int16_maybe :: Int8 -> Maybe Int16
-int8_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_int32_maybe :: Int8 -> Maybe Int32
-int8_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_int64_maybe :: Int8 -> Maybe Int64
-int8_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int8_to_int_maybe :: Int8 -> Maybe Int
-int8_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_word8_maybe :: Int16 -> Maybe Word8
-int16_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_word16_maybe :: Int16 -> Maybe Word16
-int16_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_word32_maybe :: Int16 -> Maybe Word32
-int16_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_word64_maybe :: Int16 -> Maybe Word64
-int16_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_int8_maybe :: Int16 -> Maybe Int8
-int16_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_int32_maybe :: Int16 -> Maybe Int32
-int16_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_int64_maybe :: Int16 -> Maybe Int64
-int16_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int16_to_int_maybe :: Int16 -> Maybe Int
-int16_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_word8_maybe :: Int32 -> Maybe Word8
-int32_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_word16_maybe :: Int32 -> Maybe Word16
-int32_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_word32_maybe :: Int32 -> Maybe Word32
-int32_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_word64_maybe :: Int32 -> Maybe Word64
-int32_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_int8_maybe :: Int32 -> Maybe Int8
-int32_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_int16_maybe :: Int32 -> Maybe Int16
-int32_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_int64_maybe :: Int32 -> Maybe Int64
-int32_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int32_to_int_maybe :: Int32 -> Maybe Int
-int32_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_word8_maybe :: Int64 -> Maybe Word8
-int64_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_word16_maybe :: Int64 -> Maybe Word16
-int64_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_word32_maybe :: Int64 -> Maybe Word32
-int64_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_word64_maybe :: Int64 -> Maybe Word64
-int64_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_int8_maybe :: Int64 -> Maybe Int8
-int64_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_int16_maybe :: Int64 -> Maybe Int16
-int64_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_int32_maybe :: Int64 -> Maybe Int32
-int64_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int64_to_int_maybe :: Int64 -> Maybe Int
-int64_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_word8_maybe :: Int -> Maybe Word8
-int_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_word16_maybe :: Int -> Maybe Word16
-int_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_word32_maybe :: Int -> Maybe Word32
-int_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_word64_maybe :: Int -> Maybe Word64
-int_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_int8_maybe :: Int -> Maybe Int8
-int_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_int16_maybe :: Int -> Maybe Int16
-int_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_int32_maybe :: Int -> Maybe Int32
-int_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-int_to_int64_maybe :: Int -> Maybe Int64
-int_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_word8_maybe :: Integer -> Maybe Word8
-integer_to_word8_maybe n =
-    if n < fromIntegral (minBound::Word8) ||
-       n > fromIntegral (maxBound::Word8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_word16_maybe :: Integer -> Maybe Word16
-integer_to_word16_maybe n =
-    if n < fromIntegral (minBound::Word16) ||
-       n > fromIntegral (maxBound::Word16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_word32_maybe :: Integer -> Maybe Word32
-integer_to_word32_maybe n =
-    if n < fromIntegral (minBound::Word32) ||
-       n > fromIntegral (maxBound::Word32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_word64_maybe :: Integer -> Maybe Word64
-integer_to_word64_maybe n =
-    if n < fromIntegral (minBound::Word64) ||
-       n > fromIntegral (maxBound::Word64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_int8_maybe :: Integer -> Maybe Int8
-integer_to_int8_maybe n =
-    if n < fromIntegral (minBound::Int8) ||
-       n > fromIntegral (maxBound::Int8)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_int16_maybe :: Integer -> Maybe Int16
-integer_to_int16_maybe n =
-    if n < fromIntegral (minBound::Int16) ||
-       n > fromIntegral (maxBound::Int16)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_int32_maybe :: Integer -> Maybe Int32
-integer_to_int32_maybe n =
-    if n < fromIntegral (minBound::Int32) ||
-       n > fromIntegral (maxBound::Int32)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_int64_maybe :: Integer -> Maybe Int64
-integer_to_int64_maybe n =
-    if n < fromIntegral (minBound::Int64) ||
-       n > fromIntegral (maxBound::Int64)
-    then Nothing
-    else Just (fromIntegral n)
-
--- | Type specialised 'fromIntegral'
-integer_to_int_maybe :: Integer -> Maybe Int
-integer_to_int_maybe n =
-    if n < fromIntegral (minBound::Int) ||
-       n > fromIntegral (maxBound::Int)
-    then Nothing
-    else Just (fromIntegral n)
diff --git a/Music/Theory/Math/Convert/Fx.hs b/Music/Theory/Math/Convert/Fx.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Convert/Fx.hs
@@ -0,0 +1,1286 @@
+-- | Conversion between signed and sized integral types with bounds checking.
+--   Types are aliased as Ux and Ix.
+--   Includes sizes 4 (MIDI), 7 (ASCII,MIDI), 12 (SND,AKAI), 14 (MIDI) and 24 (SND).
+--   Autogenerated: see mk/mk-convert.hs.
+module Music.Theory.Math.Convert.Fx where
+
+import Data.Int {- base -}
+import Data.Word {- base -}
+
+-- | Alias
+type U4 = Word8
+
+-- | Alias
+type U7 = Word8
+
+-- | Alias
+type U8 = Word8
+
+-- | Alias
+type U12 = Word16
+
+-- | Alias
+type U14 = Word16
+
+-- | Alias
+type U16 = Word16
+
+-- | Alias
+type U24 = Word32
+
+-- | Alias
+type U32 = Word32
+
+-- | Alias
+type U64 = Word64
+
+-- | Alias
+type I4 = Int8
+
+-- | Alias
+type I7 = Int8
+
+-- | Alias
+type I8 = Int8
+
+-- | Alias
+type I12 = Int16
+
+-- | Alias
+type I14 = Int16
+
+-- | Alias
+type I16 = Int16
+
+-- | Alias
+type I24 = Int32
+
+-- | Alias
+type I32 = Int32
+
+-- | Alias
+type I64 = Int64
+
+-- | Type specialised 'fromIntegral'
+u4_to_u7 :: U4 -> U7
+u4_to_u7 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u8 :: U4 -> U8
+u4_to_u8 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u12 :: U4 -> U12
+u4_to_u12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u14 :: U4 -> U14
+u4_to_u14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u16 :: U4 -> U16
+u4_to_u16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u24 :: U4 -> U24
+u4_to_u24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u32 :: U4 -> U32
+u4_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_u64 :: U4 -> U64
+u4_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u4_to_i4 :: U4 -> I4
+u4_to_i4 x = if x < 0 || x > 7 then error "u4_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u4_to_i7 :: U4 -> I7
+u4_to_i7 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i8 :: U4 -> I8
+u4_to_i8 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i12 :: U4 -> I12
+u4_to_i12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i14 :: U4 -> I14
+u4_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i16 :: U4 -> I16
+u4_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i24 :: U4 -> I24
+u4_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i32 :: U4 -> I32
+u4_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u4_to_i64 :: U4 -> I64
+u4_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u7_to_u4 :: U7 -> U4
+u7_to_u4 x = if x < 0 || x > 15 then error "u7_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u7_to_u8 :: U7 -> U8
+u7_to_u8 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_u12 :: U7 -> U12
+u7_to_u12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_u14 :: U7 -> U14
+u7_to_u14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_u16 :: U7 -> U16
+u7_to_u16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_u24 :: U7 -> U24
+u7_to_u24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_u32 :: U7 -> U32
+u7_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_u64 :: U7 -> U64
+u7_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u7_to_i4 :: U7 -> I4
+u7_to_i4 x = if x < 0 || x > 7 then error "u7_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u7_to_i7 :: U7 -> I7
+u7_to_i7 x = if x < 0 || x > 63 then error "u7_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u7_to_i8 :: U7 -> I8
+u7_to_i8 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_i12 :: U7 -> I12
+u7_to_i12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_i14 :: U7 -> I14
+u7_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_i16 :: U7 -> I16
+u7_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_i24 :: U7 -> I24
+u7_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_i32 :: U7 -> I32
+u7_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u7_to_i64 :: U7 -> I64
+u7_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u8_to_u4 :: U8 -> U4
+u8_to_u4 x = if x < 0 || x > 15 then error "u8_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u8_to_u7 :: U8 -> U7
+u8_to_u7 x = if x < 0 || x > 127 then error "u8_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u8_to_u12 :: U8 -> U12
+u8_to_u12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_u14 :: U8 -> U14
+u8_to_u14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_u16 :: U8 -> U16
+u8_to_u16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_u24 :: U8 -> U24
+u8_to_u24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_u32 :: U8 -> U32
+u8_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_u64 :: U8 -> U64
+u8_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u8_to_i4 :: U8 -> I4
+u8_to_i4 x = if x < 0 || x > 7 then error "u8_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u8_to_i7 :: U8 -> I7
+u8_to_i7 x = if x < 0 || x > 63 then error "u8_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u8_to_i8 :: U8 -> I8
+u8_to_i8 x = if x < 0 || x > 127 then error "u8_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u8_to_i12 :: U8 -> I12
+u8_to_i12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_i14 :: U8 -> I14
+u8_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_i16 :: U8 -> I16
+u8_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_i24 :: U8 -> I24
+u8_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_i32 :: U8 -> I32
+u8_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u8_to_i64 :: U8 -> I64
+u8_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_u4 :: U12 -> U4
+u12_to_u4 x = if x < 0 || x > 15 then error "u12_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_u7 :: U12 -> U7
+u12_to_u7 x = if x < 0 || x > 127 then error "u12_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_u8 :: U12 -> U8
+u12_to_u8 x = if x < 0 || x > 255 then error "u12_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u12_to_u14 :: U12 -> U14
+u12_to_u14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_u16 :: U12 -> U16
+u12_to_u16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_u24 :: U12 -> U24
+u12_to_u24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_u32 :: U12 -> U32
+u12_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_u64 :: U12 -> U64
+u12_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_i4 :: U12 -> I4
+u12_to_i4 x = if x < 0 || x > 7 then error "u12_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_i7 :: U12 -> I7
+u12_to_i7 x = if x < 0 || x > 63 then error "u12_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_i8 :: U12 -> I8
+u12_to_i8 x = if x < 0 || x > 127 then error "u12_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u12_to_i12 :: U12 -> I12
+u12_to_i12 x = if x < 0 || x > 2047 then error "u12_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u12_to_i14 :: U12 -> I14
+u12_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_i16 :: U12 -> I16
+u12_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_i24 :: U12 -> I24
+u12_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_i32 :: U12 -> I32
+u12_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u12_to_i64 :: U12 -> I64
+u12_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_u4 :: U14 -> U4
+u14_to_u4 x = if x < 0 || x > 15 then error "u14_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_u7 :: U14 -> U7
+u14_to_u7 x = if x < 0 || x > 127 then error "u14_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_u8 :: U14 -> U8
+u14_to_u8 x = if x < 0 || x > 255 then error "u14_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_u12 :: U14 -> U12
+u14_to_u12 x = if x < 0 || x > 4095 then error "u14_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u14_to_u16 :: U14 -> U16
+u14_to_u16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u14_to_u24 :: U14 -> U24
+u14_to_u24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u14_to_u32 :: U14 -> U32
+u14_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u14_to_u64 :: U14 -> U64
+u14_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_i4 :: U14 -> I4
+u14_to_i4 x = if x < 0 || x > 7 then error "u14_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_i7 :: U14 -> I7
+u14_to_i7 x = if x < 0 || x > 63 then error "u14_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_i8 :: U14 -> I8
+u14_to_i8 x = if x < 0 || x > 127 then error "u14_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_i12 :: U14 -> I12
+u14_to_i12 x = if x < 0 || x > 2047 then error "u14_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u14_to_i14 :: U14 -> I14
+u14_to_i14 x = if x < 0 || x > 8191 then error "u14_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u14_to_i16 :: U14 -> I16
+u14_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u14_to_i24 :: U14 -> I24
+u14_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u14_to_i32 :: U14 -> I32
+u14_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u14_to_i64 :: U14 -> I64
+u14_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_u4 :: U16 -> U4
+u16_to_u4 x = if x < 0 || x > 15 then error "u16_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_u7 :: U16 -> U7
+u16_to_u7 x = if x < 0 || x > 127 then error "u16_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_u8 :: U16 -> U8
+u16_to_u8 x = if x < 0 || x > 255 then error "u16_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_u12 :: U16 -> U12
+u16_to_u12 x = if x < 0 || x > 4095 then error "u16_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_u14 :: U16 -> U14
+u16_to_u14 x = if x < 0 || x > 16383 then error "u16_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u16_to_u24 :: U16 -> U24
+u16_to_u24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u16_to_u32 :: U16 -> U32
+u16_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u16_to_u64 :: U16 -> U64
+u16_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_i4 :: U16 -> I4
+u16_to_i4 x = if x < 0 || x > 7 then error "u16_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_i7 :: U16 -> I7
+u16_to_i7 x = if x < 0 || x > 63 then error "u16_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_i8 :: U16 -> I8
+u16_to_i8 x = if x < 0 || x > 127 then error "u16_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_i12 :: U16 -> I12
+u16_to_i12 x = if x < 0 || x > 2047 then error "u16_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_i14 :: U16 -> I14
+u16_to_i14 x = if x < 0 || x > 8191 then error "u16_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u16_to_i16 :: U16 -> I16
+u16_to_i16 x = if x < 0 || x > 32767 then error "u16_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u16_to_i24 :: U16 -> I24
+u16_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u16_to_i32 :: U16 -> I32
+u16_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u16_to_i64 :: U16 -> I64
+u16_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_u4 :: U24 -> U4
+u24_to_u4 x = if x < 0 || x > 15 then error "u24_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_u7 :: U24 -> U7
+u24_to_u7 x = if x < 0 || x > 127 then error "u24_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_u8 :: U24 -> U8
+u24_to_u8 x = if x < 0 || x > 255 then error "u24_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_u12 :: U24 -> U12
+u24_to_u12 x = if x < 0 || x > 4095 then error "u24_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_u14 :: U24 -> U14
+u24_to_u14 x = if x < 0 || x > 16383 then error "u24_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_u16 :: U24 -> U16
+u24_to_u16 x = if x < 0 || x > 65535 then error "u24_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u24_to_u32 :: U24 -> U32
+u24_to_u32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u24_to_u64 :: U24 -> U64
+u24_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i4 :: U24 -> I4
+u24_to_i4 x = if x < 0 || x > 7 then error "u24_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i7 :: U24 -> I7
+u24_to_i7 x = if x < 0 || x > 63 then error "u24_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i8 :: U24 -> I8
+u24_to_i8 x = if x < 0 || x > 127 then error "u24_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i12 :: U24 -> I12
+u24_to_i12 x = if x < 0 || x > 2047 then error "u24_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i14 :: U24 -> I14
+u24_to_i14 x = if x < 0 || x > 8191 then error "u24_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i16 :: U24 -> I16
+u24_to_i16 x = if x < 0 || x > 32767 then error "u24_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u24_to_i24 :: U24 -> I24
+u24_to_i24 x = if x < 0 || x > 8388607 then error "u24_to_i24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u24_to_i32 :: U24 -> I32
+u24_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+u24_to_i64 :: U24 -> I64
+u24_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u4 :: U32 -> U4
+u32_to_u4 x = if x < 0 || x > 15 then error "u32_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u7 :: U32 -> U7
+u32_to_u7 x = if x < 0 || x > 127 then error "u32_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u8 :: U32 -> U8
+u32_to_u8 x = if x < 0 || x > 255 then error "u32_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u12 :: U32 -> U12
+u32_to_u12 x = if x < 0 || x > 4095 then error "u32_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u14 :: U32 -> U14
+u32_to_u14 x = if x < 0 || x > 16383 then error "u32_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u16 :: U32 -> U16
+u32_to_u16 x = if x < 0 || x > 65535 then error "u32_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_u24 :: U32 -> U24
+u32_to_u24 x = if x < 0 || x > 16777215 then error "u32_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u32_to_u64 :: U32 -> U64
+u32_to_u64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i4 :: U32 -> I4
+u32_to_i4 x = if x < 0 || x > 7 then error "u32_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i7 :: U32 -> I7
+u32_to_i7 x = if x < 0 || x > 63 then error "u32_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i8 :: U32 -> I8
+u32_to_i8 x = if x < 0 || x > 127 then error "u32_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i12 :: U32 -> I12
+u32_to_i12 x = if x < 0 || x > 2047 then error "u32_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i14 :: U32 -> I14
+u32_to_i14 x = if x < 0 || x > 8191 then error "u32_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i16 :: U32 -> I16
+u32_to_i16 x = if x < 0 || x > 32767 then error "u32_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i24 :: U32 -> I24
+u32_to_i24 x = if x < 0 || x > 8388607 then error "u32_to_i24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u32_to_i32 :: U32 -> I32
+u32_to_i32 x = if x < 0 || x > 2147483647 then error "u32_to_i32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+u32_to_i64 :: U32 -> I64
+u32_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u4 :: U64 -> U4
+u64_to_u4 x = if x < 0 || x > 15 then error "u64_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u7 :: U64 -> U7
+u64_to_u7 x = if x < 0 || x > 127 then error "u64_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u8 :: U64 -> U8
+u64_to_u8 x = if x < 0 || x > 255 then error "u64_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u12 :: U64 -> U12
+u64_to_u12 x = if x < 0 || x > 4095 then error "u64_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u14 :: U64 -> U14
+u64_to_u14 x = if x < 0 || x > 16383 then error "u64_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u16 :: U64 -> U16
+u64_to_u16 x = if x < 0 || x > 65535 then error "u64_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u24 :: U64 -> U24
+u64_to_u24 x = if x < 0 || x > 16777215 then error "u64_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_u32 :: U64 -> U32
+u64_to_u32 x = if x < 0 || x > 4294967295 then error "u64_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i4 :: U64 -> I4
+u64_to_i4 x = if x < 0 || x > 7 then error "u64_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i7 :: U64 -> I7
+u64_to_i7 x = if x < 0 || x > 63 then error "u64_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i8 :: U64 -> I8
+u64_to_i8 x = if x < 0 || x > 127 then error "u64_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i12 :: U64 -> I12
+u64_to_i12 x = if x < 0 || x > 2047 then error "u64_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i14 :: U64 -> I14
+u64_to_i14 x = if x < 0 || x > 8191 then error "u64_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i16 :: U64 -> I16
+u64_to_i16 x = if x < 0 || x > 32767 then error "u64_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i24 :: U64 -> I24
+u64_to_i24 x = if x < 0 || x > 8388607 then error "u64_to_i24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i32 :: U64 -> I32
+u64_to_i32 x = if x < 0 || x > 2147483647 then error "u64_to_i32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+u64_to_i64 :: U64 -> I64
+u64_to_i64 x = if x < 0 || x > 9223372036854775807 then error "u64_to_i64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u4 :: I4 -> U4
+i4_to_u4 x = if x < 0 then error "i4_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u7 :: I4 -> U7
+i4_to_u7 x = if x < 0 then error "i4_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u8 :: I4 -> U8
+i4_to_u8 x = if x < 0 then error "i4_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u12 :: I4 -> U12
+i4_to_u12 x = if x < 0 then error "i4_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u14 :: I4 -> U14
+i4_to_u14 x = if x < 0 then error "i4_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u16 :: I4 -> U16
+i4_to_u16 x = if x < 0 then error "i4_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u24 :: I4 -> U24
+i4_to_u24 x = if x < 0 then error "i4_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u32 :: I4 -> U32
+i4_to_u32 x = if x < 0 then error "i4_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i4_to_u64 :: I4 -> U64
+i4_to_u64 x = if x < 0 then error "i4_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i4_to_i7 :: I4 -> I7
+i4_to_i7 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i8 :: I4 -> I8
+i4_to_i8 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i12 :: I4 -> I12
+i4_to_i12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i14 :: I4 -> I14
+i4_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i16 :: I4 -> I16
+i4_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i24 :: I4 -> I24
+i4_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i32 :: I4 -> I32
+i4_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i4_to_i64 :: I4 -> I64
+i4_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u4 :: I7 -> U4
+i7_to_u4 x = if x < 0 || x > 15 then error "i7_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u7 :: I7 -> U7
+i7_to_u7 x = if x < 0 then error "i7_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u8 :: I7 -> U8
+i7_to_u8 x = if x < 0 then error "i7_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u12 :: I7 -> U12
+i7_to_u12 x = if x < 0 then error "i7_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u14 :: I7 -> U14
+i7_to_u14 x = if x < 0 then error "i7_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u16 :: I7 -> U16
+i7_to_u16 x = if x < 0 then error "i7_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u24 :: I7 -> U24
+i7_to_u24 x = if x < 0 then error "i7_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u32 :: I7 -> U32
+i7_to_u32 x = if x < 0 then error "i7_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_u64 :: I7 -> U64
+i7_to_u64 x = if x < 0 then error "i7_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i7_to_i4 :: I7 -> I4
+i7_to_i4 x = if x < -8 || x > 7 then error "i7_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i7_to_i8 :: I7 -> I8
+i7_to_i8 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i7_to_i12 :: I7 -> I12
+i7_to_i12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i7_to_i14 :: I7 -> I14
+i7_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i7_to_i16 :: I7 -> I16
+i7_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i7_to_i24 :: I7 -> I24
+i7_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i7_to_i32 :: I7 -> I32
+i7_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i7_to_i64 :: I7 -> I64
+i7_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u4 :: I8 -> U4
+i8_to_u4 x = if x < 0 || x > 15 then error "i8_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u7 :: I8 -> U7
+i8_to_u7 x = if x < 0 || x > 127 then error "i8_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u8 :: I8 -> U8
+i8_to_u8 x = if x < 0 then error "i8_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u12 :: I8 -> U12
+i8_to_u12 x = if x < 0 then error "i8_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u14 :: I8 -> U14
+i8_to_u14 x = if x < 0 then error "i8_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u16 :: I8 -> U16
+i8_to_u16 x = if x < 0 then error "i8_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u24 :: I8 -> U24
+i8_to_u24 x = if x < 0 then error "i8_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u32 :: I8 -> U32
+i8_to_u32 x = if x < 0 then error "i8_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_u64 :: I8 -> U64
+i8_to_u64 x = if x < 0 then error "i8_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_i4 :: I8 -> I4
+i8_to_i4 x = if x < -8 || x > 7 then error "i8_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i8_to_i7 :: I8 -> I7
+i8_to_i7 x = if x < -64 || x > 63 then error "i8_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i8_to_i12 :: I8 -> I12
+i8_to_i12 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i8_to_i14 :: I8 -> I14
+i8_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i8_to_i16 :: I8 -> I16
+i8_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i8_to_i24 :: I8 -> I24
+i8_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i8_to_i32 :: I8 -> I32
+i8_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i8_to_i64 :: I8 -> I64
+i8_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u4 :: I12 -> U4
+i12_to_u4 x = if x < 0 || x > 15 then error "i12_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u7 :: I12 -> U7
+i12_to_u7 x = if x < 0 || x > 127 then error "i12_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u8 :: I12 -> U8
+i12_to_u8 x = if x < 0 || x > 255 then error "i12_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u12 :: I12 -> U12
+i12_to_u12 x = if x < 0 then error "i12_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u14 :: I12 -> U14
+i12_to_u14 x = if x < 0 then error "i12_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u16 :: I12 -> U16
+i12_to_u16 x = if x < 0 then error "i12_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u24 :: I12 -> U24
+i12_to_u24 x = if x < 0 then error "i12_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u32 :: I12 -> U32
+i12_to_u32 x = if x < 0 then error "i12_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_u64 :: I12 -> U64
+i12_to_u64 x = if x < 0 then error "i12_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_i4 :: I12 -> I4
+i12_to_i4 x = if x < -8 || x > 7 then error "i12_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_i7 :: I12 -> I7
+i12_to_i7 x = if x < -64 || x > 63 then error "i12_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i12_to_i8 :: I12 -> I8
+i12_to_i8 x = if x < -128 || x > 127 then error "i12_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i12_to_i14 :: I12 -> I14
+i12_to_i14 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i12_to_i16 :: I12 -> I16
+i12_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i12_to_i24 :: I12 -> I24
+i12_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i12_to_i32 :: I12 -> I32
+i12_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i12_to_i64 :: I12 -> I64
+i12_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u4 :: I14 -> U4
+i14_to_u4 x = if x < 0 || x > 15 then error "i14_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u7 :: I14 -> U7
+i14_to_u7 x = if x < 0 || x > 127 then error "i14_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u8 :: I14 -> U8
+i14_to_u8 x = if x < 0 || x > 255 then error "i14_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u12 :: I14 -> U12
+i14_to_u12 x = if x < 0 || x > 4095 then error "i14_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u14 :: I14 -> U14
+i14_to_u14 x = if x < 0 then error "i14_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u16 :: I14 -> U16
+i14_to_u16 x = if x < 0 then error "i14_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u24 :: I14 -> U24
+i14_to_u24 x = if x < 0 then error "i14_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u32 :: I14 -> U32
+i14_to_u32 x = if x < 0 then error "i14_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_u64 :: I14 -> U64
+i14_to_u64 x = if x < 0 then error "i14_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_i4 :: I14 -> I4
+i14_to_i4 x = if x < -8 || x > 7 then error "i14_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_i7 :: I14 -> I7
+i14_to_i7 x = if x < -64 || x > 63 then error "i14_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_i8 :: I14 -> I8
+i14_to_i8 x = if x < -128 || x > 127 then error "i14_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i14_to_i12 :: I14 -> I12
+i14_to_i12 x = if x < -2048 || x > 2047 then error "i14_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i14_to_i16 :: I14 -> I16
+i14_to_i16 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i14_to_i24 :: I14 -> I24
+i14_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i14_to_i32 :: I14 -> I32
+i14_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i14_to_i64 :: I14 -> I64
+i14_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u4 :: I16 -> U4
+i16_to_u4 x = if x < 0 || x > 15 then error "i16_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u7 :: I16 -> U7
+i16_to_u7 x = if x < 0 || x > 127 then error "i16_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u8 :: I16 -> U8
+i16_to_u8 x = if x < 0 || x > 255 then error "i16_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u12 :: I16 -> U12
+i16_to_u12 x = if x < 0 || x > 4095 then error "i16_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u14 :: I16 -> U14
+i16_to_u14 x = if x < 0 || x > 16383 then error "i16_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u16 :: I16 -> U16
+i16_to_u16 x = if x < 0 then error "i16_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u24 :: I16 -> U24
+i16_to_u24 x = if x < 0 then error "i16_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u32 :: I16 -> U32
+i16_to_u32 x = if x < 0 then error "i16_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_u64 :: I16 -> U64
+i16_to_u64 x = if x < 0 then error "i16_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_i4 :: I16 -> I4
+i16_to_i4 x = if x < -8 || x > 7 then error "i16_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_i7 :: I16 -> I7
+i16_to_i7 x = if x < -64 || x > 63 then error "i16_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_i8 :: I16 -> I8
+i16_to_i8 x = if x < -128 || x > 127 then error "i16_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_i12 :: I16 -> I12
+i16_to_i12 x = if x < -2048 || x > 2047 then error "i16_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i16_to_i14 :: I16 -> I14
+i16_to_i14 x = if x < -8192 || x > 8191 then error "i16_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i16_to_i24 :: I16 -> I24
+i16_to_i24 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i16_to_i32 :: I16 -> I32
+i16_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i16_to_i64 :: I16 -> I64
+i16_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u4 :: I24 -> U4
+i24_to_u4 x = if x < 0 || x > 15 then error "i24_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u7 :: I24 -> U7
+i24_to_u7 x = if x < 0 || x > 127 then error "i24_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u8 :: I24 -> U8
+i24_to_u8 x = if x < 0 || x > 255 then error "i24_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u12 :: I24 -> U12
+i24_to_u12 x = if x < 0 || x > 4095 then error "i24_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u14 :: I24 -> U14
+i24_to_u14 x = if x < 0 || x > 16383 then error "i24_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u16 :: I24 -> U16
+i24_to_u16 x = if x < 0 || x > 65535 then error "i24_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u24 :: I24 -> U24
+i24_to_u24 x = if x < 0 then error "i24_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u32 :: I24 -> U32
+i24_to_u32 x = if x < 0 then error "i24_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_u64 :: I24 -> U64
+i24_to_u64 x = if x < 0 then error "i24_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_i4 :: I24 -> I4
+i24_to_i4 x = if x < -8 || x > 7 then error "i24_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_i7 :: I24 -> I7
+i24_to_i7 x = if x < -64 || x > 63 then error "i24_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_i8 :: I24 -> I8
+i24_to_i8 x = if x < -128 || x > 127 then error "i24_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_i12 :: I24 -> I12
+i24_to_i12 x = if x < -2048 || x > 2047 then error "i24_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_i14 :: I24 -> I14
+i24_to_i14 x = if x < -8192 || x > 8191 then error "i24_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i24_to_i16 :: I24 -> I16
+i24_to_i16 x = if x < -32768 || x > 32767 then error "i24_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i24_to_i32 :: I24 -> I32
+i24_to_i32 = fromIntegral
+
+-- | Type specialised 'fromIntegral'
+i24_to_i64 :: I24 -> I64
+i24_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u4 :: I32 -> U4
+i32_to_u4 x = if x < 0 || x > 15 then error "i32_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u7 :: I32 -> U7
+i32_to_u7 x = if x < 0 || x > 127 then error "i32_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u8 :: I32 -> U8
+i32_to_u8 x = if x < 0 || x > 255 then error "i32_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u12 :: I32 -> U12
+i32_to_u12 x = if x < 0 || x > 4095 then error "i32_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u14 :: I32 -> U14
+i32_to_u14 x = if x < 0 || x > 16383 then error "i32_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u16 :: I32 -> U16
+i32_to_u16 x = if x < 0 || x > 65535 then error "i32_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u24 :: I32 -> U24
+i32_to_u24 x = if x < 0 || x > 16777215 then error "i32_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u32 :: I32 -> U32
+i32_to_u32 x = if x < 0 then error "i32_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_u64 :: I32 -> U64
+i32_to_u64 x = if x < 0 then error "i32_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i4 :: I32 -> I4
+i32_to_i4 x = if x < -8 || x > 7 then error "i32_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i7 :: I32 -> I7
+i32_to_i7 x = if x < -64 || x > 63 then error "i32_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i8 :: I32 -> I8
+i32_to_i8 x = if x < -128 || x > 127 then error "i32_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i12 :: I32 -> I12
+i32_to_i12 x = if x < -2048 || x > 2047 then error "i32_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i14 :: I32 -> I14
+i32_to_i14 x = if x < -8192 || x > 8191 then error "i32_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i16 :: I32 -> I16
+i32_to_i16 x = if x < -32768 || x > 32767 then error "i32_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i32_to_i24 :: I32 -> I24
+i32_to_i24 x = if x < -8388608 || x > 8388607 then error "i32_to_i24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral'
+i32_to_i64 :: I32 -> I64
+i32_to_i64 = fromIntegral
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u4 :: I64 -> U4
+i64_to_u4 x = if x < 0 || x > 15 then error "i64_to_u4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u7 :: I64 -> U7
+i64_to_u7 x = if x < 0 || x > 127 then error "i64_to_u7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u8 :: I64 -> U8
+i64_to_u8 x = if x < 0 || x > 255 then error "i64_to_u8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u12 :: I64 -> U12
+i64_to_u12 x = if x < 0 || x > 4095 then error "i64_to_u12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u14 :: I64 -> U14
+i64_to_u14 x = if x < 0 || x > 16383 then error "i64_to_u14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u16 :: I64 -> U16
+i64_to_u16 x = if x < 0 || x > 65535 then error "i64_to_u16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u24 :: I64 -> U24
+i64_to_u24 x = if x < 0 || x > 16777215 then error "i64_to_u24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u32 :: I64 -> U32
+i64_to_u32 x = if x < 0 || x > 4294967295 then error "i64_to_u32: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_u64 :: I64 -> U64
+i64_to_u64 x = if x < 0 then error "i64_to_u64: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i4 :: I64 -> I4
+i64_to_i4 x = if x < -8 || x > 7 then error "i64_to_i4: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i7 :: I64 -> I7
+i64_to_i7 x = if x < -64 || x > 63 then error "i64_to_i7: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i8 :: I64 -> I8
+i64_to_i8 x = if x < -128 || x > 127 then error "i64_to_i8: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i12 :: I64 -> I12
+i64_to_i12 x = if x < -2048 || x > 2047 then error "i64_to_i12: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i14 :: I64 -> I14
+i64_to_i14 x = if x < -8192 || x > 8191 then error "i64_to_i14: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i16 :: I64 -> I16
+i64_to_i16 x = if x < -32768 || x > 32767 then error "i64_to_i16: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i24 :: I64 -> I24
+i64_to_i24 x = if x < -8388608 || x > 8388607 then error "i64_to_i24: OUT-OF-RANGE" else fromIntegral x
+
+-- | Type specialised 'fromIntegral' with out-of-range error.
+i64_to_i32 :: I64 -> I32
+i64_to_i32 x = if x < -2147483648 || x > 2147483647 then error "i64_to_i32: OUT-OF-RANGE" else fromIntegral x
diff --git a/Music/Theory/Math/Nichomachus.hs b/Music/Theory/Math/Nichomachus.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Nichomachus.hs
@@ -0,0 +1,53 @@
+{- | Nichomachus of Gerasa (Νικόμαχος) c.60-c.120
+
+<https://pdfs.semanticscholar.org/5dac/8842ad857c822ab854ede3decadfe0464f15.pdf>
+-}
+module Music.Theory.Math.Nichomachus where
+
+{- | a-b = b-c ; b = a+c / 2
+
+> arithmetic_mean 2 6 == 4
+> arithmetic_mean 1 2 == (1+2)/2 -- 3/2
+-}
+arithmetic_mean :: Fractional a => a -> a -> a
+arithmetic_mean a c = (a + c) / 2
+
+{- | a/b = b/c ; b = sqrt ac
+
+> geometric_mean 1 4 == 2
+> geometric_mean 1 2 == sqrt (1*2) -- sqrt 2
+-}
+geometric_mean :: Floating a => a -> a -> a
+geometric_mean a c = sqrt (a * c)
+
+{- | a-b / a = b-c / c ; 2ac / a+c
+
+> harmonic_mean 2 6 == 3
+> harmonic_mean 1 2 == (2*1*2)/(1+2) -- 4/3
+-}
+harmonic_mean :: Fractional a => a -> a -> a
+harmonic_mean a c = (2 * a * c) / (a + c) -- OR -- 2 / (1/a + 1/c)
+
+{- | a-b / c = b-c / a ; a-b / b-c = c/a ; aa+cc / a+c
+
+> cont_harmonic_mean 3 6 == 5
+> cont_harmonic_mean 1 2 == (1*1+2*2)/(1+2) -- 5/3
+-}
+cont_harmonic_mean :: Fractional a => a -> a -> a
+cont_harmonic_mean a c = (a * a + c * c) / (a + c)
+
+{- | a-b / c = b-c / b ; a-b / b-c = c/b ; c - a + (sqrt (5aa - 2ac + cc)) / 2
+
+> cont_geometric_mean 2 5 == 4
+> cont_geometric_mean 1 2 == (2-1+sqrt(5*1*1-2*1*2+2*2))/2 -- (1+sqrt 5)/2 -- GOLDEN RATIO -- 1.6180
+-}
+cont_geometric_mean :: Floating a => a -> a -> a
+cont_geometric_mean a c = (c - a + sqrt (5 * a * a - 2 * a * c + c * c)) / 2
+
+{- | a-b / c = b-c / b ; a-b / b-c = c/b ; a - c + (sqrt (aa - 2ac + 5cc)) / 2
+
+> subcont_geometric_mean 1 6 == 4
+> subcont_geometric_mean 1 2 == (-1 + sqrt 17) / 2 -- 1.5616
+-}
+subcont_geometric_mean :: Floating a => a -> a -> a
+subcont_geometric_mean a c = (a - c + sqrt (a * a - 2 * a * c + 5 * c * c)) / 2
diff --git a/Music/Theory/Math/OEIS.hs b/Music/Theory/Math/OEIS.hs
deleted file mode 100644
--- a/Music/Theory/Math/OEIS.hs
+++ /dev/null
@@ -1,27 +0,0 @@
--- | The On-Line Encyclopedia of Integer Sequences, <http://oeis.org/>
-module Music.Theory.Math.OEIS where
-
--- | <http://oeis.org/A000290>
---
--- The squares of the non-negative integers.
---
--- > import Data.List
--- > [0,1,4,9,16,25,36,49,64,81,100] `isInfixOf` a000290
-a000290 :: Integral n => [n]
-a000290 = let square n = n * n in map square [0..]
-
--- | <http://oeis.org/A002267>
-a002267 :: Num n => [n]
-a002267 = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 41, 47, 59, 71]
-
--- | <http://oeis.org/A126709>
---
--- Loh-Shu magic square, attributed to the legendary Fu Xi (Fuh-Hi).
-a126709 :: Num n => [n]
-a126709 = [4, 9, 2, 3, 5, 7, 8, 1, 6]
-
--- | <http://oeis.org/A126710>
---
--- Jaina inscription of the twelfth or thirteenth century, Khajuraho, India.
-a126710 :: Num n => [n]
-a126710 = [7, 12, 1, 14, 2, 13, 8, 11, 16, 3, 10, 5, 9, 6, 15, 4]
diff --git a/Music/Theory/Math/Oeis.hs b/Music/Theory/Math/Oeis.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Oeis.hs
@@ -0,0 +1,1478 @@
+-- | The On-Line Encyclopedia of Integer Sequences, <http://oeis.org/>
+module Music.Theory.Math.Oeis where
+
+import Data.Bits {- base -}
+import Data.Char {- base -}
+import Data.List {- base -}
+import Data.Ratio {- base -}
+
+import qualified Data.Set as Set {- containers -}
+
+import qualified Data.MemoCombinators as Memo {- data-memocombinators -}
+
+import qualified Music.Theory.Math as Math {- hmt-base -}
+
+import qualified Music.Theory.Math.Prime as Prime {- hmt -}
+
+{- | <http://oeis.org/A000005>
+
+d(n) (also called tau(n) or sigma_0(n)), the number of divisors of n. (Formerly M0246 N0086)
+
+[1, 2, 2, 3, 2, 4, 2, 4, 3, 4, 2, 6, 2, 4, 4, 5, 2, 6, 2, 6, 4, 4, 2, 8, 3, 4, 4, 6, 2, 8, 2, 6, 4, 4, 4, 9, 2, 4, 4, 8, 2, 8, 2, 6, 6, 4, 2, 10, 3, 6, 4, 6, 2, 8, 4, 8, 4, 4, 2, 12, 2, 4, 6, 7, 4, 8, 2, 6, 4, 8, 2, 12, 2, 4, 6, 6, 4, 8, 2, 10, 5, 4, 2, 12, 4, 4, 4, 8, 2, 12, 4, 6, 4, 4, 4, 12, 2, 6, 6, 9, 2, 8, 2, 8] `isPrefixOf` a000005
+-}
+a000005 :: Integral n => [n]
+a000005 = map (product . map (+ 1) . a124010_row) [1..]
+
+{- | <http://oeis.org/A000010>
+
+Euler totient function phi(n): count numbers <= n and prime to n.
+
+> [1,1,2,2,4,2,6,4,6,4,10,4,12,6,8,8,16,6,18,8,12,10,22,8,20,12] `isPrefixOf` a000010
+-}
+a000010 :: Integral n => [n]
+a000010 = map a000010_n [1 ..]
+
+a000010_n :: Integral n => n -> n
+a000010_n n = genericLength (filter (==1) (map (gcd n) [1..n]))
+
+{- | <http://oeis.org/A000012>
+
+The simplest sequence of positive numbers: the all 1's sequence.
+-}
+a000012 :: Num n => [n]
+a000012 = repeat 1
+
+{- | <https://oeis.org/A000031>
+
+Number of n-bead necklaces with 2 colors when turning over is not allowed; also number of output sequences from a simple n-stage cycling shift register; also number of binary irreducible polynomials whose degree divides n.
+
+> [1,2,3,4,6,8,14,20,36,60,108,188,352,632,1182,2192,4116,7712,14602,27596] `isPrefixOf` a000031
+-}
+a000031 :: Integral n => [n]
+a000031 = map a000031_n [0..]
+
+a000031_n :: Integral n => n -> n
+a000031_n n =
+  if n == 0
+  then 1
+  else let divs = a027750_row n
+       in ((`div` n) . sum . zipWith (*) (map a000010_n divs) . map (2 ^) . reverse) divs
+
+{- | <http://oeis.org/A000032>
+
+Lucas numbers beginning at 2: L(n) = L(n-1) + L(n-2), L(0) = 2, L(1) = 1. (Formerly M0155)
+
+> [2,1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778,9349,15127] `isPrefixOf` a000032
+-}
+a000032 :: Num n => [n]
+a000032 = 2 : 1 : zipWith (+) a000032 (tail a000032)
+
+{- | <http://oeis.org/A000040>
+
+The prime numbers.
+
+> [2,3,5,7,11,13,17,19,23,29,31,37,41,43,47,53,59,61,67,71,73,79,83,89,97,101,103] `isPrefixOf` a000040
+-}
+a000040 :: Integral n => [n]
+a000040 =
+  let base = [2, 3, 5, 7, 11, 13, 17]
+      larger = p0 : filter prime more
+      prime n = all ((> 0) . mod n) (takeWhile (\x -> x*x <= n) larger)
+      _ : p0 : more = roll (makeWheels base)
+      roll (n,rs) = [n * k + r | k <- [0..], r <- rs]
+      makeWheels = foldl nextSize (1,[1])
+      nextSize (size,bs) p = (size * p,[r | k <- [0..p-1], b <- bs, let r = size*k+b, mod r p > 0])
+  in base ++ larger
+
+{- | <http://oeis.org/A000041>
+
+a(n) is the number of partitions of n (the partition numbers).
+
+[1,1,2,3,5,7,11,15,22,30,42,56,77,101,135,176,231,297,385,490,627,792,1002,1255] `isPrefixOf` a000041
+-}
+a000041 :: Num n => [n]
+a000041 =
+  let p_m = Memo.memo2 Memo.integral Memo.integral p
+      p _ 0 = 1
+      p k m = if m < k then 0 else p_m k (m - k) + p_m (k + 1) m
+  in map (p_m 1) [0::Integer ..]
+
+{- | <http://oeis.org/A000045>
+
+Fibonacci numbers
+
+> [0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946] `isPrefixOf` a000045
+-}
+a000045 :: Num n => [n]
+a000045 = 0 : 1 : zipWith (+) a000045 (tail a000045)
+
+{- | <http://oeis.org/A000051>
+
+a(n) = 2^n + 1
+
+> [2,3,5,9,17,33,65,129,257,513,1025,2049,4097,8193,16385,32769,65537,131073] `isPrefixOf` a000051
+-}
+a000051 :: Num n => [n]
+a000051 = iterate (subtract 1 . (* 2)) 2
+
+{- | <http://oeis.org/A000071>
+
+a(n) = Fibonacci(n) - 1.
+
+> [0,0,1,2,4,7,12,20,33,54,88,143,232,376,609,986,1596,2583,4180,6764,10945,17710] `isPrefixOf` a000071
+-}
+a000071 :: Num n => [n]
+a000071 = map (subtract 1) (tail a000045)
+
+{- | <http://oeis.org/A000073>
+
+Tribonacci numbers: a(n) = a(n-1) + a(n-2) + a(n-3) for n >= 3 with a(0) = a(1) = 0 and a(2) = 1.
+
+> [0,0,1,1,2,4,7,13,24,44,81,149,274,504,927,1705,3136,5768,10609,19513,35890] `isPrefixOf` a000073
+-}
+a000073 :: Num n => [n]
+a000073 = 0 : 0 : 1 : zipWith (+) a000073 (tail (zipWith (+) a000073 (tail a000073)))
+
+{- | <http://oeis.org/A000078>
+
+Tetranacci numbers: a(n) = a(n-1) + a(n-2) + a(n-3) + a(n-4) with a(0)=a(1)=a(2)=0, a(3)=1.
+
+> [0,0,0,1,1,2,4,8,15,29,56,108,208,401,773,1490,2872,5536,10671,20569,39648] `isPrefixOf` a000078
+-}
+a000078 :: Num n => [n]
+a000078 =
+  let f xs = let y = (sum . head . transpose . take 4 . tails) xs in y : f (y:xs)
+  in 0 : 0 : 0 : f [0, 0, 0, 1]
+
+{- | <http://oeis.org/A000079>
+
+Powers of 2: a(n) = 2^n. (Formerly M1129 N0432)
+
+> [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536] `isPrefixOf` a000079
+> [1,2,4,8,16,32,64,128,256,512,1024,2048,4096,8192,16384,32768,65536] `isPrefixOf` map (2 ^) [0..]
+-}
+a000079 :: Num n => [n]
+a000079 = iterate (* 2) 1
+
+{- | <http://oeis.org/A000085>
+
+Number of self-inverse permutations on n letters, also known as involutions; number of standard Young tableaux with n cells.
+
+> [1,1,2,4,10,26,76,232,764,2620,9496,35696,140152,568504,2390480,10349536] `isPrefixOf` a000085
+-}
+a000085 :: Integral n => [n]
+a000085 = 1 : 1 : zipWith (+) (zipWith (*) [1..] a000085) (tail a000085)
+
+{- | <http://oeis.org/A000108>
+
+Catalan numbers: C(n) = binomial(2n,n)/(n+1) = (2n)!/(n!(n+1)!).
+
+> [1,1,2,5,14,42,132,429,1430,4862,16796,58786,208012,742900,2674440,9694845] `isPrefixOf` a000108
+-}
+a000108 :: Num n => [n]
+a000108 = map last (iterate (scanl1 (+) . (++ [0])) [1])
+
+{- | <http://oeis.org/A000120>
+
+1's-counting sequence: number of 1's in binary expansion of n (or the binary weight of n).
+
+> [0,1,1,2,1,2,2,3,1,2,2,3,2,3,3,4,1,2,2,3,2,3,3,4,2,3,3,4,3,4,4,5,1,2,2,3,2,3,3] `isPrefixOf` a000120
+-}
+a000120 :: Integral i => [i]
+a000120 = let r = [0] : (map . map) (+ 1) (scanl1 (++) r) in concat r
+
+{- | <http://oeis.org/A000142>
+
+Factorial numbers: n! = 1*2*3*4*...*n
+(order of symmetric group S_n, number of permutations of n letters).
+
+> [1,1,2,6,24,120,720,5040,40320,362880,3628800,39916800,479001600,6227020800] `isPrefixOf` a000142
+-}
+a000142 :: (Enum n, Num n) => [n]
+a000142 = 1 : zipWith (*) [1..] a000142
+
+{- | https://oeis.org/A000201
+
+Lower Wythoff sequence (a Beatty sequence): a(n) = floor(n*phi), where phi = (1+sqrt(5))/2 = A001622
+
+> [1,3,4,6,8,9,11,12,14,16,17,19,21,22,24,25,27,29,30,32,33,35,37,38,40,42] `isPrefixOf` a000201
+
+> import Sound.SC3.Plot {- hsc3-plot -}
+> plot_p1_imp [take 128 a000201 :: [Int]]
+-}
+a000201 :: Integral n => [n]
+a000201 =
+  let f (x:xs) (y:ys) = y : f xs (delete (x + y) ys)
+      f _ _ = error "a000201"
+  in f [1..] [1..]
+
+{- | <https://oeis.org/A000204>
+
+Lucas numbers (beginning with 1): L(n) = L(n-1) + L(n-2) with L(1) = 1, L(2) = 3
+
+> [1,3,4,7,11,18,29,47,76,123,199,322,521,843,1364,2207,3571,5778,9349,15127] `isPrefixOf` a000204
+-}
+a000204 :: Num n => [n]
+a000204 = 1 : 3 : zipWith (+) a000204 (tail a000204)
+
+{- | <http://oeis.org/A000213>
+
+Tribonacci numbers: a(n) = a(n-1) + a(n-2) + a(n-3) with a(0)=a(1)=a(2)=1.
+
+[1,1,1,3,5,9,17,31,57,105,193,355,653,1201,2209,4063,7473,13745,25281,46499]  `isPrefixOf` a000213
+-}
+a000213 :: Num n => [n]
+a000213 = 1 : 1 : 1 : zipWith (+) a000213 (tail (zipWith (+) a000213 (tail a000213)))
+
+{- | <https://oeis.org/A000217>
+
+Triangular numbers: a(n) = binomial(n+1,2) = n(n+1)/2 = 0 + 1 + 2 + ... + n.
+
+> [0,1,3,6,10,15,21,28,36,45,55,66,78,91,105,120,136,153,171,190,210,231,253,276] `isPrefixOf` a000217
+-}
+a000217 :: (Enum n,Num n) => [n]
+a000217 = scanl1 (+) [0..]
+
+{- | <http://oeis.org/A000225>
+
+a(n) = 2^n - 1 (Sometimes called Mersenne numbers, although that name is usually reserved for A001348)
+
+> [0,1,3,7,15,31,63,127,255,511,1023,2047,4095,8191,16383,32767,65535] `isPrefixOf` a000225
+-}
+a000225 :: Num n => [n]
+a000225 = iterate ((+ 1) . (* 2)) 0
+
+{- | <http://oeis.org/000285>
+
+a(0) = 1, a(1) = 4, and a(n) = a(n-1) + a(n-2) for n >= 2. (Formerly M3246 N1309)
+
+> [1,4,5,9,14,23,37,60,97,157,254,411,665,1076,1741,2817,4558,7375,11933,19308] `isPrefixOf` a000285
+-}
+a000285 :: Num n => [n]
+a000285 = 1 : 4 : zipWith (+) a000285 (tail a000285)
+
+{- | <http://oeis.org/A000290>
+
+The squares of the non-negative integers.
+
+> [0,1,4,9,16,25,36,49,64,81,100] `isPrefixOf` a000290
+-}
+a000290 :: Integral n => [n]
+a000290 = let square n = n * n in map square [0..]
+
+{- | <https://oeis.org/A000292>
+
+Tetrahedral (or triangular pyramidal) numbers: a(n) = C(n+2,3) = n*(n+1)*(n+2)/6.
+
+> [0,1,4,10,20,35,56,84,120,165,220,286,364,455,560,680,816,969,1140,1330,1540] `isPrefixOf` a000292
+-}
+a000292 :: (Enum n,Num n) => [n]
+a000292 = scanl1 (+) a000217
+
+{- | <http://oeis.org/A000384>
+
+Hexagonal numbers: a(n) = n*(2*n-1). (Formerly M4108 N1705)
+
+> [0,1,6,15,28,45,66,91,120,153,190,231,276,325,378,435,496,561,630,703,780,861] `isPrefixOf` a000384
+-}
+a000384 :: Integral n => [n]
+a000384 = scanl (+) 0 a016813
+
+{- | <http://oeis.org/A000578>
+
+The cubes: a(n) = n^3.
+
+> [0,1,8,27,64,125,216,343,512,729,1000,1331,1728,2197,2744,3375,4096,4913,5832] `isPrefixOf` a000578
+-}
+a000578 :: Num n => [n]
+a000578 =
+  0 : 1 : 8 :
+  zipWith (+) (map (+ 6) a000578) (map (* 3) (tail (zipWith (-) (tail a000578) a000578)))
+
+{- | <http://oeis.org/A000583>
+
+Fourth powers: a(n) = n^4.
+
+> [0,1,16,81,256,625,1296,2401,4096,6561,10000,14641,20736,28561,38416,50625] `isPrefixOf` a000583
+-}
+a000583 :: Integral n => [n]
+a000583 = scanl (+) 0 a005917
+
+{- | <http://oeis.org/A000670>
+
+Fubini numbers: number of preferential arrangements of n labeled elements; or number of weak orders on n labeled elements; or number of ordered partitions of [n].
+
+> [1,1,3,13,75,541,4683,47293,545835,7087261,102247563,1622632573,28091567595] `isPrefixOf` a000670
+-}
+a000670 :: Integral n => [n]
+a000670 =
+  let f xs (bs:bss) = let y = sum (zipWith (*) xs bs) in y : f (y : xs) bss
+      f _ _ = error "a000670d"
+  in 1 : f [1] (map tail (tail a007318_tbl))
+
+{- | <https://oeis.org/A000796>
+
+Decimal expansion of Pi (or digits of Pi).
+
+> [3,1,4,1,5,9,2,6,5,3,5,8,9,7,9,3,2,3,8,4,6,2,6,4,3,3,8,3,2,7,9,5,0,2,8,8,4,1,9] `isPrefixOf` a000796
+
+> pi :: Data.Number.Fixed.Fixed Data.Number.Fixed.Prec500 {- numbers -}
+-}
+a000796 :: Integral n => [n]
+a000796 =
+  let gen _ [] = error "A000796"
+      gen z (x:xs) =
+        let lb = approx z 3
+            approx (a,b,c) n = div (a * n + b) c
+            mult (a,b,c) (d,e,f) = (a * d,a * e + b * f,c * f)
+        in if lb /= approx z 4
+           then gen (mult z x) xs
+        else lb : gen (mult (10,-10 * lb,1) z) (x:xs)
+  in map fromInteger (gen (1,0,1) [(n,a*d,d) | (n,d,a) <- map (\k -> (k,2 * k + 1,2)) [1..]])
+
+{- | <https://oeis.org/A000930>
+
+Narayana's cows sequence.
+
+> [1,1,1,2,3,4,6,9,13,19,28,41,60] `isPrefixOf` a000930
+-}
+a000930 :: Num n => [n]
+a000930 = 1 : 1 : 1 : zipWith (+) a000930 (drop 2 a000930)
+
+{- | <https://oeis.org/A000931>
+
+Padovan sequence (or Padovan numbers): a(n) = a(n-2) + a(n-3) with a(0) = 1, a(1) = a(2) = 0.
+
+> [1,0,0,1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265] `isPrefixOf` a000931
+-}
+a000931 :: Num n => [n]
+a000931 = 1 : 0 : 0 : zipWith (+) a000931 (tail a000931)
+
+{- | <https://oeis.org/A001008>
+
+Numerators of harmonic numbers H(n) = Sum_{i=1..n} 1/i
+
+[1,3,11,25,137,49,363,761,7129,7381,83711,86021,1145993,1171733,1195757,2436559] `isPrefixOf` a001008
+-}
+a001008 :: Integral i => [i]
+a001008 = map numerator (scanl1 (+) (map (1 %) [1..]))
+
+{- | <http://oeis.org/A001037>
+
+Number of degree-n irreducible polynomials over GF(2); number of
+n-bead necklaces with beads of 2 colors when turning over is not
+allowed and with primitive period n; number of binary Lyndon words of
+length n.
+
+> [1,2,1,2,3,6,9,18,30,56,99,186,335,630,1161,2182,4080,7710,14532,27594,52377,99858,190557,364722,698870] `isPrefixOf` a001037
+-}
+a001037 :: Integral n => [n]
+a001037 = map a001037_n [0..]
+
+a001037_n :: Integral n => n -> n
+a001037_n n = if n == 0 then 1 else (sum (map (\d -> (2 ^ d) * a008683_n (n `div` d)) (a027750_row n))) `div` n
+
+{- | <http://oeis.org/A001113>
+
+Decimal expansion of e.
+
+> [2,7,1,8,2,8,1,8,2,8,4,5,9,0,4,5,2,3,5,3,6,0,2,8,7,4,7,1,3,5,2,6,6,2,4,9,7,7,5] `isPrefixOf` a001113
+
+> exp 1 :: Data.Number.Fixed.Fixed Data.Number.Fixed.Prec500 {- numbers -}
+-}
+a001113 :: Integral n => [n]
+a001113 =
+  let gen _ [] = error "A001113"
+      gen z (x:xs) =
+        let lb = approx z 1
+            approx (a,b,c) n = div (a * n + b) c
+            mult (a,b,c) (d,e,f) = (a * d,a * e + b * f,c * f)
+        in if lb /= approx z 2
+           then gen (mult z x) xs
+           else lb : gen (mult (10,-10 * lb,1) z) (x:xs)
+  in gen (1,0,1) [(n,a * d,d) | (n,d,a) <- map (\k -> (1,k,1)) [1..]]
+
+{- | <https://oeis.org/A001147>
+
+Double factorial of odd numbers: a(n) = (2*n-1)!! = 1*3*5*...*(2*n-1). (Formerly M3002 N1217)
+
+> [1,1,3,15,105,945,10395,135135,2027025,34459425,654729075,13749310575] `isPrefixOf` a001147
+-}
+a001147 :: Integral t => [t]
+a001147 = 1 : zipWith (*) [1, 3 ..] a001147
+
+{- | <https://oeis.org/A001156>
+
+Number of partitions of n into squares.
+
+> [1,1,1,1,2,2,2,2,3,4,4,4,5,6,6,6,8,9,10,10,12,13,14,14,16,19,20,21,23,26,27,28] `isPrefixOf` a001156
+-}
+a001156 :: Num n => [n]
+a001156 =
+  let p _ 0 = 1
+      p ks'@(k:ks) m = if m < k then 0 else p ks' (m - k) + p ks m
+      p _ _ = error "A001156"
+  in map (p (tail a000290)) [0::Integer ..]
+
+{- | <https://oeis.org/A001333>
+
+Numerators of continued fraction convergents to sqrt(2).
+
+[1,1,3,7,17,41,99,239,577,1393,3363,8119,19601,47321,114243,275807,665857] `isPrefixOf` a001333
+-}
+a001333 :: Num n => [n]
+a001333 = 1 : 1 : zipWith (+) a001333 (map (* 2) (tail a001333))
+
+{- | <http://oeis.org/A001622>
+
+Decimal expansion of golden ratio phi (or tau) = (1 + sqrt(5))/2.
+
+> [1,6,1,8,0,3,3,9,8,8,7,4,9,8,9,4,8,4,8,2,0,4,5,8,6,8,3,4,3,6,5,6,3,8,1,1,7,7,2] `isPrefixOf` a001622
+
+> a001622_k :: Data.Number.Fixed.Fixed Data.Number.Fixed.Prec500 {- numbers -}
+-}
+a001622 :: Num n => [n]
+a001622 = map (fromIntegral . digitToInt) "161803398874989484820458683436563811772030917980576286213544862270526046281890244970720720418939113748475408807538689175212663386222353693179318006076672635443338908659593958290563832266131992829026788067520876689250171169620703222104321626954862629631361443814975870122034080588795445474924618569536486444924104432077134494704956584678850987433944221254487706647809158846074998871240076521705751797883416625624940758906970400028121042762177111777805315317141011704666599146697987317613560067087480711" ++ error "A001622"
+
+a001622_k :: Floating n => n
+a001622_k = (1 + sqrt 5) / 2
+
+{- |  <http://oeis.org/A001644>
+
+a(n) = a(n-1) + a(n-2) + a(n-3), a(0)=3, a(1)=1, a(2)=3.
+
+[3,1,3,7,11,21,39,71,131,241,443,815,1499,2757,5071,9327,17155,31553,58035,106743] `isPrefixOf` a001644
+-}
+a001644 :: Num n => [n]
+a001644 = 3 : 1 : 3 : zipWith3 (((+) .) . (+)) a001644 (tail a001644) (drop 2 a001644)
+
+{- | <https://oeis.org/A001653>
+
+Numbers k such that 2*k^2 - 1 is a square.
+
+> [1, 5, 29, 169, 985, 5741, 33461, 195025, 1136689, 6625109, 38613965, 225058681, 1311738121, 7645370045, 44560482149] `isPrefixOf` a001653
+
+-}
+a001653 :: [Integer]
+a001653 = 1 : 5 : zipWith (-) (map (* 6) (tail a001653)) a001653
+
+{- | <http://oeis.org/A001687>
+
+a(n) = a(n-2) + a(n-5).
+
+[0,1,0,1,0,1,1,1,2,1,3,2,4,4,5,7,7,11,11,16,18,23,29,34,45,52,68,81,102,126,154] `isPrefixOf` a001687
+-}
+a001687 :: Num n => [n]
+a001687 = 0 : 1 : 0 : 1 : 0 : zipWith (+) a001687 (drop 3 a001687)
+
+{- | <https://oeis.org/A001950>
+
+Upper Wythoff sequence (a Beatty sequence): a(n) = floor(n*phi^2), where phi = (1+sqrt(5))/2
+
+> [2,5,7,10,13,15,18,20,23,26,28,31,34,36,39,41,44,47,49,52,54,57,60,62,65] `isPrefixOf` a001950
+-}
+a001950 :: Integral n => [n]
+a001950 = zipWith (+) a000201 [1..]
+
+-- | <http://oeis.org/A002267>
+--
+-- The 15 supersingular primes.
+a002267 :: Num n => [n]
+a002267 = [2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 41, 47, 59, 71]
+
+{- | <https://oeis.org/A002487>
+
+Stern's diatomic series (or Stern-Brocot sequence)
+
+> [0,1,1,2,1,3,2,3,1,4,3,5,2,5,3,4,1,5,4,7,3,8,5,7,2,7,5,8,3,7,4,5] `isPrefixOf` a002487
+-}
+a002487 :: Num n => [n]
+a002487 =
+  let f (a:a') (b:b') = a + b : a : f a' b'
+      f _ _ = error "a002487"
+      x = 1 : 1 : f (tail x) x
+  in 0 : x
+
+{- | <https://oeis.org/A002858>
+
+Ulam numbers: a(1) = 1; a(2) = 2; for n>2, a(n) = least number > a(n-1) which is a unique sum of two distinct earlier terms.
+
+> [1, 2, 3, 4, 6, 8, 11, 13, 16, 18, 26, 28, 36, 38, 47, 48, 53, 57, 62, 69, 72, 77, 82, 87, 97, 99, 102, 106, 114, 126] `isPrefixOf` a002858
+-}
+a002858 :: [Integer]
+a002858 = 1 : 2 : ulam 2 2 a002858
+
+ulam :: Int -> Integer -> [Integer] -> [Integer]
+ulam n u us =
+  let u' = f (0 :: Integer) (u + 1) us'
+      f 2 z _                         = f 0 (z + 1) us'
+      f e z (v:vs) | z - v <= v       = if e == 1 then z else f 0 (z + 1) us'
+                   | z - v `elem` us' = f (e + 1) z vs
+                   | otherwise        = f e z vs
+      f _ _ []                        = error "ulam?"
+      us' = take n us
+  in u' : ulam (n + 1) u' us
+
+{- | <http://oeis.org/A003108>
+
+Number of partitions of n into cubes.
+
+> [1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3,4,4,4,5,5,5,5,5,6,6,6,7,7,7,7] `isPrefixOf` a003108
+-}
+a003108 :: Num n => [n]
+a003108 =
+  let p _ 0 = 1
+      p ks'@(k:ks) m = if m < k then 0 else p ks' (m - k) + p ks m
+      p _ _ = error "A003108"
+  in map (p (tail a000578)) [0::Integer ..]
+
+a003215_n :: Num n => n -> n
+a003215_n n = 3 * n * (n + 1) + 1
+
+{- | <http://oeis.org/A003215>
+
+Hex (or centered hexagonal) numbers: 3*n*(n+1)+1 (crystal ball sequence for hexagonal lattice).
+
+> [1,7,19,37,61,91,127,169,217,271,331,397,469,547,631,721,817,919,1027,1141] `isPrefixOf` a003215
+-}
+a003215 :: (Enum n,Num n) => [n]
+a003215 = map a003215_n [0..]
+
+-- | <http://oeis.org/A003269>
+--
+-- > [0,1,1,1,1,2,3,4,5,7,10,14,19,26,36,50,69,95,131,181,250,345,476,657] `isPrefixOf` a003269
+a003269 :: Num n => [n]
+a003269 = 0 : 1 : 1 : 1 : zipWith (+) a003269 (drop 3 a003269)
+
+{- | <http://oeis.org/A003520>
+
+a(n) = a(n-1) + a(n-5); a(0) = ... = a(4) = 1.
+
+> [1,1,1,1,1,2,3,4,5,6,8,11,15,20,26,34,45,60,80,106,140,185,245,325,431] `isPrefixOf` a003520
+-}
+a003520 :: Num n => [n]
+a003520 = 1 : 1 : 1 : 1 : 1 : zipWith (+) a003520 (drop 4 a003520)
+
+{- | <http://oeis.org/A003462>
+
+a(n) = (3^n - 1)/2. (Formerly M3463)
+
+[0, 1, 4, 13, 40, 121, 364, 1093, 3280, 9841, 29524, 88573, 265720, 797161, 2391484, 7174453] `isPrefixOf` a003462
+-}
+a003462 :: [Integer]
+a003462 = iterate ((+ 1) . (* 3)) 0
+
+a003462_n :: Integer -> Integer
+a003462_n = (`div` 2) . (subtract 1) . (3 ^)
+
+{- | <http://oeis.org/A003586>
+
+3-smooth numbers: numbers of the form 2^i*3^j with i, j >= 0
+
+[1, 2, 3, 4, 6, 8, 9, 12, 16, 18, 24, 27, 32, 36, 48, 54, 64, 72, 81, 96, 108, 128, 144, 162] `isPrefixOf` a003586
+-}
+a003586 :: [Integer]
+a003586 =
+  let smooth s = let (x, s') = Set.deleteFindMin s in x : smooth (Set.insert (3 * x) (Set.insert (2 * x) s'))
+  in  smooth (Set.singleton 1)
+
+{- | <https://oeis.org/A003849>
+
+The infinite Fibonacci word (start with 0, apply 0->01, 1->0, take limit).
+
+> [0,1,0,0,1,0,1,0,0,1,0,0,1,0,1,0,0,1,0,1,0,0,1,0,0,1,0,1,0,0,1,0,0,1,0,1,0] `isPrefixOf` a003849
+-}
+a003849 :: Num n => [n]
+a003849 =
+  let fws = [1] : [0] : zipWith (++) fws (tail fws)
+  in tail (concat fws)
+
+{- | <http://oeis.org/A004001>
+
+Hofstadter-Conway sequence: a(n) = a(a(n-1)) + a(n-a(n-1)) with a(1) = a(2) = 1.
+
+> [1,1,2,2,3,4,4,4,5,6,7,7,8,8,8,8,9,10,11,12,12,13,14,14,15,15,15,16,16,16,16,16] `isPrefixOf` a004001
+
+> plot_p1_ln [take 250 a004001]
+> plot_p1_ln [zipWith (-) a004001 (map (`div` 2) [1 .. 2000])]
+
+-}
+a004001 :: [Int]
+a004001 =
+  let h n x =
+        let x' = a004001 !! (x - 1) + a004001 !! (n - x - 1)
+        in x' : h (n + 1) x'
+  in 1 : 1 : h 3 1
+
+{- | <http://oeis.org/A004718>
+
+Per Nørgård's "infinity sequence"
+
+> take 32 a004718 == [0,1,-1,2,1,0,-2,3,-1,2,0,1,2,-1,-3,4,1,0,-2,3,0,1,-1,2,-2,3,1,0,3,-2,-4,5]
+
+> plot_p1_imp [take 1024 a004718]
+
+<https://www.tandfonline.com/doi/abs/10.1080/17459737.2017.1299807>
+<https://arxiv.org/pdf/1402.3091.pdf>
+
+-}
+a004718 :: Num n => [n]
+a004718 = 0 : concat (transpose [map (+ 1) a004718, map negate (tail a004718)])
+
+{- | <http://oeis.org/A005185>
+
+Hofstadter Q-sequence: a(1) = a(2) = 1; a(n) = a(n-a(n-1)) + a(n-a(n-2)) for n > 2.
+
+> [1,1,2,3,3,4,5,5,6,6,6,8,8,8,10,9,10,11,11,12,12,12,12,16,14,14,16,16,16,16,20] `isPrefixOf` a005185
+-}
+a005185 :: [Int]
+a005185 =
+  let ix n = a005185 !! (n - 1)
+      zadd = zipWith (+)
+      zsub = zipWith (-)
+  in 1 : 1 : zadd (map ix (zsub [3..] a005185)) (map ix (zsub [3..] (tail a005185)))
+
+{- | <https://oeis.org/A005448>
+
+Centered triangular numbers: a(n) = 3n(n-1)/2 + 1.
+
+> [1,4,10,19,31,46,64,85,109,136,166,199,235,274,316,361,409,460,514,571,631,694] `isPrefixOf` a005448
+
+> map a005448_n [1 .. 1000] `isPrefixOf` a005448
+-}
+a005448 :: Integral n => [n]
+a005448 = 1 : zipWith (+) a005448 [3,6 ..]
+
+a005448_n :: Integral n => n -> n
+a005448_n n = 3 * n * (n - 1) `div` 2 + 1
+
+{- | <http://oeis.org/A005728>
+
+Number of fractions in Farey series of order n.
+
+> [1,2,3,5,7,11,13,19,23,29,33,43,47,59,65,73,81,97,103,121,129,141,151] `isPrefixOf` a005728
+-}
+a005728 :: Integral i => [i]
+a005728 =
+  let phi n = genericLength (filter (==1) (map (gcd n) [1..n]))
+      f n = if n == 0 then 1 else f (n - 1) + phi n
+  in map f [0::Integer ..]
+
+{- | <http://oeis.org/A005811>
+
+Number of runs in binary expansion of n (n>0); number of 1's in Gray code for n
+
+> take 32 a005811 == [0,1,2,1,2,3,2,1,2,3,4,3,2,3,2,1,2,3,4,3,4,5,4,3,2,3,4,3,2,3,2,1]
+-}
+a005811 :: Integral n => [n]
+a005811 =
+  let f (x:xs) = x : f (xs ++ [x + x `mod` 2, x + 1 - x `mod` 2])
+      f _ = error "A005811"
+  in 0 : f [1]
+
+{- | <http://oeis.org/A005917>
+
+Rhombic dodecahedral numbers: a(n) = n^4 - (n - 1)^4.
+
+> [1,15,65,175,369,671,1105,1695,2465,3439,4641,6095,7825,9855,12209,14911,17985] `isPrefixOf` a005917
+-}
+a005917 :: Integral n => [n]
+a005917 =
+  let f x ws = let (us,vs) = splitAt x ws in us : f (x + 2) vs
+  in map sum (f 1 [1, 3 ..])
+
+{- | <https://oeis.org/A006003>
+
+a(n) = n*(n^2 + 1)/2.
+
+> [0,1,5,15,34,65,111,175,260,369,505,671,870,1105,1379,1695,2056,2465,2925,3439] `isPrefixOf` a006003
+
+> map a006003_n [0 .. 1000] `isPrefixOf` a006003
+-}
+a006003 :: Integral n => [n]
+a006003 = scanl (+) 0 a005448
+
+a006003_n :: Integral n => n -> n
+a006003_n n = n * (n ^ (2::Int) + 1) `div` 2
+
+{- | <http://oeis.org/A006046>
+
+Total number of odd entries in first n rows of Pascal's triangle: a(0) = 0, a(1) = 1, a(2k) = 3*a(k), a(2k+1) = 2*a(k) + a(k+1).
+
+> [0,1,3,5,9,11,15,19,27,29,33,37,45,49,57,65,81,83,87,91,99,103,111,119,135,139] `isPrefixOf` a006046
+
+> import Sound.SC3.Plot {- hsc3-plot -}
+> plot_p1_ln [take 250 a006046]
+> let t = log 3 / log 2
+> plot_p1_ln [zipWith (/) (map fromIntegral a006046) (map (\n -> n ** t) [0.0,1 .. 200])]
+-}
+a006046 :: [Int]
+a006046 = map (sum . concat) (inits a047999_tbl)
+
+{- | <http://oeis.org/A006052>
+
+Number of magic squares of order n composed of the numbers from 1 to n^2, counted up to rotations and reflections.
+
+> [1,0,1,880,275305224] == a006052
+-}
+a006052 :: Integral n => [n]
+a006052 = [1,0,1,880,275305224]
+
+{- | <http://oeis.org/A006842>
+
+Triangle read by rows: row n gives numerators of Farey series of order n.
+
+> [0,1,0,1,1,0,1,1,2,1,0,1,1,1,2,3,1,0,1,1,1,2,1,3,2,3,4,1,0,1,1,1,1,2,1,3] `isPrefixOf` a006842
+> plot_p1_imp [take 200 (a006842 :: [Int])]
+> plot_p1_pt [take 10000 (a006842 :: [Int])]
+-}
+a006842 :: Integral i => [i]
+a006842 = map numerator (concatMap Math.farey [1..])
+
+{- | <http://oeis.org/A006843>
+
+Triangle read by rows: row n gives denominators of Farey series of order n
+
+> [1,1,1,2,1,1,3,2,3,1,1,4,3,2,3,4,1,1,5,4,3,5,2,5,3,4,5,1,1,6,5,4,3,5,2,5] `isPrefixOf` a006843
+> plot_p1_imp [take 200 (a006843 :: [Int])]
+> plot_p1_pt [take 10000 (a006843 :: [Int])]
+-}
+a006843 :: Integral i => [i]
+a006843 = map denominator (concatMap Math.farey [1..])
+
+{- | <https://oeis.org/A007318>
+
+Pascal's triangle read by rows
+
+[[1],[1,1],[1,2,1],[1,3,3,1],[1,4,6,4,1],[1,5,10,10,5,1]] `isPrefixOf` a007318_tbl
+-}
+a007318 :: Integral i => [i]
+a007318 = concat a007318_tbl
+
+a007318_tbl :: Integral i => [[i]]
+a007318_tbl =
+  let f r = zipWith (+) (0 : r) (r ++ [0])
+  in iterate f [1]
+
+{- | <https://oeis.org/A008277>
+
+Triangle of Stirling numbers of the second kind, S2(n,k), n >= 1, 1 <= k <= n.
+
+[1,1,1,1,3,1,1,7,6,1,1,15,25,10,1,1,31,90,65,15,1,1,63,301,350,140,21,1] `isPrefixOf` a008277
+-}
+a008277 :: (Enum n,Num n) => [n]
+a008277 = concat a008277_tbl
+
+a008277_tbl :: (Enum n,Num n) => [[n]]
+a008277_tbl = map tail a048993_tbl
+
+{- | <http://oeis.org/A008278>
+
+Triangle of Stirling numbers of 2nd kind, S(n,n-k+1), n >= 1, 1<=k<=n.
+
+[1,1,1,1,3,1,1,6,7,1,1,10,25,15,1,1,15,65,90,31,1,1,21,140,350,301,63,1] `isPrefixOf` a008278
+-}
+a008278 :: (Enum n,Num n) => [n]
+a008278 = concat a008278_tbl
+
+a008278_tbl :: (Enum n,Num n) => [[n]]
+a008278_tbl =
+  let f p =
+        let q = reverse (zipWith (*) [1..] (reverse p))
+        in zipWith (+) (0 : q) (p ++ [0])
+  in iterate f [1]
+
+{- | <http://oeis.org/A008683>
+
+Möbius (or Moebius) function mu(n). mu(1) = 1; mu(n) = (-1)^k if n is the product of k different primes; otherwise mu(n) = 0.
+
+> [1,-1,-1,0,-1,1,-1,0,0,1,-1,0,-1,1,1,0,-1,0,-1,0,1,1,-1,0,0,1,0,0,-1,-1,-1,0,1] `isPrefixOf` a008683
+-}
+a008683 :: Integral n => [n]
+a008683 = map a008683_n [1..]
+
+a008683_n :: Integral n => n -> n
+a008683_n =
+  let mu [] = 1
+      mu (1:es) = - mu es
+      mu _ = 0
+  in mu . snd . unzip . Prime.prime_factors_m 
+
+{- | <http://oeis.org/A010049>
+
+Second-order Fibonacci numbers.
+
+> [0,1,1,3,5,10,18,33,59,105,185,324,564,977,1685,2895,4957,8462,14406,24465,41455] `isInfixOf` a010049
+-}
+a010049 :: Num n => [n]
+a010049 =
+  let c us (v:vs) = sum (zipWith (*) us (1 : reverse us)) : c (v:us) vs
+      c _ _ = error "A010049"
+  in uncurry c (splitAt 1 a000045)
+
+{- | <https://oeis.org/A010060>
+
+Thue-Morse sequence: let A_k denote the first 2^k terms; then A_0 = 0 and for k >= 0, A_{k+1} = A_k B_k, where B_k is obtained from A_k by interchanging 0's and 1's.
+
+[0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0, 0] `isPrefixOf` a010060
+
+-}
+a010060 :: [Integer]
+a010060 =
+  let interleave (x:xs) ys = x : interleave ys xs
+      interleave [] _ = error "a010060?"
+   in 0 : interleave (map (1 -) a010060) (tail a010060)
+
+{- | <https://oeis.org/A014081>
+
+a(n) is the number of occurrences of '11' in binary expansion of n.
+
+> [0, 0, 0, 1, 0, 0, 1, 2, 0, 0, 0, 1, 1, 1, 2, 3, 0, 0, 0, 1, 0, 0, 1, 2, 1, 1, 1, 2, 2, 2, 3, 4, 0, 0, 0, 1, 0, 0, 1, 2] `isPrefixOf` a014081
+
+-}
+a014081 :: (Integral i, Bits i) => [i]
+a014081 = map (\n -> a000120 !! (n .&. div n 2)) [0..]
+
+{- | <https://oeis.org/A014577>
+
+The regular paper-folding sequence (or dragon curve sequence).
+
+> [1, 1, 0, 1, 1, 0, 0, 1, 1, 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 0, 1, 1, 0, 0, 1, 0, 0, 1, 1, 1, 0, 1, 1, 0, 0, 1, 1] `isPrefixOf` a014577
+-}
+a014577 :: Integral i => [i]
+a014577 =
+  let f n = if n `rem` 2 == 1 then f (n `quot` 2) else 1 - (n `div` 2 `rem` 2)
+  in map f [0..]
+
+{- | <http://oeis.org/A016813>
+
+a(n) = 4*n + 1.
+
+> [1,5,9,13,17,21,25,29,33,37,41,45,49,53,57,61,65,69,73,77,81,85,89,93,97,101] `isPrefixOf` a016813
+-}
+a016813 :: Integral n => [n]
+a016813 = [1, 5 ..]
+
+{- | <http://oeis.org/A017817>
+
+a(n) = a(n-3) + a(n-4), with a(0)=1, a(1)=a(2)=0, a(3)=1
+
+> [1,0,0,1,1,0,1,2,1,1,3,3,2,4,6,5,6,10,11,11,16,21,22,27,37,43,49,64,80,92] `isPrefixOf` a017817
+-}
+a017817 :: Num n => [n]
+a017817 = 1 : 0 : 0 : 1 : zipWith (+) a017817 (tail a017817)
+
+{- | <http://oeis.org/A020695>
+
+Pisot sequence E(2,3).
+
+> [2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946,17711] `isPrefixOf` a020695
+-}
+a020695 :: Num n => [n]
+a020695 = drop 3 a000045
+
+{- | <https://oeis.org/A020985>
+
+The Rudin-Shapiro or Golay-Rudin-Shapiro sequence (coefficients of the Shapiro polynomials).		45
+
+> [1, 1, 1, -1, 1, 1, -1, 1, 1, 1, 1, -1, -1, -1, 1, -1, 1, 1, 1, -1, 1, 1, -1, 1, -1, -1, -1, 1, 1, 1, -1, 1, 1, 1, 1, -1] `isPrefixOf` a020985
+-}
+a020985 :: [Integer]
+a020985 =
+  let f (x:xs) w = x : x*w : f xs (0 - w)
+      f [] _ = error "a020985?"
+  in 1 : 1 : f (tail a020985) (-1)
+
+{- | <http://oeis.org/A022095>
+
+Fibonacci sequence beginning 1, 5.
+
+> [1,5,6,11,17,28,45,73,118,191,309,500,809,1309,2118,3427,5545,8972,14517,23489] `isPrefixOf` a022095
+-}
+a022095 :: Num n => [n]
+a022095 = 1 : 5 : zipWith (+) a022095 (tail a022095)
+
+{- | <http://oeis.org/A022096>
+
+Fibonacci sequence beginning 1, 6.
+
+> [1,6,7,13,20,33,53,86,139,225,364,589,953,1542,2495,4037,6532,10569,17101,27670] `isPrefixOf` a022096
+-}
+a022096 :: Num n => [n]
+a022096 = 1 : 6 : zipWith (+) a022096 (tail a022096)
+
+{- | <https://oeis.org/A027750>
+
+Triangle read by rows in which row n lists the divisors of n.
+
+> [1,1,2,1,3,1,2,4,1,5,1,2,3,6,1,7,1,2,4,8,1,3,9,1,2,5,10,1,11,1,2,3,4,6,12,1,13] `isPrefixOf` a027750
+-}
+a027750 :: Integral n => [n]
+a027750 = concatMap a027750_row [1..]
+
+a027750_row :: Integral n => n -> [n]
+a027750_row n = filter ((== 0) . (mod n)) [1..n]
+
+{- | <http://oeis.org/A027934>
+
+a(0)=0, a(1)=1, a(2)=2; for n > 2, a(n) = 3*a(n-1) - a(n-2) - 2*a(n-3).
+
+> [0,1,2,5,11,24,51,107,222,457,935,1904,3863,7815,15774,31781,63939,128488] `isPrefixOf` a027934
+-}
+a027934 :: Num n => [n]
+a027934 =
+  let f x y z = 3 * x - y - 2 * z
+  in 0 : 1 : 2 : zipWith3 f (drop 2 a027934) (tail a027934) a027934
+
+{- | <http://oeis.org/A029635>
+
+The (1,2)-Pascal triangle (or Lucas triangle) read by rows.
+
+> [2,1,2,1,3,2,1,4,5,2,1,5,9,7,2,1,6,14,16,9,2,1,7,20,30,25,11,2,1,8,27,50,55,36] `isPrefixOf` a029635
+> take 7 a029635_tbl == [[2],[1,2],[1,3,2],[1,4,5,2],[1,5,9,7,2],[1,6,14,16,9,2],[1,7,20,30,25,11,2]]
+-}
+a029635 :: Num i => [i]
+a029635 = concat a029635_tbl
+
+a029635_tbl :: Num i => [[i]]
+a029635_tbl =
+  let f r = zipWith (+) (0 : r) (r ++ [0])
+  in [2] : iterate f [1,2]
+
+{- | <http://oeis.org/A030308>
+
+Triangle T(n,k): Write n in base 2, reverse order of digits, to get the n-th row
+
+> take 9 a030308 == [[0],[1],[0,1],[1,1],[0,0,1],[1,0,1],[0,1,1],[1,1,1],[0,0,0,1]]
+-}
+a030308 :: (Eq n,Num n) => [[n]]
+a030308 =
+   let f l = case l of
+         [] -> [1]
+         0:b -> 1 : b
+         1:b -> 0 : f b
+         _ -> error "A030308"
+   in iterate f [0]
+
+{- | <https://oeis.org/A033622>
+
+Good sequence of increments for Shell sort (best on big values).
+
+[1, 5, 19, 41, 109, 209, 505, 929, 2161, 3905, 8929, 16001, 36289, 64769, 146305, 260609, 587521] `isPrefixOf` a033622
+-}
+a033622 :: [Integer]
+a033622 = map a033622_n [0..]
+
+a033622_n :: Integer -> Integer
+a033622_n n =
+  if even n
+  then 9 * 2 ^ n - 9 * 2 ^ ( n `div` 2) + 1
+  else 8 * 2 ^ n - 6 * 2 ^ ((n + 1 )`div` 2) + 1
+
+{- | <http://oeis.org/A033812>
+
+The Loh-Shu 3 X 3 magic square, lexicographically largest variant when read by columns.
+-}
+a033812 :: Num n => [n]
+a033812 = [8, 1, 6, 3, 5, 7, 4, 9, 2]
+
+{- | <http://oeis.org/A034968>
+
+Minimal number of factorials that add to n.
+
+> [0,1,1,2,2,3,1,2,2,3,3,4,2,3,3,4,4,5,3,4,4,5,5,6,1,2,2,3,3,4,2,3,3,4,4,5,3,4,4] `isPrefixOf` a034968
+-}
+a034968 :: Integral n => [n]
+a034968 =
+  let f i s n = if n == 0 then s else f (i + 1) (s + rem n i) (quot n i)
+  in map (f 2 0) [0 ..]
+
+{- | <https://oeis.org/A036562>
+
+a(n) = 4^(n+1) + 3*2^n + 1
+
+[1, 8, 23, 77, 281, 1073, 4193, 16577, 65921, 262913, 1050113, 4197377, 16783361, 67121153] `isPrefixOf` a036562
+-}
+a036562 :: [Integer]
+a036562 = 1 : map a036562_n [0..]
+
+a036562_n :: Integer -> Integer
+a036562_n n = 4^(n+1) + 3*2^n + 1
+
+{- | <http://oeis.org/A046042>
+
+Number of partitions of n into fourth powers.
+
+> [1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,2,3,3,3,3,3,3,3,3] `isPrefixOf` a046042
+-}
+a046042 :: Num n => [n]
+a046042 =
+  let p _ 0 = 1
+      p ks'@(k:ks) m = if m < k then 0 else p ks' (m - k) + p ks m
+      p _ _ = error "A046042"
+  in map (p (tail a000583)) [1::Integer ..]
+
+{- | <http://oeis.org/A047999>
+
+Sierpiński's triangle (or gasket): triangle, read by rows, formed by reading Pascal's triangle mod 2.
+
+> [1,1,1,1,0,1,1,1,1,1,1,0,0,0,1,1,1,0,0,1,1,1,0,1,0,1,0,1,1,1,1,1,1,1,1,1,1,0,0] `isPrefixOf` a047999
+-}
+a047999 :: [Int]
+a047999 = concat a047999_tbl
+
+a047999_tbl :: [[Int]]
+a047999_tbl = iterate (\r -> zipWith xor (0 : r) (r ++ [0])) [1]
+
+{- | <https://oeis.org/A048993>
+
+Triangle of Stirling numbers of 2nd kind, S(n,k), n >= 0, 0 <= k <= n.
+
+> [1,0,1,0,1,1,0,1,3,1,0,1,7,6,1,0,1,15,25,10,1,0,1,31,90,65,15,1] `isPrefixOf` a048993
+-}
+a048993 :: (Enum n,Num n) => [n]
+a048993 = concat a048993_tbl
+
+a048993_tbl :: (Enum n,Num n) => [[n]]
+a048993_tbl = iterate (\row -> 0 : zipWith (+) row (zipWith (*) [1..] (tail row)) ++ [1]) [1]
+
+{- | <http://oeis.org/A049455>
+
+Triangle read by rows, numerator of fractions of a variant of the Farey series.
+
+> [0,1,0,1,1,0,1,1,2,1,0,1,1,2,1,3,2,3,1,0,1,1,2,1,3,2,3,1,4,3,5,2,5,3,4,1,0] `isPrefixOf` a049455
+> plot_p1_imp [take 200 (a049455 :: [Int])]
+> plot_p1_pt [take 10000 (a049455 :: [Int])]
+-}
+a049455 :: Integral n => [n]
+a049455 = map fst (concat Math.stern_brocot_tree_lhs)
+
+{- | <http://oeis.org/A049456>
+
+Triangle read by rows, denominator of fractions of a variant of the Farey series.
+
+[1,1,1,2,1,1,3,2,3,1,1,4,3,5,2,5,3,4,1,1,5,4,7,3,8,5,7,2,7,5,8,3,7,4,5,1,1,6,5,9] `isPrefixOf` a049456
+> plot_p1_imp [take 200 (a049456 :: [Int])]
+> plot_p1_pt [take 10000 (a049456 :: [Int])]
+-}
+a049456 :: Integral n => [n]
+a049456 = map snd (concat Math.stern_brocot_tree_lhs)
+
+{- | <http://oeis.org/A053121>
+
+Catalan triangle (with 0's) read by rows.
+
+> [1,0,1,1,0,1,0,2,0,1,2,0,3,0,1,0,5,0,4,0,1,5,0,9,0,5,0,1,0,14,0,14,0,6,0,1,14,0] `isPrefixOf` a053121
+> take 7 a053121_tbl == [[1],[0,1],[1,0,1],[0,2,0,1],[2,0,3,0,1],[0,5,0,4,0,1],[5,0,9,0,5,0,1]]
+-}
+a053121 :: Num n => [n]
+a053121 = concat a053121_tbl
+
+a053121_tbl :: Num n => [[n]]
+a053121_tbl = iterate (\row -> zipWith (+) (0 : row) (tail row ++ [0, 0])) [1]
+
+{- | <http://oeis.org/A058265>
+
+Decimal expansion of the tribonacci constant t, the real root of x^3 - x^2 - x - 1.
+
+> [1,8,3,9,2,8,6,7,5,5,2,1,4,1,6,1,1,3,2,5,5,1,8,5,2,5,6,4,6,5,3,2,8,6,6,0,0,4,2] `isPrefixOf` a058265
+
+> a058265_k :: Data.Number.Fixed.Fixed Data.Number.Fixed.Prec500 {- numbers -}
+-}
+a058265 :: Num n => [n]
+a058265 = map (fromIntegral . digitToInt) "183928675521416113255185256465328660042417874609759224677875863940420322208196642573843541942830701414197982685924097416417845074650743694383154582049951379624965553964461366612154027797267811894104121160922328215595607181671218236598665227337853781569698925211739579141322872106187898408525495693114534913498534595761750359652213238142472727224173581877000697905510254904496571074252654772281100659893755563630933305282623575385197199429914530082546639774729005870059744813919316728258488396263329709" ++ error "A058265"
+
+-- | A058265 as 'Floating' calculation, see "Data.Number.Fixed".
+a058265_k :: Floating n => n
+a058265_k = (1/3) * (1 + (19 + 3 * sqrt 33) ** (1/3) + (19 - 3 * sqrt 33)  ** (1/3))
+
+{- | <http://oeis.org/A060588>
+
+If the final two digits of n written in base 3 are the same then this digit, otherwise mod 3-sum of these two digits.
+
+> [0,2,1,2,1,0,1,0,2,0,2,1,2,1,0,1,0,2,0,2,1,2,1,0,1,0,2,0,2,1,2,1,0,1,0,2,0,2,1] `isPrefixOf` a060588a
+-}
+a060588a :: Integral n => [n]
+a060588a = map a060588a_n [0..]
+
+a060588a_n :: Integral n => n -> n
+a060588a_n n = (-n - floor (fromIntegral n / (3::Double))) `mod` 3
+
+{- | <http://oeis.org/A061654>
+
+a(n) = (3*16^n + 2)/5
+
+> [1,10,154,2458,39322,629146,10066330,161061274,2576980378,41231686042] `isPrefixOf` a061654
+-}
+a061654 :: Integral n => [n]
+a061654 = map a061654_n [0 ..]
+
+a061654_n :: Integral n => n -> n
+a061654_n n = (3 * 16^n + 2) `div` 5
+
+{- | <http://oeis.org/A071996>
+
+a(1) = 0, a(2) = 1, a(n) = a(floor(n/3)) + a(n - floor(n/3)).
+
+> [0,1,1,1,1,2,2,3,3,3,4,4,4,4,4,5,5,6,6,6,6,6,7,8,8,9,9,9,9,9,9,9,10,11,12,12,12] `isPrefixOf` a071996
+
+> plot_p1_ln [take 50 a000201 :: [Int]]
+> plot_p1_imp [map length (take 250 (group a071996))]
+-}
+a071996 :: Integral n => [n]
+a071996 =
+  let f n =
+        case n of
+          0 -> error "A071996"
+          1 -> 0
+          2 -> 1
+          _ -> let m = floor (fromIntegral n / (3::Double)) in f m + f (n - m)
+  in map f [1::Int ..]
+
+{- | <http://oeis.org/A073334>
+
+The "rhythmic infinity system" of Danish composer Per Nørgård
+
+> take 24 a073334 == [3,5,8,5,8,13,8,5,8,13,21,13,8,13,8,5,8,13,21,13,21,34,21,13]
+> plot_p1_imp [take 200 (a073334 :: [Int])]
+-}
+a073334 :: Num n => [n]
+a073334 =
+  let f n = a000045 !! ((a005811 !! n) + 4)
+  in 3 : map f [1..]
+
+{- | <https://oeis.org/A080843>
+
+Tribonacci word: limit S(infinity), where S(0) = 0, S(1) = 0,1, S(2) = 0,1,0,2 and for n >= 0, S(n+3) = S(n+2) S(n+1) S(n).
+
+> [0,1,0,2,0,1,0,0,1,0,2,0,1,0,1,0,2,0,1,0,0,1,0,2,0,1,0,2,0,1,0,0,1,0,2,0,1,0,1] `isPrefixOf` a080843
+-}
+a080843 :: Integral n => [n]
+a080843 =
+  let rw n = case n of {0 -> [0,1];1 -> [0,2];2 -> [0];_ -> error "A080843"}
+      unf = let f n l = case l of {[] -> error "A080843";x:xs -> drop n x ++ f (length x) xs} in f 0
+  in unf (iterate (concatMap rw) [0])
+
+{- | <http://oeis.org/A080992>
+
+Entries in Durer's magic square.
+
+> [16,3,2,13,5,10,11,8,9,6,7,12,4,15,14,1] == a080992
+-}
+a080992 :: Num n => [n]
+a080992 =
+  [16,03,02,13
+  ,05,10,11,08
+  ,09,06,07,12
+  ,04,15,14,01]
+
+{- | <http://oeis.org/A083866>
+
+Positions of zeros in Per Nørgård's infinity sequence (A004718).
+
+> take 24 a083866 == [0,5,10,17,20,27,34,40,45,54,65,68,75,80,85,90,99,105,108,119,130,136,141,150]
+-}
+a083866 :: (Enum n,Num n) => [n]
+a083866 = map snd (filter ((== (0::Int)) . fst) (zip a004718 [0..]))
+
+{- | <http://oeis.org/A095660>
+
+Pascal (1,3) triangle.
+
+> [3,1,3,1,4,3,1,5,7,3,1,6,12,10,3,1,7,18,22,13,3,1,8,25,40,35,16,3,1,9,33,65,75] `isPrefixOf` a095660
+> take 6 a095660_tbl == [[3],[1,3],[1,4,3],[1,5,7,3],[1,6,12,10,3],[1,7,18,22,13,3]]
+-}
+a095660 :: Num i => [i]
+a095660 = concat a095660_tbl
+
+a095660_tbl :: Num i => [[i]]
+a095660_tbl =
+  let f r = zipWith (+) (0 : r) (r ++ [0])
+  in [3] : iterate f [1,3]
+
+{- | <http://oeis.org/A095666>
+
+Pascal (1,4) triangle.
+
+> [4,1,4,1,5,4,1,6,9,4,1,7,15,13,4,1,8,22,28,17,4,1,9,30,50,45,21,4,1,10,39,80,95] `isPrefixOf` a095666
+> take 6 a095666_tbl == [[4],[1,4],[1,5,4],[1,6,9,4],[1,7,15,13,4],[1,8,22,28,17,4]]
+-}
+a095666 :: Num i => [i]
+a095666 = concat a095666_tbl
+
+a095666_tbl :: Num i => [[i]]
+a095666_tbl =
+  let f r = zipWith (+) (0 : r) (r ++ [0])
+  in [4] : iterate f [1,4]
+
+{- | <http://oeis.org/A096940>
+
+Pascal (1,5) triangle.
+
+> [5,1,5,1,6,5,1,7,11,5,1,8,18,16,5,1,9,26,34,21,5,1,10,35,60,55,26,5,1,11,45,95] `isPrefixOf` a096940
+> take 6 a096940_tbl == [[5],[1,5],[1,6,5],[1,7,11,5],[1,8,18,16,5],[1,9,26,34,21,5]]
+-}
+a096940 :: Num i => [i]
+a096940 = concat a096940_tbl
+
+a096940_tbl :: Num i => [[i]]
+a096940_tbl =
+  let f r = zipWith (+) (0 : r) (r ++ [0])
+  in [5] : iterate f [1,5]
+
+{- | <http://oeis.org/A105809>
+
+A Fibonacci-Pascal matrix.
+
+> [1,1,1,2,2,1,3,4,3,1,5,7,7,4,1,8,12,14,11,5,1,13,20,26,25,16,6,1,21,33,46,51,41] `isPrefixOf` a105809
+-}
+a105809 :: Num n => [n]
+a105809 = concat a105809_tbl
+
+a105809_tbl :: Num n => [[n]]
+a105809_tbl =
+  let f (u:_, vs) = (vs, zipWith (+) (u : vs) (vs ++ [0]))
+      f _ = error "A105809"
+  in map fst (iterate f ([1], [1, 1]))
+
+{- | <http://oeis.org/A124010>
+
+Triangle in which first row is 0, n-th row (n>1) lists the (ordered)
+prime signature of n, that is, the exponents of distinct prime factors
+in factorization of n.
+
+> [0,1,1,2,1,1,1,1,3,2,1,1,1,2,1,1,1,1,1,1,4,1,1,2,1,2,1,1,1,1,1,1,3,1,2,1,1,3,2,1,1,1,1,1,1,5,1] `isPrefixOf` a124010
+-}
+a124010 :: Integral n => [n]
+a124010 = concatMap a124010_row [1..]
+
+a124010_row :: Integral n => n -> [n]
+a124010_row n =
+  let f u w =
+        case (u, w) of
+          (1, _) -> []
+          (_, p:ps) ->
+            let h v e =
+                  let (v', m) = divMod v p
+                  in if m == 0
+                     then h v' (e + 1)
+                     else if e > 0
+                          then e : f v ps
+                          else f v ps
+            in h u 0
+          _ -> error "a124010"
+  in if n == 1 then [0] else f n a000040
+
+{- | <https://oeis.org/A124472>
+
+Benjamin Franklin's 16 X 16 magic square read by rows.
+
+> [200,217,232,249,8,25,40,57,72,89,104,121,136,153,168,185,58,39,26,7,250,231] `isPrefixOf` a124472
+-}
+a124472 :: Num n => [n]
+a124472 =
+  concat
+  [[200,217,232,249,8,25,40,57,72,89,104,121,136,153,168,185]
+  ,[58,39,26,7,250,231,218,199,186,167,154,135,122,103,90,71]
+  ,[198,219,230,251,6,27,38,59,70,91,102,123,134,155,166,187]
+  ,[60,37,28,5,252,229,220,197,188,165,156,133,124,101,92,69]
+  ,[201,216,233,248,9,24,41,56,73,88,105,120,137,152,169,184]
+  ,[55,42,23,10,247,234,215,202,183,170,151,138,119,106,87,74]
+  ,[203,214,235,246,11,22,43,54,75,86,107,118,139,150,171,182]
+  ,[53,44,21,12,245,236,213,204,181,172,149,140,117,108,85,76]
+  ,[205,212,237,244,13,20,45,52,77,84,109,116,141,148,173,180]
+  ,[51,46,19,14,243,238,211,206,179,174,147,142,115,110,83,78]
+  ,[207,210,239,242,15,18,47,50,79,82,111,114,143,146,175,178]
+  ,[49,48,17,16,241,240,209,208,177,176,145,144,113,112,81,80]
+  ,[196,221,228,253,4,29,36,61,68,93,100,125,132,157,164,189]
+  ,[62,35,30,3,254,227,222,195,190,163,158,131,126,99,94,67]
+  ,[194,223,226,255,2,31,34,63,66,95,98,127,130,159,162,191]
+  ,[64,33,32,1,256,225,224,193,192,161,160,129,128,97,96,65]]
+
+{- | <http://oeis.org/A125519>
+
+A 4 x 4 permutation-free magic square.
+-}
+a125519 :: Num n => [n]
+a125519 = [831,326,267,574,584,257,316,841,158,683,742,415,425,732,673,168]
+
+{- | <http://oeis.org/A126275>
+
+Moment of inertia of all magic squares of order n.
+
+> [5,60,340,1300,3885,9800,21840,44280,83325,147620,248820,402220,627445,949200] `isPrefixOf` a126275
+-}
+a126275 :: Integral n => [n]
+a126275 = map a126275_n [2..]
+
+a126275_n :: Integral n => n -> n
+a126275_n n = (n ^ (2::Int) * (n ^ (4::Int) - 1)) `div` 12
+
+{- | <http://oeis.org/A126276>
+
+Moment of inertia of all magic cubes of order n.
+
+> [18,504,5200,31500,136710,471968,1378944,3547800,8258250,17728920,35603568] `isPrefixOf` a126276
+-}
+a126276 :: Integral n => [n]
+a126276 = map a126276_n [2..]
+
+a126276_n :: Integral n => n -> n
+a126276_n n = (n ^ (3::Int) * (n ^ (3::Int) + 1) * (n ^ (2::Int) - 1)) `div` 12
+
+{- | <http://oeis.org/A126651>
+
+A 7 x 7 magic square.
+-}
+a126651 :: Num n => [n]
+a126651 =
+  [71,  1, 51, 32, 50,  2, 80
+  ,21, 41, 61, 56, 26, 13, 69
+  ,31, 81, 11, 20, 62, 65, 17
+  ,34, 40, 60, 43, 28, 64, 18
+  ,48, 42, 22, 54, 39, 75,  7
+  ,33, 53, 15, 68, 16, 44, 58
+  ,49, 29, 67, 14, 66, 24, 38]
+
+{- | <http://oeis.org/A126652>
+
+A 3 X 3 magic square with magic sum 75: the Loh-Shu square A033812 multiplied by 5.
+
+> a126652 == map (* 5) a033812
+-}
+a126652 :: Num n => [n]
+a126652 = [40, 5, 30, 15, 25, 35, 20, 45, 10]
+
+{- | <http://oeis.org/A126653>
+
+A 3 X 3 magic square with magic sum 45: the Loh-Shu square A033812 multiplied by 3.
+
+> a126653 == map (* 3) a033812
+-}
+a126653 :: Num n => [n]
+a126653 = [24, 3, 18, 9, 15, 21, 12, 27, 6]
+
+{- | <http://oeis.org/A126654>
+
+A 3 x 3 magic square.
+-}
+a126654 :: Num n => [n]
+a126654 = [32, 4, 24, 12, 20, 28, 16, 36, 8]
+
+{- | <http://oeis.org/A126709>
+
+The Loh-Shu 3 x 3 magic square, variant 2.
+
+Loh-Shu magic square, attributed to the legendary Fu Xi (Fuh-Hi).
+-}
+a126709 :: Num n => [n]
+a126709 =
+  [4,9,2
+  ,3,5,7
+  ,8,1,6]
+
+{- | <http://oeis.org/A126710>
+
+Jaina inscription of the twelfth or thirteenth century, Khajuraho, India.
+-}
+a126710 :: Num n => [n]
+a126710 =
+  [ 7,12, 1,14
+  , 2,13, 8,11
+  ,16, 3,10, 5
+  , 9, 6,15, 4]
+
+{- | <http://oeis.org/A126976>
+
+A 6 x 6 magic square read by rows.
+
+Agrippa (Magic Square of the Sun)
+-}
+a126976 :: Num n => [n]
+a126976 =
+  [06,32,03,34,35,01
+  ,07,11,27,28,08,30
+  ,19,14,16,15,23,24
+  ,18,20,22,21,17,13
+  ,25,29,10,09,26,12
+  ,36,05,33,04,02,31]
+
+{- | <https://oeis.org/A212804>
+
+Expansion of (1 - x)/(1 - x - x^2).
+
+[1,0,1,1,2,3,5,8,13,21,34,55,89,144,233,377,610,987,1597,2584,4181,6765,10946] `isPrefixOf` a212804
+-}
+a212804 :: Integral n => [n]
+a212804 = 1 : a000045
+
+{- | <https://oeis.org/A245553>
+
+A Rauzy fractal sequence: trajectory of 1 under morphism 1 -> 2,3; 2 -> 3; 3 -> 1.
+
+> [1,2,3,2,3,3,1,2,3,3,1,3,1,1,2,3,2,3,3,1,3,1,1,2,3,3,1,1,2,3,1,2,3,2,3,3,1,2,3] `isPrefixOf` a245553
+-}
+a245553 :: Integral n => [n]
+a245553 =
+  let rw n = case n of {1 -> [2,3];2 -> [3];3 -> [1];_ -> error "A245553"}
+      jn x = x ++ concatMap rw x
+      unf = let f n l = case l of {[] -> error "A245553";x:xs -> drop n x ++ f (length x) xs} in f 0
+  in unf (iterate jn [1])
+
+{- | <http://oeis.org/A255723>
+
+Another variant of Per Nørgård's "infinity sequence"
+
+> take 24 a255723 == [0,-2,-1,2,-2,-4,1,0,-1,-3,0,1,2,0,-3,4,-2,-4,1,0,-4,-6,3,-2]
+> plot_p1_imp [take 400 (a255723 :: [Int])]
+-}
+a255723 :: Num n => [n]
+a255723 = 0 : concat (transpose [map (subtract 2) a255723
+                                ,map (-1 -) a255723
+                                ,map (+ 2) a255723
+                                ,tail a255723])
+
+{- | <http://oeis.org/A256184>
+
+First of two variations by Per Nørgård of his "infinity sequence"
+
+> take 24 a256184 == [0,-2,-1,2,-4,-3,1,-3,-2,-2,0,1,4,-6,-5,3,-5,-4,-1,-1,0,3,-5,-4]
+-}
+a256184 :: Num n => [n]
+a256184 = 0 : concat (transpose [map (subtract 2) a256184
+                                ,map (subtract 1) a256184
+                                ,map negate (tail a256184)])
+
+{- | <http://oeis.org/A256185>
+
+Second of two variations by Per Nørgård of his "infinity sequence"
+
+> take 24 a256185 == [0,-3,-2,3,-6,1,2,-5,0,-3,0,-5,6,-9,4,-1,-2,-3,-2,-1,-4,5,-8,3]
+-}
+a256185 :: Num n => [n]
+a256185 = 0 : concat (transpose [map (subtract 3) a256185
+                                ,map (-2 -) a256185
+                                ,map negate (tail a256185)])
+
+{- | <http://oeis.org/A270876>
+
+Number of magic tori of order n composed of the numbers from 1 to n^2.
+
+> [1,0,1,255,251449712] == a270876
+-}
+a270876 :: Integral n => [n]
+a270876 = [1,0,1,255,251449712]
+
+{- | <http://oeis.org/A320872>
+
+For all possible 3 X 3 magic squares made of primes, in order of increasing magic sum, list the lexicographically smallest representative of each equivalence class (modulo symmetries of the square), as a row of the 9 elements (3 rows of 3 elements each).
+-}
+a320872 :: Num n => [n]
+a320872 =
+  [17, 89,  71,  113,  59,  5, 47, 29, 101
+  ,41, 89,  83,  113,  71, 29, 59, 53, 101
+  ,37, 79,  103, 139,  73,  7, 43, 67, 109
+  ,29, 131, 107, 167,  89, 11, 71, 47, 149
+  ,43, 127, 139, 199, 103,  7, 67, 79, 163
+  ,37, 151, 139, 211, 109,  7, 79, 67, 181
+  ,43, 181, 157, 241, 127, 13, 97, 73, 211]
diff --git a/Music/Theory/Math/Prime.hs b/Music/Theory/Math/Prime.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Prime.hs
@@ -0,0 +1,234 @@
+-- | Prime number related functions.
+module Music.Theory.Math.Prime where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ratio {- base -}
+
+import qualified Data.Numbers.Primes as Primes {- primes -}
+
+import qualified Music.Theory.Function as Function {- hmt -}
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Math as Math {- hmt -}
+import qualified Music.Theory.Unicode as Unicode {- hmt -}
+
+-- | Alias for 'Primes.primes'.
+--
+-- > take 12 primes_list == [2,3,5,7,11,13,17,19,23,29,31,37]
+primes_list :: Integral i => [i]
+primes_list = Primes.primes
+
+-- | Give zero-index of prime, or Nothing if value is not prime.
+--
+-- > map prime_k [2,3,5,7,11,13,17,19,23,29,31,37] == map Just [0 .. 11]
+-- > map prime_k [1,4,6,8,9,10,12,14,15,16,18,20,21,22] == replicate 14 Nothing
+prime_k :: Integral a => a -> Maybe Int
+prime_k i = if Primes.isPrime i then Just (List.findIndex_err (== i) primes_list) else Nothing
+
+-- | 'maybe' 'error' of 'prime_k'
+--
+-- > prime_k_err 13 == 5
+prime_k_err :: Integral a => a -> Int
+prime_k_err = fromMaybe (error "prime_k: not prime?") . prime_k
+
+{- | Generate list of factors of /n/ from /x/.
+
+> factor primes_list 315 == [3,3,5,7]
+> Primes.primeFactors 315 == [3,3,5,7]
+
+As a special case 1 gives the empty list.
+
+> factor primes_list 1 == []
+> Primes.primeFactors 1 == []
+-}
+factor :: Integral i => [i] -> i -> [i]
+factor x n =
+    case x of
+      [] -> error "factor: null primes_list input"
+      i:x' -> if n < i
+              then [] -- ie. prime factors of 1...
+              else if i * i > n
+                   then [n]
+                   else if rem n i == 0
+                        then i : factor x (quot n i)
+                        else factor x' n
+
+-- | 'factor' of 'primes_list'.
+--
+-- > map prime_factors [-1,0,1] == [[],[],[]]
+-- > map prime_factors [1,4,231,315] == [[],[2,2],[3,7,11],[3,3,5,7]]
+-- > map Primes.primeFactors [1,4,231,315] == [[],[2,2],[3,7,11],[3,3,5,7]]
+prime_factors :: Integral i => i -> [i]
+prime_factors = factor primes_list
+
+-- | 'maximum' of 'prime_factors'
+--
+-- > map prime_limit [243,125] == [3,5]
+-- > map prime_limit [0,1] == [1,1]
+prime_limit :: Integral i => i -> i
+prime_limit x = if x < 2 then 1 else maximum (prime_factors x)
+
+-- | Collect number of occurences of each element of a sorted list.
+--
+-- > multiplicities [1,1,1,2,2,3] == [(1,3),(2,2),(3,1)]
+multiplicities :: Eq t => [t] -> [(t,Int)]
+multiplicities = List.generic_histogram_by (==) Nothing
+
+-- | Pretty printer for histogram (multiplicites).
+--
+-- > multiplicities_pp [(3,2),(5,1),(7,1)] == "3×2 5×1 7×1"
+multiplicities_pp :: Show t => [(t,Int)] -> String
+multiplicities_pp =
+  let f (x,y) = show x ++ "×" ++ show y
+  in unwords . map f
+
+-- | 'multiplicities' of 'Primes.primeFactors'.
+--
+-- > prime_factors_m 1 == []
+-- > prime_factors_m 315 == [(3,2),(5,1),(7,1)]
+prime_factors_m :: Integral i => i -> [(i,Int)]
+prime_factors_m = multiplicities . Primes.primeFactors
+
+-- | 'multiplicities_pp' of 'prime_factors_m'.
+prime_factors_m_pp :: (Show i,Integral i) => i -> String
+prime_factors_m_pp = multiplicities_pp . prime_factors_m
+
+-- | Prime factors of /n/ and /d/.
+rat_prime_factors :: Integral i => (i,i) -> ([i],[i])
+rat_prime_factors = Function.bimap1 Primes.primeFactors
+
+-- | 'Ratio' variant of 'rat_prime_factors'
+rational_prime_factors :: Integral i => Ratio i -> ([i],[i])
+rational_prime_factors = rat_prime_factors . Math.rational_nd
+
+{- | Variant that writes factors of numerator as positive and factors for denominator as negative.
+     Sorted by absolute value.
+
+> rat_prime_factors_sgn (3 * 5 * 7 * 11,1) == [3,5,7,11]
+> rat_prime_factors_sgn (3 * 5,7 * 11) == [3,5,-7,-11]
+> rat_prime_factors_sgn (3 * 7,5) == [3,-5,7]
+-}
+rat_prime_factors_sgn :: Integral i => (i,i) -> [i]
+rat_prime_factors_sgn r = let (n,d) = rat_prime_factors r in sortOn abs (n ++ map negate d)
+
+-- | Rational variant.
+--
+-- > rational_prime_factors_sgn (2 * 2 * 2 * 1/3 * 1/3 * 1/3 * 1/3 * 5) == [2,2,2,-3,-3,-3,-3,5]
+rational_prime_factors_sgn :: Integral i => Ratio i -> [i]
+rational_prime_factors_sgn = rat_prime_factors_sgn . Math.rational_nd
+
+-- | The largest prime factor of n/d.
+rat_prime_limit :: Integral i => (i,i) -> i
+rat_prime_limit = uncurry max . Function.bimap1 prime_limit
+
+-- | The largest prime factor of /n/.
+--
+-- > rational_prime_limit (243/125) == 5
+rational_prime_limit :: Integral i => Ratio i -> i
+rational_prime_limit = rat_prime_limit . Math.rational_nd
+
+-- | Merge function for 'rat_prime_factors_m'
+rat_pf_merge :: Ord t => [(t,Int)] -> [(t,Int)] -> [(t,Int)]
+rat_pf_merge p q =
+  case (p,q) of
+    (_,[]) -> p
+    ([],_) -> map (\(i,j) -> (i,-j)) q
+    ((a,b):p',(c,d):q') ->
+      if a < c
+      then (a,b) : rat_pf_merge p' q
+      else if a > c
+           then (c,-d) : rat_pf_merge p q'
+           else if b /= d
+                then (a,b-d) : rat_pf_merge p' q'
+                else rat_pf_merge p' q'
+
+{- | Collect the prime factors in a rational number given as a
+numerator/ denominator pair (n,m). Prime factors are listed in
+ascending order with their positive or negative multiplicities,
+depending on whether the prime factor occurs in the numerator or the
+denominator (after cancelling out common factors).
+
+> rat_prime_factors_m (1,1) == []
+> rat_prime_factors_m (16,15) == [(2,4),(3,-1),(5,-1)]
+> rat_prime_factors_m (10,9) == [(2,1),(3,-2),(5,1)]
+> rat_prime_factors_m (81,64) == [(2,-6),(3,4)]
+> rat_prime_factors_m (27,16) == [(2,-4),(3,3)]
+> rat_prime_factors_m (12,7) == [(2,2),(3,1),(7,-1)]
+> rat_prime_factors_m (5,31) == [(5,1),(31,-1)]
+-}
+rat_prime_factors_m :: Integral i => (i,i) -> [(i,Int)]
+rat_prime_factors_m (n,d) = rat_pf_merge (prime_factors_m n) (prime_factors_m d)
+
+-- | 'Ratio' variant of 'rat_prime_factors_m'
+rational_prime_factors_m :: Integral i => Ratio i -> [(i,Int)]
+rational_prime_factors_m = rat_prime_factors_m . Math.rational_nd
+
+-- | Variant of 'rat_prime_factors_m' giving results in a list.
+--
+-- > rat_prime_factors_l (1,1) == []
+-- > rat_prime_factors_l (2^5,9) == [5,-2]
+-- > rat_prime_factors_l (2*2*3,7) == [2,1,0,-1]
+-- > rat_prime_factors_l (3*3,11*13) == [0,2,0,0,-1,-1]
+rat_prime_factors_l :: Integral i => (i,i) -> [Int]
+rat_prime_factors_l x =
+  case rat_prime_factors_m x of
+    [] -> []
+    r -> let lm = maximum (map fst r)
+         in map (\i -> fromMaybe 0 (lookup i r)) (List.take_until (== lm) primes_list)
+
+-- | 'Ratio' variant of 'rat_prime_factors_l'
+--
+-- > map rational_prime_factors_l [1/31,256/243] == [[0,0,0,0,0,0,0,0,0,0,-1],[8,-5]]
+rational_prime_factors_l :: Integral i => Ratio i -> [Int]
+rational_prime_factors_l = rat_prime_factors_l . Math.rational_nd
+
+-- | Variant of 'rational_prime_factors_l' padding table to /k/ places.
+--   It is an error for /k/ to indicate a prime less than the limit of /x/.
+--
+-- > map (rat_prime_factors_t 6) [(5,13),(12,7)] == [[0,0,1,0,0,-1],[2,1,0,-1,0,0]]
+-- > rat_prime_factors_t 3 (9,7) == undefined
+rat_prime_factors_t :: (Integral i,Show i) => Int -> (i,i) -> [Int]
+rat_prime_factors_t k = List.pad_right_err 0 k . rat_prime_factors_l
+
+-- | 'Ratio' variant of 'rat_prime_factors_t'
+rational_prime_factors_t :: (Integral i,Show i) => Int -> Ratio i -> [Int]
+rational_prime_factors_t n = rat_prime_factors_t n . Math.rational_nd
+
+-- | Condense factors list to include only indicated places.
+--   It is an error if a deleted factor has a non-zero entry in the table.
+--
+-- > rat_prime_factors_l (12,7) == [2,1,0,-1]
+-- > rat_prime_factors_c [2,3,5,7] (12,7) == [2,1,0,-1]
+-- > rat_prime_factors_c [2,3,7] (12,7) == [2,1,-1]
+rat_prime_factors_c :: (Integral i,Show i) => [i] -> (i,i) -> [Int]
+rat_prime_factors_c fc r =
+  let t = rat_prime_factors_l r
+      k = map prime_k_err fc
+      f (ix,e) = if ix `notElem` k
+                 then (if e > 0 then error "rat_prime_factors_c: non-empty factor" else Nothing)
+                 else Just e
+  in mapMaybe f (zip [0..] t)
+
+-- | 'Ratio' variant of 'rat_prime_factors_t'
+--
+-- > map (rational_prime_factors_c [3,5,31]) [3,5,31]
+rational_prime_factors_c :: (Integral i,Show i) => [i] -> Ratio i -> [Int]
+rational_prime_factors_c fc = rat_prime_factors_c fc . Math.rational_nd
+
+-- | Pretty printer for prime factors.  sup=superscript ol=overline
+prime_factors_pp :: [Integer] -> String
+prime_factors_pp = intercalate [Unicode.middle_dot] . map show
+
+{- | Pretty printer for prime factors.  sup=superscript ol=overline
+
+> prime_factors_pp_sup_ol True [2,2,-3,5] == "2²·3̅·5"
+> prime_factors_pp_sup_ol False [-2,-2,-2,3,3,5,5,5,5] == "-2³·3²·5⁴"
+-}
+prime_factors_pp_sup_ol :: Bool -> [Integer] -> String
+prime_factors_pp_sup_ol ol =
+  let mk x = if x < 0 && ol then Unicode.overline (show (- x)) else show x
+      f x = let x0 = head x
+                n = length x
+            in if n == 1 then mk x0 else mk x0 ++ Unicode.int_show_superscript n
+  in intercalate [Unicode.middle_dot] . map f . group
+
diff --git a/Music/Theory/Maybe.hs b/Music/Theory/Maybe.hs
deleted file mode 100644
--- a/Music/Theory/Maybe.hs
+++ /dev/null
@@ -1,84 +0,0 @@
--- | Extensions to "Data.Maybe".
-module Music.Theory.Maybe where
-
-import Data.Maybe {- base -}
-
--- | Variant with error text.
-from_just :: String -> Maybe a -> a
-from_just err = fromMaybe (error err)
-
--- | Variant of unzip.
---
--- > let r = ([Just 1,Nothing,Just 3],[Just 'a',Nothing,Just 'c'])
--- > in maybe_unzip [Just (1,'a'),Nothing,Just (3,'c')] == r
-maybe_unzip :: [Maybe (a,b)] -> ([Maybe a],[Maybe b])
-maybe_unzip =
-    let f x = case x of
-                Nothing -> (Nothing,Nothing)
-                Just (i,j) -> (Just i,Just j)
-    in unzip . map f
-
--- | Replace 'Nothing' elements with last 'Just' value.  This does not
--- alter the length of the list.
---
--- > maybe_latch 1 [Nothing,Just 2,Nothing,Just 4] == [1,2,2,4]
-maybe_latch :: a -> [Maybe a] -> [a]
-maybe_latch i x =
-    case x of
-      [] -> []
-      Just e:x' -> e : maybe_latch e x'
-      Nothing:x' -> i : maybe_latch i x'
-
--- | Variant requiring initial value is not 'Nothing'.
---
--- > maybe_latch1 [Just 1,Nothing,Nothing,Just 4] == [1,1,1,4]
-maybe_latch1 :: [Maybe a] -> [a]
-maybe_latch1 = maybe_latch (error "maybe_latch1")
-
--- | 'map' of 'fmap'.
---
--- > maybe_map negate [Nothing,Just 2] == [Nothing,Just (-2)]
-maybe_map :: (a -> b) -> [Maybe a] -> [Maybe b]
-maybe_map = map . fmap
-
--- | If either is 'Nothing' then 'False', else /eq/ of values.
-maybe_eq_by :: (t -> u -> Bool) -> Maybe t -> Maybe u -> Bool
-maybe_eq_by eq_fn p q =
-    case (p,q) of
-      (Just p',Just q') -> eq_fn p' q'
-      _ -> False
-
--- | Join two values, either of which may be missing.
-maybe_join' :: (s -> t) -> (s -> s -> t) -> Maybe s -> Maybe s -> Maybe t
-maybe_join' f g p q =
-    case (p,q) of
-      (Nothing,_) -> fmap f q
-      (_,Nothing) -> fmap f p
-      (Just p',Just q') -> Just (p' `g` q')
-
--- | 'maybe_join'' of 'id'
-maybe_join :: (t -> t -> t) -> Maybe t -> Maybe t -> Maybe t
-maybe_join = maybe_join' id
-
--- | Apply predicate inside 'Maybe'.
---
--- > maybe_predicate even (Just 3) == Nothing
-maybe_predicate :: (a -> Bool) -> Maybe a -> Maybe a
-maybe_predicate f i =
-    case i of
-      Nothing -> Nothing
-      Just j -> if f j then Just j else Nothing
-
--- | 'map' of 'maybe_predicate'.
---
--- > let r = [Nothing,Nothing,Nothing,Just 4]
--- > in maybe_filter even [Just 1,Nothing,Nothing,Just 4] == r
-maybe_filter :: (a -> Bool) -> [Maybe a] -> [Maybe a]
-maybe_filter = map . maybe_predicate
-
--- | Variant of 'Data.List.filter' that retains 'Nothing' as a
--- placeholder for removed elements.
---
--- > filter_maybe even [1..4] == [Nothing,Just 2,Nothing,Just 4]
-filter_maybe :: (a -> Bool) -> [a] -> [Maybe a]
-filter_maybe f = maybe_filter f . map Just
diff --git a/Music/Theory/Meter/Barlow_1987.hs b/Music/Theory/Meter/Barlow_1987.hs
--- a/Music/Theory/Meter/Barlow_1987.hs
+++ b/Music/Theory/Meter/Barlow_1987.hs
@@ -3,53 +3,55 @@
 -- Translated by Henning Lohner.
 module Music.Theory.Meter.Barlow_1987 where
 
-import Data.List
-import Data.Numbers.Primes {- primes -}
+import Data.List {- base -}
 --import Debug.Trace
 
-import Music.Theory.Math (R)
+import qualified Data.Numbers.Primes as P {- primes -}
 
+import qualified Music.Theory.Math as T {- hmt-base -}
+
 traceShow :: a -> b -> b
 traceShow _ x = x
 
 -- | One indexed variant of 'genericIndex'.
 --
--- > map (at [11..13]) [1..3] == [11,12,13]
-at :: (Integral n) => [a] -> n -> a
-at x i = x `genericIndex` (i - 1)
+-- > map (at1 [11..13]) [1..3] == [11,12,13]
+at1 :: Integral n => [a] -> n -> a
+at1 x i = x `genericIndex` (i - 1)
 
--- | Variant of 'at' with boundary rules and specified error message.
+-- | Variant of 'at1' with boundary rules and specified error message.
 --
--- > map (at' 'x' [11..13]) [0..4] == [1,11,12,13,1]
--- > at' 'x' [0] 3 == undefined
-at' :: (Num a,Show a,Integral n,Show n,Show m) => m -> [a] -> n -> a
-at' m x i =
+-- > map (at1_bnd_err 'x' [11..13]) [0..4] == [1,11,12,13,1]
+-- > at1_bnd_err 'x' [0] 3 == undefined
+at1_bnd_err :: (Num a,Show a,Integral n,Show n,Show m) => m -> [a] -> n -> a
+at1_bnd_err m x i =
     let n = genericLength x
     in if i == 0 || i == n + 1
        then 1 -- error (show ("at':==",m,x,i))
        else if i < 0 || i > n + 1
-            then error (show ("at'",m,x,i))
+            then error (show ("at1_bnd_err",m,x,i))
             else x `genericIndex` (i - 1)
 
 -- | Variant of 'mod' with input constraints.
 --
--- > mod' (-1) 2 == 1
-mod' :: (Integral a,Show a) => a -> a -> a
-mod' a b =
+-- > mod_pos_err (-1) 2 == 1
+-- > mod_pos_err 1 (-2) == undefined
+mod_pos_err :: (Integral a,Show a) => a -> a -> a
+mod_pos_err a b =
     let r = mod a b
     in if r < 0 || r >= b
-       then error (show ("mod'",a,b,r))
+       then error (show ("mod_pos_err",a,b,r))
        else r
 
--- | Specialised variant of 'fromIntegral'.
-to_r :: Integral n => n -> R
+-- | Type-specialised variant of 'fromIntegral'.
+to_r :: Integral n => n -> Double
 to_r = fromIntegral
 
 -- | Variant on 'div' with input constraints.
-div' :: (Integral a,Show a) => String -> a -> a -> a
-div' m i j =
+div_pos_err :: (Integral a,Show a) => String -> a -> a -> a
+div_pos_err m i j =
     if i < 0 || j < 0
-    then error (show ("div'",m,i,j))
+    then error (show ("div_pos_err",m,i,j))
     else truncate (to_r i / to_r j)
 
 -- | A stratification is a tree of integral subdivisions.
@@ -76,23 +78,24 @@
 lower_psi q z n =
     let s8 r =
             let s1 = product q
-                s2 = (n - 2) `mod'` s1
-                s3 = let f k = at' "s3" q (z + 1 - k)
+                s2 = (n - 2) `mod_pos_err` s1
+                s3 = let f k = at1_bnd_err "s3" q (z + 1 - k)
                      in product (map f [0 .. r])
-                s4 = 1 + div' "s4" s2 s3
-                c = at' "c" q (z - r)
-                s5 = s4 `mod'` c
+                s4 = 1 + div_pos_err "s4" s2 s3
+                c = at1_bnd_err "c" q (z - r)
+                s5 = s4 `mod_pos_err` c
                 s6 = upper_psi c (1 + s5)
-                s7 = let f = at' "s7" q
+                s7 = let f = at1_bnd_err "s7" q
                      in product (map f [0 .. z - r - 1])
             in traceShow ("lower_psi:s",s1,s2,s3,s4,s5,s6,s7) (s7 * s6)
     in traceShow ("lower_psi",q,z,n) (sum (map s8 [0 .. z - 1]))
 
--- | The first /n/th primes, reversed.
+-- | The first /n/ primes, reversed.
 --
 -- > reverse_primes 14 == [43,41,37,31,29,23,19,17,13,11,7,5,3,2]
+-- > length (reverse_primes 14) == 14
 reverse_primes :: Integral n => n -> [n]
-reverse_primes n = reverse (genericTake n primes)
+reverse_primes n = reverse (genericTake n P.primes)
 
 -- | Generate prime stratification for /n/.
 --
@@ -105,7 +108,7 @@
     let go x k =
             case x of
               p:x' -> if k `rem` p == 0
-                      then p : go x (div' "ps" k p)
+                      then p : go x (div_pos_err "ps" k p)
                       else go x' k
               [] -> []
     in go (reverse_primes 14)
@@ -125,8 +128,8 @@
     else if p == 2
          then p - n
          else if n == p - 1
-              then div' "upper_psi" p 4
-              else let n' = n - div' "n'" n p
+              then div_pos_err "upper_psi" p 4
+              else let n' = n - div_pos_err "n'" n p
                        s = prime_stratification (p - 1)
                        q = lower_psi s (genericLength s) n'
                        q' = to_r q
@@ -179,7 +182,7 @@
 -- @(0,1)@.
 --
 -- relative_indispensibilities [3,2] == [1,0,0.6,0.2,0.8,0.4]
-relative_indispensibilities :: (Integral n,Show n) => Stratification n -> [R]
+relative_indispensibilities :: (Integral n,Show n) => Stratification n -> [Double]
 relative_indispensibilities = relative_to_length . indispensibilities
 
 -- | Align two meters (given as stratifications) to least common
@@ -209,7 +212,7 @@
 -- | Type pairing a stratification and a tempo.
 type S_MM t = ([t],t)
 
--- | Variant of 'div' that requires 'mod' be @0@.
+-- | Variant of 'div' that requires 'mod_pos_err be @0@.
 whole_div :: Integral a => a -> a -> a
 whole_div i j =
     case i `divMod` j of
@@ -242,18 +245,6 @@
         s2' = s2 ++ prime_stratification (t `whole_div` t2)
     in (s1',s2')
 
--- | Arithmetic mean (average) of a list.
---
--- > mean [0..5] == 2.5
-mean :: Fractional a => [a] -> a
-mean x = sum x / fromIntegral (length x)
-
--- | Square of /n/.
---
--- > square 5 == 25
-square :: Num a => a -> a
-square n = n * n
-
 -- | Composition of 'prolong_stratifications' and 'align_meters'.
 --
 -- > align_s_mm indispensibilities ([2,2,3],5) ([3,5],4)
@@ -274,15 +265,15 @@
 upper_psi' h n =
     if h > 3
     then let omega x = if x == 0 then 0 else 1
-             h4 = div' "h4" h 4
+             h4 = div_pos_err "h4" h 4
              n' = n - 1 + omega (h - n)
              p = prime_stratification (h - 1)
              x0 = lower_psi p (genericLength p) n'
-             x1 = x0 + omega (div' "z" x0 h4)
+             x1 = x0 + omega (div_pos_err "z" x0 h4)
              x2 = omega (h - n - 1)
              x3 = x2 + h4 * (1 - x2)
          in traceShow ("upper_psi'",h,n,n',x0,x1,x2,x3) (x1 * x3)
-    else (h + n - 2) `mod'` h
+    else (h + n - 2) `mod_pos_err` h
 
 -- | The /MPS/ limit equation given on p.58.
 --
@@ -301,9 +292,9 @@
 -- > mean_square_product [(2,3),(4,5)] == (6^2 + 20^2) / 2^2
 mean_square_product :: Fractional n => [(n,n)] -> n
 mean_square_product x =
-    let f = square . uncurry (*)
+    let f = T.square . uncurry (*)
         n = fromIntegral (length x)
-    in sum (map f x) / square n
+    in sum (map f x) / T.square n
 
 -- | An incorrect attempt at the description in paragraph two of p.58
 -- of the /CMJ/ paper.
@@ -311,7 +302,7 @@
 -- > let p ~= q = abs (p - q) < 1e-4
 -- > metrical_affinity [2,3] 1 [3,2] 1 ~= 0.0324
 -- > metrical_affinity [2,2,3] 20 [3,5] 16 ~= 0.0028
-metrical_affinity :: (Integral n,Show n) => [n] -> n -> [n] -> n -> R
+metrical_affinity :: (Integral n,Show n) => [n] -> n -> [n] -> n -> Double
 metrical_affinity s1 v1 s2 v2 =
     let (s1',s2') = prolong_stratifications (s1,v1) (s2,v2)
         i1 = relative_indispensibilities s1'
@@ -331,7 +322,7 @@
 -- > metrical_affinity' [2,2,2] 1 [3,2,2] 1 ~= 0.45872
 --
 -- > metrical_affinity' [3,2,2] 3 [2,2,3] 2 ~= 0.10282
-metrical_affinity' :: (Integral t,Show t) => [t] -> t -> [t] -> t -> R
+metrical_affinity' :: (Integral t,Show t) => [t] -> t -> [t] -> t -> Double
 metrical_affinity' s1 v1 s2 v2 =
     let (s1',s2') = prolong_stratifications (s1,v1) (s2,v2)
         ix :: (Integer -> x) -> Integer -> x
@@ -339,20 +330,20 @@
                    1 -> f 1
                    2 -> f 2
                    _ -> error (show ("ix",i))
-        s = ix (at [s1,s2])
-        v = ix (at [v1,v2])
+        s = ix (at1 [s1,s2])
+        v = ix (at1 [v1,v2])
         u = ix (genericLength . s)
-        s' = ix (at [s1',s2'])
+        s' = ix (at1 [s1',s2'])
         z = ix (genericLength . s')
-        q i j = s i `at` j
+        q i j = s i `at1` j
         omega_u i = product (map (q i) [1::Int .. u i])
         omega_z _ = lcm (v 1 * omega_u 1) (v 2 * omega_u 2)
         omega_0 = lcm (product (s' 1)) (product (s' 2))
-        x0 n i = lower_psi (s' i) (z i) (1 + ((n - 1) `mod'` omega_z i))
-        x1 n = square (product (map (x0 n) [1,2]))
+        x0 n i = lower_psi (s' i) (z i) (1 + ((n - 1) `mod_pos_err` omega_z i))
+        x1 n = T.square (product (map (x0 n) [1,2]))
         x2 = sum (map x1 [1 .. omega_0])
         x3 = 18 * x2 - 2
-        x4 i = square (omega_z i - 1)
+        x4 i = T.square (omega_z i - 1)
         x5 = product (map x4 [1::Integer,2])
         x6 = 7 * omega_0 * x5
         x7 = to_r x3 / to_r x6
diff --git a/Music/Theory/Metric/Buchler_1998.hs b/Music/Theory/Metric/Buchler_1998.hs
--- a/Music/Theory/Metric/Buchler_1998.hs
+++ b/Music/Theory/Metric/Buchler_1998.hs
@@ -3,13 +3,14 @@
 -- thesis, University of Rochester, 1998
 module Music.Theory.Metric.Buchler_1998 where
 
+import Data.Int {- base -}
 import Data.List {- base -}
 import Data.Ratio {- base -}
 
 import qualified Music.Theory.List as T
-import qualified Music.Theory.Z12.Forte_1973 as T
+import qualified Music.Theory.Z as T
+import qualified Music.Theory.Z.Forte_1973 as T
 import qualified Music.Theory.Set.List as T
-import Music.Theory.Z12 (Z12)
 
 -- | Predicate for list with cardinality /n/.
 of_c :: Integral n => n -> [a] -> Bool
@@ -18,7 +19,7 @@
 -- | Set classes of cardinality /n/.
 --
 -- > sc_table_n 2 == [[0,1],[0,2],[0,3],[0,4],[0,5],[0,6]]
-sc_table_n :: (Integral n) => n -> [[Z12]]
+sc_table_n :: (Integral n) => n -> [[Int8]]
 sc_table_n n = filter (of_c n) (map snd T.sc_table)
 
 -- | Minima and maxima of ICV of SCs of cardinality /n/.
@@ -27,7 +28,7 @@
 icv_minmax :: (Integral n, Integral b) => n -> ([b], [b])
 icv_minmax n =
     let t = sc_table_n n
-        i = transpose (map T.icv t)
+        i = transpose (map (T.z_icv T.z12) t)
     in (map minimum i,map maximum i)
 
 data R = MIN | MAX deriving (Eq,Show)
@@ -43,10 +44,10 @@
       MAX -> "-"
 
 -- | 'SATV' element measure with given funtion.
-satv_f :: (Integral n) => ((n,n,n) -> D n) -> [Z12] -> [D n]
+satv_f :: (Integral n) => ((n,n,n) -> D n) -> [Int8] -> [D n]
 satv_f f p =
     let n = length p
-        i = T.icv p
+        i = T.z_icv T.z12 p
         (l,r) = icv_minmax n
     in map f (zip3 l i r)
 
@@ -68,7 +69,7 @@
 --
 -- > satv_e_pp (satv_a [0,1,2,6,7,8]) == "<-1,+2,+0,+0,-1,-0>"
 -- > satv_e_pp (satv_a [0,1,2,3,4]) == "<-0,-1,-2,+0,+0,+0>"
-satv_a :: Integral i => [Z12] -> [D i]
+satv_a :: Integral i => [Int8] -> [D i]
 satv_a =
     let f (l,i,r) = let l' = abs (i - l)
                         r' = abs (i - r)
@@ -81,7 +82,7 @@
 --
 -- > satv_e_pp (satv_b [0,1,2,6,7,8]) == "<+4,-4,-5,-4,+4,+3>"
 -- > satv_e_pp (satv_b [0,1,2,3,4]) == "<+4,+3,+2,-3,-4,-2>"
-satv_b :: Integral i => [Z12] -> [D i]
+satv_b :: Integral i => [Int8] -> [D i]
 satv_b =
     let f (l,i,r) = let l' = abs (i - l)
                         r' = abs (i - r)
@@ -102,7 +103,7 @@
 -- > satv_pp (satv [0,1,2,3,4,6]) == "(<-1,-2,-2,+0,+1,+1>,<+4,+4,+3,-4,-4,-2>)"
 -- > satv_pp (satv [0,1,3,6,8]) == "(<+1,-2,-2,+0,-1,-1>,<-3,+2,+2,-3,+3,+1>)"
 -- > satv_pp (satv [0,2,3,5,7,9]) == "(<+1,-2,-2,+0,-1,+1>,<-4,+4,+3,-4,+4,-2>)"
-satv :: Integral i => [Z12] -> SATV i
+satv :: Integral i => [Int8] -> SATV i
 satv p = (satv_a p,satv_b p)
 
 -- | 'SATV' reorganised by 'R'.
@@ -120,7 +121,7 @@
 -- | Sum of numerical components of @a@ and @b@ parts of 'SATV'.
 --
 -- > satv_n_sum (satv [0,1,2,6,7,8]) == [5,6,5,4,5,3]
--- > satv_n_sum (satv [0,3,6,9]) = [3,3,4,3,3,2]
+-- > satv_n_sum (satv [0,3,6,9]) == [3,3,4,3,3,2]
 satv_n_sum :: Num c => SATV c -> [c]
 satv_n_sum (i,j) = zipWith (+) (map snd i) (map snd j)
 
@@ -148,7 +149,7 @@
 -- > satsim [0,1,2,3,4] [0,1,4,5,7] == 8/21
 -- > satsim [0,1,2,3,4] [0,2,4,6,8] == 4/7
 -- > satsim [0,1,4,5,7] [0,2,4,6,8] == 4/7
-satsim :: Integral a => [Z12] -> [Z12] -> Ratio a
+satsim :: Integral a => [Int8] -> [Int8] -> Ratio a
 satsim p q =
     let i = satv p
         j = satv q
@@ -161,7 +162,7 @@
 -- | Table of 'satsim' measures for all @SC@ pairs.
 --
 -- > length satsim_table == 24310
-satsim_table :: Integral i => [(([Z12],[Z12]),Ratio i)]
+satsim_table :: Integral i => [(([Int8],[Int8]),Ratio i)]
 satsim_table =
     let f (i,j) = ((i,j),satsim i j)
         t = filter ((`notElem` [0,1,12]) . length) (map snd T.sc_table)
diff --git a/Music/Theory/Metric/Morris_1980.hs b/Music/Theory/Metric/Morris_1980.hs
--- a/Music/Theory/Metric/Morris_1980.hs
+++ b/Music/Theory/Metric/Morris_1980.hs
@@ -2,19 +2,21 @@
 -- Sets\". Perspectives of New Music, 18(2):445-460, 1980.
 module Music.Theory.Metric.Morris_1980 where
 
-import Data.Ratio
-import Music.Theory.Z12
-import Music.Theory.Z12.Forte_1973
+import Data.Int {- base -}
+import Data.Ratio {- base -}
 
+import Music.Theory.Z {- hmt -}
+import Music.Theory.Z.Forte_1973 {- hmt -}
+
 -- | SIM
 --
--- > icv [0,1,3,6] == [1,1,2,0,1,1] && icv [0,2,4,7] == [0,2,1,1,2,0]
+-- > icv 12 [0,1,3,6] == [1,1,2,0,1,1] && icv 12 [0,2,4,7] == [0,2,1,1,2,0]
 -- > sim [0,1,3,6] [0,2,4,7] == 6
 -- > sim [0,1,2,4,5,8] [0,1,3,7] == 9
-sim :: Integral a => [Z12] -> [Z12] -> a
+sim :: Integral a => [Int8] -> [Int8] -> a
 sim r s =
-    let r' = icv r
-        s' = icv s
+    let r' = z_icv z12 r
+        s' = z_icv z12 s
         t = zipWith (-) r' s'
     in sum (map abs t)
 
@@ -25,8 +27,8 @@
 -- > asim [0,1,2,3,4] [0,1,4,5,7] == 2/5
 -- > asim [0,1,2,3,4] [0,2,4,6,8] == 3/5
 -- > asim [0,1,4,5,7] [0,2,4,6,8] == 3/5
-asim :: (Integral n) => [Z12] -> [Z12] -> Ratio n
+asim :: (Integral n) => [Int8] -> [Int8] -> Ratio n
 asim r s =
-    let r' = icv r
-        s' = icv s
+    let r' = z_icv z12 r
+        s' = z_icv z12 s
     in sim r s % (sum r' + sum s')
diff --git a/Music/Theory/Metric/Polansky_1996.hs b/Music/Theory/Metric/Polansky_1996.hs
--- a/Music/Theory/Metric/Polansky_1996.hs
+++ b/Music/Theory/Metric/Polansky_1996.hs
@@ -1,15 +1,16 @@
--- | Larry Polansky. \"Morphological Metrics\". Journal of New Music
--- Research, 25(4):289-368, 1996.
+-- | Larry Polansky. \"Morphological Metrics\".
+-- Journal of New Music Research, 25(4):289-368, 1996.
 module Music.Theory.Metric.Polansky_1996 where
 
-import Data.List
-import Data.Maybe
-import Data.Ratio
-import qualified Music.Theory.Contour.Polansky_1992 as C
-import qualified Music.Theory.List as L
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ratio {- base -}
 
--- | Distance function, ordinarily /n/ below is in 'Num', 'Fractional'
--- or 'Real'.
+import qualified Music.Theory.List as L {- hmt-base -}
+
+import qualified Music.Theory.Contour.Polansky_1992 as C {- hmt -}
+
+-- | Distance function, ordinarily /n/ below is in 'Num', 'Fractional' or 'Real'.
 type Interval a n = (a -> a -> n)
 
 -- | 'fromIntegral' '.' '-'.
@@ -21,43 +22,43 @@
 dif_r i j = realToFrac (i - j)
 
 -- | 'abs' '.' /f/.
-abs_dif :: Num n => Interval a n -> a -> a -> n
-abs_dif f i j = abs (i `f` j)
+abs_of :: Num n => Interval a n -> a -> a -> n
+abs_of f i j = abs (i `f` j)
 
 -- | Square.
 sqr :: Num a => a -> a
 sqr n = n * n
 
 -- | 'sqr' '.' /f/.
-sqr_dif :: Num n => Interval a n -> a -> a -> n
-sqr_dif f i j = sqr (i `f` j)
+sqr_of :: Num n => Interval a n -> a -> a -> n
+sqr_of f i j = sqr (i `f` j)
 
 -- | 'sqr' '.' 'abs' '.' /f/.
-sqr_abs_dif :: Num n => Interval a n -> a -> a -> n
-sqr_abs_dif f i = sqr . abs_dif f i
+sqr_abs_of :: Num n => Interval a n -> a -> a -> n
+sqr_abs_of f i = sqr . abs_of f i
 
 -- | 'sqrt' '.' 'abs' '.' /f/.
-sqrt_abs_dif :: Floating c => Interval a c -> a -> a -> c
-sqrt_abs_dif f i = sqrt . abs_dif f i
+sqrt_abs_of :: Floating c => Interval a c -> a -> a -> c
+sqrt_abs_of f i = sqrt . abs_of f i
 
 -- | City block metric, p.296
 --
 -- > city_block_metric (-) (1,2) (3,5) == 2+3
 city_block_metric :: Num n => Interval a n -> (a,a) -> (a,a) -> n
-city_block_metric f (x1,x2) (y1,y2) = abs_dif f x1 y1 + abs_dif f x2 y2
+city_block_metric f (x1,x2) (y1,y2) = abs_of f x1 y1 + abs_of f x2 y2
 
 -- | Two-dimensional euclidean metric, p.297.
 --
 -- > euclidean_metric_2 (-) (1,2) (3,5) == sqrt (4+9)
 euclidean_metric_2 :: Floating n => Interval a n -> (a,a) -> (a,a) -> n
-euclidean_metric_2 f (x1,x2) (y1,y2) = sqrt (sqr_dif f x1 y1 + sqr_dif f x2 y2)
+euclidean_metric_2 f (x1,x2) (y1,y2) = sqrt (sqr_of f x1 y1 + sqr_of f x2 y2)
 
 -- | /n/-dimensional euclidean metric
 --
 -- > euclidean_metric_l (-) [1,2] [3,5] == sqrt (4+9)
 -- > euclidean_metric_l (-) [1,2,3] [2,4,6] == sqrt (1+4+9)
 euclidean_metric_l :: Floating c => Interval b c -> [b] -> [b] -> c
-euclidean_metric_l f p = sqrt . sum . zipWith (sqr_dif f) p
+euclidean_metric_l f p = sqrt . sum . zipWith (sqr_of f) p
 
 -- | Cube root.
 --
@@ -89,19 +90,12 @@
     let g i j = abs (i `f` j) ** n
     in nthrt n (sum (zipWith g p q))
 
--- | Integration with /f/.
---
--- > d_dx (-) [0,2,4,1,0] == [2,2,-3,-1]
--- > d_dx (-) [2,3,0,4,1] == [1,-3,4,-3]
-d_dx :: Interval a n -> [a] -> [n]
-d_dx f l = zipWith f (tail l) l
-
--- | 'map' 'abs' '.' 'd_dx'.
+-- | 'map' 'abs' '.' 'L.d_dx_by'.
 --
 -- > d_dx_abs (-) [0,2,4,1,0] == [2,2,3,1]
 -- > d_dx_abs (-) [2,3,0,4,1] == [1,3,4,3]
 d_dx_abs :: Num n => Interval a n -> [a] -> [n]
-d_dx_abs f = map abs . d_dx f
+d_dx_abs f = map abs . L.d_dx_by f
 
 -- | Ordered linear magnitude (no delta), p.300
 --
@@ -114,11 +108,11 @@
 
 -- | Ordered linear magintude (general form) p.302
 --
--- > olm_general (abs_dif (-)) [0,2,4,1,0] [2,3,0,4,1] == 1.25
--- > olm_general (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
+-- > olm_general (abs_of (-)) [0,2,4,1,0] [2,3,0,4,1] == 1.25
+-- > olm_general (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
 olm_general :: Fractional n => Interval a n -> [a] -> [a] -> n
 olm_general f p q =
-    let r = zipWith (-) (d_dx f p) (d_dx f q)
+    let r = zipWith (-) (L.d_dx_by f p) (L.d_dx_by f q)
         z = sum (map abs r)
     in z / (fromIntegral (length p) - 1)
 
@@ -149,8 +143,8 @@
 
 -- | Ordered linear magintude (generalised-interval form) p.305
 --
--- > olm (abs_dif dif_r) (abs_ix_dif dif_r) (const 1) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
--- > olm (abs_dif dif_r) (abs_ix_dif dif_r) maximum [1,5,12,2,9,6] [7,6,4,9,8,1] == 0.46
+-- > olm (abs_of dif_r) (abs_ix_dif dif_r) (const 1) [1,5,12,2,9,6] [7,6,4,9,8,1] == 4.6
+-- > olm (abs_of dif_r) (abs_ix_dif dif_r) maximum [1,5,12,2,9,6] [7,6,4,9,8,1] == 0.46
 olm :: Fractional a => Psi a -> Delta n a  -> ([a] -> a) -> [n] -> [n] -> a
 olm psi delta maxint m n =
     let l = length m
@@ -163,11 +157,11 @@
 -- > olm_no_delta [0,2,4,1,0] [2,3,0,4,1] == 1.25
 -- > olm_no_delta [1,6,2,5,11] [3,15,13,2,9] == 4.5
 olm_no_delta :: (Real a,Real n,Fractional n) => [a] -> [a] -> n
-olm_no_delta = olm (abs_dif dif_r) (abs_ix_dif dif_r) (const 1)
+olm_no_delta = olm (abs_of dif_r) (abs_ix_dif dif_r) (const 1)
 
 -- > olm_no_delta_squared [0,2,4,1,0] [2,3,0,4,1] == sum (map sqrt [3,5,7,8]) / 4
 olm_no_delta_squared :: Floating a => [a] -> [a] -> a
-olm_no_delta_squared = olm (sqrt_abs_dif (-)) (sqr_abs_ix_dif (-)) (const 1)
+olm_no_delta_squared = olm (sqrt_abs_of (-)) (sqr_abs_ix_dif (-)) (const 1)
 
 second_order :: (Num n) => ([n] -> [n] -> t) -> [n] -> [n] -> t
 second_order f p q = f (d_dx_abs (-) p) (d_dx_abs (-) q)
@@ -187,12 +181,12 @@
 second_order_binonial_coefficient :: Fractional a => a -> a
 second_order_binonial_coefficient n = ((n * n) - n) / 2
 
--- | 'd_dx' of 'flip' 'compare'.
+-- | 'L.d_dx_by' of 'flip' 'compare'.
 --
 -- > direction_interval [5,9,3,2] == [LT,GT,GT]
 -- > direction_interval [2,5,6,6] == [LT,LT,EQ]
 direction_interval :: Ord i => [i] -> [Ordering]
-direction_interval = d_dx (flip compare)
+direction_interval = L.d_dx_by (flip compare)
 
 -- | Histogram of list of 'Ordering's.
 --
@@ -219,7 +213,7 @@
     let (i,j,k) = direction_vector m
         (p,q,r) = direction_vector n
         z = (i + j + k) * 2
-    in (abs_dif (-) i p + abs_dif (-) j q + abs_dif (-) k r) % z
+    in (abs_of (-) i p + abs_of (-) j q + abs_of (-) k r) % z
 
 -- | Ordered linear direction, p.312
 --
@@ -256,27 +250,24 @@
     let (i,j,k) = ord_hist (concat (C.half_matrix_f compare m))
         (p,q,r) = ord_hist (concat (C.half_matrix_f compare n))
         z = (i + j + k) * 2
-    in (abs_dif (-) i p + abs_dif (-) j q + abs_dif (-) k r) % z
+    in (abs_of (-) i p + abs_of (-) j q + abs_of (-) k r) % z
 
 -- | 'C.half_matrix_f', Fig.9, p.318
 --
--- > let r = [[2,3,1,4]
--- >           ,[1,3,6]
--- >             ,[4,7]
--- >               ,[3]]
--- > in combinatorial_magnitude_matrix (abs_dif (-)) [5,3,2,6,9] == r
+-- > let r = [[2,3,1,4],[1,3,6],[4,7],[3]]
+-- > combinatorial_magnitude_matrix (abs_of (-)) [5,3,2,6,9] == r
 combinatorial_magnitude_matrix :: Interval a n -> [a] -> [[n]]
 combinatorial_magnitude_matrix = C.half_matrix_f
 
 -- | Unordered linear magnitude (simplified), p.320-321
 --
 -- > let r = abs (sum [5,4,3,6] - sum [12,2,11,7]) / 4
--- > in ulm_simplified (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == r
+-- > ulm_simplified (abs_of (-)) [1,6,2,5,11] [3,15,13,2,9] == r
 --
--- > ulm_simplified (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3
+-- > ulm_simplified (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3
 ulm_simplified :: Fractional n => Interval a n -> [a] -> [a] -> n
 ulm_simplified f p q =
-    let g = abs . sum . d_dx f
+    let g = abs . sum . L.d_dx_by f
     in abs (g p - g q) / fromIntegral (length p - 1)
 
 ocm_zcm :: Fractional n => Interval a n -> [a] -> [a] -> (n, n, [n])
@@ -291,8 +282,8 @@
 
 -- | Ordered combinatorial magnitude (OCM), p.323
 --
--- > ocm (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == 5.2
--- > ocm (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3.6
+-- > ocm (abs_of (-)) [1,6,2,5,11] [3,15,13,2,9] == 5.2
+-- > ocm (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 3.6
 ocm :: Fractional n => Interval a n -> [a] -> [a] -> n
 ocm f p q =
     let (z,c,_) = ocm_zcm f p q
@@ -300,8 +291,8 @@
 
 -- | Ordered combinatorial magnitude (OCM), p.323
 --
--- > ocm_absolute_scaled (abs_dif (-)) [1,6,2,5,11] [3,15,13,2,9] == 0.4
--- > ocm_absolute_scaled (abs_dif (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 54/(15*11)
+-- > ocm_absolute_scaled (abs_of (-)) [1,6,2,5,11] [3,15,13,2,9] == 0.4
+-- > ocm_absolute_scaled (abs_of (-)) [1,5,12,2,9,6] [7,6,4,9,8,1] == 54/(15*11)
 ocm_absolute_scaled :: (Ord n,Fractional n) => Interval a n -> [a] -> [a] -> n
 ocm_absolute_scaled f p q =
     let (z,c,m) = ocm_zcm f p q
diff --git a/Music/Theory/Monad.hs b/Music/Theory/Monad.hs
deleted file mode 100644
--- a/Music/Theory/Monad.hs
+++ /dev/null
@@ -1,10 +0,0 @@
--- | Monad functions.
-module Music.Theory.Monad where
-
-repeatM_ :: (Monad m) => m a -> m ()
-repeatM_ = sequence_ . repeat
-
-iterateM_ :: (Monad m) => st -> (st -> m st) -> m ()
-iterateM_ st f = do
-  st' <- f st
-  iterateM_ st' f
diff --git a/Music/Theory/Ord.hs b/Music/Theory/Ord.hs
deleted file mode 100644
--- a/Music/Theory/Ord.hs
+++ /dev/null
@@ -1,38 +0,0 @@
--- | 'Ordering' functions
-module Music.Theory.Ord where
-
--- | Specialised 'fromEnum'.
-ord_to_int :: Ordering -> Int
-ord_to_int = fromEnum
-
--- | Specialised 'toEnum'.
-int_to_ord :: Int -> Ordering
-int_to_ord = toEnum
-
--- | Invert 'Ordering'.
---
--- > map ord_invert [LT,EQ,GT] == [GT,EQ,LT]
-ord_invert :: Ordering -> Ordering
-ord_invert x =
-    case x of
-      LT -> GT
-      EQ -> EQ
-      GT -> LT
-
--- | Given 'Ordering', re-order pair,
-order_pair :: Ordering -> (t,t) -> (t,t)
-order_pair o (x,y) =
-    case o of
-      LT -> (x,y)
-      EQ -> (x,y)
-      GT -> (y,x)
-
--- | Sort a pair of equal type values using given comparison function.
---
--- > sort_pair compare ('b','a') == ('a','b')
-sort_pair :: (t -> t -> Ordering) -> (t,t) -> (t,t)
-sort_pair fn (x,y) = order_pair (fn x y) (x,y)
-
--- | Variant where the comparison function may not compute a value.
-sort_pair_m :: (t -> t -> Maybe Ordering) -> (t,t) -> Maybe (t,t)
-sort_pair_m fn (x,y) = fmap (`order_pair` (x,y)) (fn x y)
diff --git a/Music/Theory/Parse.hs b/Music/Theory/Parse.hs
--- a/Music/Theory/Parse.hs
+++ b/Music/Theory/Parse.hs
@@ -1,8 +1,10 @@
+-- | Parsing utilities
 module Music.Theory.Parse where
 
 import Data.Maybe {- base -}
 
-import qualified Text.ParserCombinators.Parsec as P {- parsec -}
+import qualified Text.Parsec as P {- parsec -}
+import qualified Text.Parsec.String as P {- parsec -}
 
 -- | A 'Char' parser.
 type P a = P.GenParser Char () a
@@ -14,3 +16,12 @@
 -- | Parse 'Integral'.
 parse_int :: Integral i => P i
 parse_int = fmap (fromInteger . read) (P.many1 P.digit)
+
+run_parser :: P t -> String -> Either P.ParseError t
+run_parser p = P.runParser p () ""
+
+run_parser_maybe :: P t -> String -> Maybe t
+run_parser_maybe p = either (const Nothing) Just . run_parser p
+
+run_parser_error :: P c -> String -> c
+run_parser_error p = either (error . show) id . run_parser p
diff --git a/Music/Theory/Permutations.hs b/Music/Theory/Permutations.hs
deleted file mode 100644
--- a/Music/Theory/Permutations.hs
+++ /dev/null
@@ -1,162 +0,0 @@
--- | Permutation functions.
-module Music.Theory.Permutations where
-
-import qualified Data.Permute as P {- permutation -}
-import Numeric (showHex) {- base -}
-
-import qualified Music.Theory.List as L
-
--- | Factorial function.
---
--- > (factorial 13,maxBound::Int)
-factorial :: (Ord a, Num a) => a -> a
-factorial n = if n <= 1 then 1 else n * factorial (n - 1)
-
--- | Number of /k/ element permutations of a set of /n/ elements.
---
--- > (nk_permutations 4 3,nk_permutations 13 3) == (24,1716)
-nk_permutations :: Integral a => a -> a -> a
-nk_permutations n k = factorial n  `div` factorial (n - k)
-
--- | Number of /nk/ permutations where /n/ '==' /k/.
---
--- > map n_permutations [1..8] == [1,2,6,24,120,720,5040,40320]
--- > n_permutations 16 `div` 1000000 == 20922789
-n_permutations :: (Integral a) => a -> a
-n_permutations n = nk_permutations n n
-
--- | Generate the permutation from /p/ to /q/, ie. the permutation
--- that, when applied to /p/, gives /q/.
---
--- > apply_permutation (permutation [0,1,3] [1,0,3]) [0,1,3] == [1,0,3]
-permutation :: (Eq a) => [a] -> [a] -> P.Permute
-permutation p q =
-    let n = length p
-        f x = L.elem_index_unique x p
-    in P.listPermute n (map f q)
-
--- | Apply permutation /f/ to /p/.
---
--- > let p = permutation [1..4] [4,3,2,1]
--- > in apply_permutation p [1..4] == [4,3,2,1]
-apply_permutation :: P.Permute -> [a] -> [a]
-apply_permutation f p = map (p !!) (P.elems f)
-
--- | Composition of 'apply_permutation' and 'from_cycles'.
---
--- > apply_permutation_c [[0,3],[1,2]] [1..4] == [4,3,2,1]
--- > apply_permutation_c [[0,2],[1],[3,4]] [1..5] == [3,2,1,5,4]
--- > apply_permutation_c [[0,1,4],[2,3]] [1..5] == [2,5,4,3,1]
--- > apply_permutation_c [[0,1,3],[2,4]] [1..5] == [2,4,5,1,3]
-apply_permutation_c :: [[Int]] -> [a] -> [a]
-apply_permutation_c = apply_permutation . from_cycles
-
--- | True if the inverse of /p/ is /p/.
---
--- > non_invertible (permutation [0,1,3] [1,0,3]) == True
---
--- > let p = permutation [1..4] [4,3,2,1]
--- > in non_invertible p == True && P.cycles p == [[0,3],[1,2]]
-non_invertible :: P.Permute -> Bool
-non_invertible p = p == P.inverse p
-
--- | Generate a permutation from the cycles /c/.
---
--- > apply_permutation (from_cycles [[0,1,2,3]]) [1..4] == [2,3,4,1]
-from_cycles :: [[Int]] -> P.Permute
-from_cycles c = P.cyclesPermute (sum (map length c)) c
-
--- | Generate all permutations of size /n/.
---
--- > map one_line (permutations_n 3) == [[1,2,3],[1,3,2]
--- >                                    ,[2,1,3],[2,3,1]
--- >                                    ,[3,1,2],[3,2,1]]
-permutations_n :: Int -> [P.Permute]
-permutations_n n =
-    let f p = let r = P.next p
-              in maybe [p] (\np -> p : f np) r
-    in f (P.permute n)
-
--- | Composition of /q/ then /p/.
---
--- > let {p = from_cycles [[0,2],[1],[3,4]]
--- >     ;q = from_cycles [[0,1,4],[2,3]]
--- >     ;r = p `compose` q}
--- > in apply_permutation r [1,2,3,4,5] == [2,4,5,1,3]
-compose :: P.Permute -> P.Permute -> P.Permute
-compose p q =
-    let n = P.size q
-        i = [1 .. n]
-        j = apply_permutation p i
-        k = apply_permutation q j
-    in permutation i k
-
--- | Two line notation of /p/.
---
--- > two_line (permutation [0,1,3] [1,0,3]) == ([1,2,3],[2,1,3])
-two_line :: P.Permute -> ([Int],[Int])
-two_line p =
-    let n = P.size p
-        i = [1..n]
-    in (i,apply_permutation p i)
-
--- | One line notation of /p/.
---
--- > one_line (permutation [0,1,3] [1,0,3]) == [2,1,3]
---
--- > map one_line (permutations_n 3) == [[1,2,3],[1,3,2]
--- >                                    ,[2,1,3],[2,3,1]
--- >                                    ,[3,1,2],[3,2,1]]
-one_line :: P.Permute -> [Int]
-one_line = snd . two_line
-
--- | Variant of 'one_line' that produces a compact string.
---
--- > one_line_compact (permutation [0,1,3] [1,0,3]) == "213"
---
--- > let p = permutations_n 3
--- > in unwords (map one_line_compact p) == "123 132 213 231 312 321"
-one_line_compact :: P.Permute -> String
-one_line_compact =
-    let f n = if n >= 0 && n <= 15
-              then showHex n ""
-              else error "one_line_compact:not(0-15)"
-    in concatMap f . one_line
-
--- | Multiplication table of symmetric group /n/.
---
--- > unlines (map (unwords . map one_line_compact) (multiplication_table 3))
---
--- @
--- ==> 123 132 213 231 312 321
---     132 123 312 321 213 231
---     213 231 123 132 321 312
---     231 213 321 312 123 132
---     312 321 132 123 231 213
---     321 312 231 213 132 123
--- @
-multiplication_table :: Int -> [[P.Permute]]
-multiplication_table n =
-    let ps = permutations_n n
-        f p = map (compose p) ps
-    in map f ps
-
-{-
-let q = permutation [1..4] [2,3,4,1] -- [[0,1,2,3]]
-(q,non_invertible q,P.cycles q,apply_permutation q [1..4])
-
-let p = permutation [1..5] [3,2,1,5,4] -- [[0,2],[1],[3,4]]
-let q = permutation [1..5] [2,5,4,3,1] -- [[0,1,4],[2,3]]
-let r = permutation [1..5] [2,4,5,1,3] -- [[0,1,3],[2,4]]
-(non_invertible p,P.cycles p,apply_permutation p [1..5])
-(non_invertible q,P.cycles q,apply_permutation q [1..5])
-(non_invertible r,P.cycles r,apply_permutation r [1..5])
-
-map P.cycles (permutations_n 3)
-map P.cycles (permutations_n 4)
-partition not (map non_invertible (permutations_n 4))
-
-import Data.List {- base -}
-putStrLn $ unlines $ map unwords $ permutations ["A0","A1","B0"]
-
--}
diff --git a/Music/Theory/Permutations/List.hs b/Music/Theory/Permutations/List.hs
--- a/Music/Theory/Permutations/List.hs
+++ b/Music/Theory/Permutations/List.hs
@@ -2,38 +2,45 @@
 module Music.Theory.Permutations.List where
 
 import Data.List {- base -}
+
 import qualified Math.Combinatorics.Multiset as C {- multiset-comb -}
 
-import qualified Music.Theory.Permutations as P {- hmt -}
+import qualified Music.Theory.Permutations as P {- hmt-base -}
 
 -- | Generate all permutations.
 --
--- > permutations [0,3] == [[0,3],[3,0]]
--- > length (permutations [1..5]) == P.n_permutations 5
-permutations :: [a] -> [[a]]
-permutations i =
+-- > permutations_l [0,3] == [[0,3],[3,0]]
+-- > length (permutations_l [1..5]) == P.n_permutations 5
+permutations_l :: [a] -> [[a]]
+permutations_l i =
     let f p = P.apply_permutation p i
     in map f (P.permutations_n (length i))
 
+-- | /k/-element permutations of a set of /n/-elements.
+--
+-- > permutations_nk_l 3 2 "abc" == ["ab","ac","ba","bc","ca","cb"]
+permutations_nk_l :: Eq e => Int -> Int -> [e] -> [[e]]
+permutations_nk_l n k e =
+  if length e /= n
+  then error "permutations_nk_l"
+  else nub (map (take k) (permutations_l e))
+
 -- | Generate all distinct permutations of a multi-set.
 --
 -- > multiset_permutations [0,1,1] == [[0,1,1],[1,1,0],[1,0,1]]
-multiset_permutations :: (Ord a) => [a] -> [[a]]
+multiset_permutations :: Ord a => [a] -> [[a]]
 multiset_permutations = C.permutations . C.fromList
 
-factorial :: (Enum a, Num a) => a -> a
-factorial n = product [1..n]
-
 -- | Calculate number of permutations of a multiset.
 --
--- > let r = factorial 11 `div` product (map factorial [1,4,4,2])
--- > in multiset_permutations_n "MISSISSIPPI" == r
+-- > let r = P.factorial 11 `div` product (map P.factorial [1,4,4,2])
+-- > multiset_permutations_n "MISSISSIPPI" == r
 --
 -- > multiset_permutations_n "MISSISSIPPI" == 34650
 -- > length (multiset_permutations "MISSISSIPPI") == 34650
 multiset_permutations_n :: Ord a => [a] -> Int
 multiset_permutations_n x =
     let occ = map length . group . sort
-        n = factorial (length x)
-        d = product $ map factorial $ occ x
+        n = P.factorial (length x)
+        d = product $ map P.factorial $ occ x
     in n `div` d
diff --git a/Music/Theory/Permutations/Morris_1984.hs b/Music/Theory/Permutations/Morris_1984.hs
--- a/Music/Theory/Permutations/Morris_1984.hs
+++ b/Music/Theory/Permutations/Morris_1984.hs
@@ -5,33 +5,41 @@
 -- <http://www.cccbr.org.uk/bibliography/>
 module Music.Theory.Permutations.Morris_1984 where
 
-import Data.Char {- base -}
 import Data.List {- base -}
 import Data.List.Split {- split -}
 import Data.Maybe {- base -}
 
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Permutations as T {- hmt -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Permutations as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
 
 -- | A change either swaps all adjacent bells, or holds a subset of bells.
 data Change = Swap_All | Hold [Int] deriving (Eq,Show)
 
--- | A method is a sequence of changes, if symmetrical only have the
+-- | A method is a sequence of changes, if symmetrical only half the
 -- changes are given and the lead end.
-data Method = Method [Change] (Maybe Change) deriving (Eq,Show)
+data Method = Method [Change] (Maybe [Change]) deriving (Eq,Show)
 
--- | Compete list of 'Change's at 'Method', writing out symmetries.
+-- | Maximum hold value at 'Method'
+method_limit :: Method -> Int
+method_limit (Method p q) =
+  let f c = case c of
+              Swap_All -> 0
+              Hold i -> maximum i
+  in maximum (map f (p ++ fromMaybe [] q))
+
+-- | Complete list of 'Change's at 'Method', writing out symmetries.
 method_changes :: Method -> [Change]
 method_changes (Method p q) =
     case q of
       Nothing -> p
-      Just q' -> p ++ tail (reverse p) ++ [q']
+      Just le -> p ++ tail (reverse p) ++ le
 
 -- | Parse a change notation.
 --
 -- > map parse_change ["-","x","38"] == [Swap_All,Swap_All,Hold [3,8]]
 parse_change :: String -> Change
-parse_change s = if is_swap_all s then Swap_All else Hold (to_abbrev s)
+parse_change s = if is_swap_all s then Swap_All else Hold (map nchar_to_int s)
 
 -- | Separate changes.
 --
@@ -40,58 +48,64 @@
 split_changes :: String -> [String]
 split_changes = filter (/= ".") . split (dropInitBlank (oneOf "-x."))
 
--- | Parse 'Method' from the sequence of changes with possible lead end.
---
--- > parse_method ("-38-14-1258-36-14-58-16-78",Just "12")
-parse_method :: (String,Maybe String) -> Method
+-- | Place notation, sequence of changes with possible lead end.
+type Place = (String,Maybe String)
+
+-- | Parse 'Method' given 'PLACE' notation.
+parse_method :: Place -> Method
 parse_method (p,q) =
-    let c = map parse_change (split_changes p)
-        le = fmap parse_change q
-    in Method c le
+    let f = map parse_change . split_changes
+    in Method (f p) (fmap f q)
 
--- > map is_swap_all ["-","x","38"] == [True,True,False]
-is_swap_all :: String -> Bool
-is_swap_all s =
-    case s of
-      [c] -> c `elem` "-x"
-      _ -> False
+-- | Parse string into 'Place'.
+--
+-- > parse_method (parse_place "-38-14-1258-36-14-58-16-78,12")
+parse_place :: String -> Place
+parse_place txt =
+  case splitOn "," txt of
+    [p] -> (p,Nothing)
+    [p,q] -> (p,Just q)
+    _ -> error "parse_place?"
 
--- | Swap elemets of two-tuple (pair).
+-- | - or x?
 --
--- > swap_pair (1,2) == (2,1)
-swap_pair :: (s,t) -> (t,s)
-swap_pair (p,q) = (q,p)
+-- > map is_swap_all ["-","x","38"] == [True,True,False]
+is_swap_all :: String -> Bool
+is_swap_all = flip elem ["-","x"]
 
 -- | Flatten list of pairs.
 --
 -- > flatten_pairs [(1,2),(3,4)] == [1..4]
 flatten_pairs :: [(a,a)] -> [a]
-flatten_pairs l =
-    case l of
-      [] -> []
-      (p,q):l' -> p : q : flatten_pairs l'
+flatten_pairs = concatMap T.t2_to_list
 
 -- | Swap all adjacent pairs at list.
 --
 -- > swap_all [1 .. 8] == [2,1,4,3,6,5,8,7]
 swap_all :: [a] -> [a]
-swap_all = flatten_pairs . map swap_pair . T.adj2 2
+swap_all = flatten_pairs . map T.p2_swap . T.adj2 2
 
 numeric_spelling_tbl :: [(Char,Int)]
-numeric_spelling_tbl = zip "1234567890ETABCD" [1 .. 16]
+numeric_spelling_tbl = zip "1234567890ETABCDFGHJKL" [1 .. 22]
 
--- | Parse abbreviated 'Hold' notation, characters are hexedecimal.
+-- | Parse abbreviated 'Hold' notation, characters are NOT hexadecimal.
 --
--- > to_abbrev "380ETA" == [3,8,10,11,12,13]
-to_abbrev :: String -> [Int]
-to_abbrev = map (fromMaybe (error "to_abbrev") . flip lookup numeric_spelling_tbl)
+-- > map nchar_to_int "380ETA" == [3,8,10,11,12,13]
+nchar_to_int :: Char -> Int
+nchar_to_int = fromMaybe (error "nchar_to_int") . flip lookup numeric_spelling_tbl
 
+-- | Inverse of 'nchar_to_int'.
+--
+-- > map int_to_nchar [3,8,10,11,12,13] == "380ETA"
+int_to_nchar :: Int -> Char
+int_to_nchar = flip T.reverse_lookup_err numeric_spelling_tbl
+
 -- | Given a 'Hold' notation, generate permutation cycles.
 --
 -- > let r = [Right (1,2),Left 3,Right (4,5),Right (6,7),Left 8]
--- > in gen_swaps 8 [3,8] == r
+-- > gen_swaps 8 [3,8] == r
 --
--- > let r = [Left 1,Left 2,Right (3,4),Right (5,6),Right (7,8)]
+-- > r = [Left 1,Left 2,Right (3,4),Right (5,6),Right (7,8)]
 -- > gen_swaps 8 [1,2] == r
 gen_swaps :: (Num t, Ord t) => t -> [t] -> [Either t (t,t)]
 gen_swaps k =
@@ -125,7 +139,7 @@
 -- | One-indexed permutation cycles to zero-indexed.
 --
 -- > let r = [[0],[1],[2,3],[4,5],[6,7]]
--- > in to_zero_indexed [[1],[2],[3,4],[5,6],[7,8]] == r
+-- > to_zero_indexed [[1],[2],[3,4],[5,6],[7,8]] == r
 to_zero_indexed :: Enum t => [[t]] -> [[t]]
 to_zero_indexed = map (map pred)
 
@@ -135,7 +149,7 @@
 swap_abbrev :: Int -> [Int] -> [a] -> [a]
 swap_abbrev k a =
     let c = to_zero_indexed (swaps_to_cycles (gen_swaps k a))
-        p = T.from_cycles c
+        p = T.from_cycles_zero_indexed c
     in T.apply_permutation p
 
 -- | Apply a 'Change'.
@@ -151,7 +165,7 @@
 -- > let r = ([1,2,4,5,3]
 -- >         ,[[1,2,3,4,5],[2,1,3,4,5],[2,3,1,4,5],[3,2,4,1,5],[3,4,2,5,1]
 -- >          ,[4,3,2,5,1],[4,2,3,1,5],[2,4,1,3,5],[2,1,4,3,5],[1,2,4,3,5]])
--- > in apply_method cambridgeshire_slow_course_doubles [1..5] == r
+-- > apply_method cambridgeshire_slow_course_doubles [1..5] == r
 apply_method :: Method -> [a] -> ([a],[[a]])
 apply_method m l =
     let k = length l
@@ -172,60 +186,69 @@
     in rec l []
 
 -- | 'concat' of 'closed_method' with initial sequence appended.
-closed_method' :: Eq a => Method -> [a] -> [[a]]
-closed_method' m l = concat (closed_method m l) ++ [l]
+closed_method_lp :: Eq a => Method -> [a] -> [[a]]
+closed_method_lp m l = concat (closed_method m l) ++ [l]
 
+-- | 'closed_method' of 'parse_method'
+closed_place :: Eq t => Place -> [t] -> [[[t]]]
+closed_place pl = closed_method (parse_method pl)
+
 -- * Methods
 
--- | <https://rsw.me.uk/blueline/methods/view/Cambridgeshire_Slow_Course_Doubles>
+-- | <https://rsw.me.uk/blueline/methods/view/Cambridgeshire_Place_Doubles>
 --
--- > length (closed_method cambridgeshire_slow_course_doubles [1..5]) == 3
+-- > length (closed_place cambridgeshire_place_doubles_pl [1..5]) == 3
+cambridgeshire_place_doubles_pl :: Place
+cambridgeshire_place_doubles_pl = ("345.145.5.1.345",Just "123")
+
+-- | 'parse_method' of 'cambridgeshire_place_doubles_pl'
 cambridgeshire_slow_course_doubles :: Method
-cambridgeshire_slow_course_doubles =
-    let a = ("345.145.5.1.345",Just "123")
-    in parse_method a
+cambridgeshire_slow_course_doubles = parse_method cambridgeshire_place_doubles_pl
 
--- | Double Cambridge Cyclic Bob Minor.
---
--- <https://rsw.me.uk/blueline/methods/view/Double_Cambridge_Cyclic_Bob_Minor>
+-- | <https://rsw.me.uk/blueline/methods/view/Double_Cambridge_Cyclic_Bob_Minor>
 --
--- > length (closed_method double_cambridge_cyclic_bob_minor [1..6]) == 5
+-- > length (closed_place double_cambridge_cyclic_bob_minor_pl [1..6]) == 5
+double_cambridge_cyclic_bob_minor_pl :: Place
+double_cambridge_cyclic_bob_minor_pl = ("-14-16-56-36-16-12",Nothing)
+
+-- | 'parse_method' of 'double_cambridge_cyclic_bob_minor_pl'
 double_cambridge_cyclic_bob_minor :: Method
-double_cambridge_cyclic_bob_minor =
-    let a = ("-14-16-56-36-16-12",Nothing)
-    in parse_method a
+double_cambridge_cyclic_bob_minor = parse_method double_cambridge_cyclic_bob_minor_pl
 
--- | Hammersmith Bob Triples
---
--- <https://rsw.me.uk/blueline/methods/view/Hammersmith_Bob_Triples>
+-- | <https://rsw.me.uk/blueline/methods/view/Hammersmith_Bob_Triples>
 --
--- > length (closed_method hammersmith_bob_triples [1..7]) == 6
+-- > length (closed_place hammersmith_bob_triples_pl [1..7]) == 6
+hammersmith_bob_triples_pl :: Place
+hammersmith_bob_triples_pl = ("7.1.5.123.7.345.7",Just "127")
+
 hammersmith_bob_triples :: Method
-hammersmith_bob_triples =
-    let a = ("7.1.5.123.7.345.7",Just "127")
-    in parse_method a
+hammersmith_bob_triples = parse_method hammersmith_bob_triples_pl
 
 -- | <https://rsw.me.uk/blueline/methods/view/Cambridge_Surprise_Major>
 --
--- > length (closed_method cambridge_surprise_major [1..8]) == 7
+-- > length (closed_place cambridge_surprise_major_pl [1..8]) == 7
+cambridge_surprise_major_pl :: Place
+cambridge_surprise_major_pl = ("-38-14-1258-36-14-58-16-78",Just "12")
+
 cambridge_surprise_major :: Method
-cambridge_surprise_major =
-    let a = ("-38-14-1258-36-14-58-16-78",Just "12")
-    in parse_method a
+cambridge_surprise_major = parse_method cambridge_surprise_major_pl
 
 -- | <https://rsw.me.uk/blueline/methods/view/Smithsonian_Surprise_Royal>
 --
--- > let m = closed_method smithsonian_surprise_royal [1..10]
--- > (length m,nub (map length m),sum (map length m)) == (9,[40],360)
+-- > let c = closed_place smithsonian_surprise_royal_pl [1..10]
+-- > (length c,nub (map length c),sum (map length c)) == (9,[40],360)
+smithsonian_surprise_royal_pl :: Place
+smithsonian_surprise_royal_pl = ("-30-14-50-16-3470-18-1456-50-16-70",Just "12")
+
 smithsonian_surprise_royal :: Method
-smithsonian_surprise_royal =
-    let a = ("-30-14-50-16-3470-18-1456-50-16-70",Just "12")
-    in parse_method a
+smithsonian_surprise_royal = parse_method smithsonian_surprise_royal_pl
 
 -- | <https://rsw.me.uk/blueline/methods/view/Ecumenical_Surprise_Maximus>
 --
--- > let m = closed_method ecumenical_surprise_maximus [1..12]
--- > (length m,nub (map length m),sum (map length m)) == (11,[48],528)
+-- > c = closed_place ecumenical_surprise_maximus_pl [1..12]
+-- > (length c,nub (map length c),sum (map length c)) == (11,[48],528)
+ecumenical_surprise_maximus_pl :: Place
+ecumenical_surprise_maximus_pl = ("x3Tx14x5Tx16x7Tx1238x149Tx50x16x7Tx18.90.ET",Just "12")
+
 ecumenical_surprise_maximus :: Method
-ecumenical_surprise_maximus =
-  parse_method ("x3Tx14x5Tx16x7Tx1238x149Tx50x16x7Tx18.90.ET",Just "12")
+ecumenical_surprise_maximus = parse_method ecumenical_surprise_maximus_pl
diff --git a/Music/Theory/Pitch.hs b/Music/Theory/Pitch.hs
--- a/Music/Theory/Pitch.hs
+++ b/Music/Theory/Pitch.hs
@@ -7,17 +7,23 @@
 import Data.Maybe {- base -}
 import Text.Printf {- base -}
 
+import qualified Text.Parsec as P {- parsec -}
+
 import qualified Music.Theory.List as T {- hmt -}
 import qualified Music.Theory.Math as T {- hmt -}
+import qualified Music.Theory.Math.Convert as T {- hmt -}
+import qualified Music.Theory.Parse as T {- hmt -}
 import qualified Music.Theory.Pitch.Note as T {- hmt -}
+import qualified Music.Theory.Show as T {- hmt -}
+import qualified Music.Theory.Tuning as T {- hmt -}
 
--- * Octave & pitch-class (generic)
+-- * Octave pitch-class (generic)
 
 -- | 'Octave' and 'PitchClass' duple.
 type Octave_PitchClass i = (i,i)
 
 -- | Normalise 'Octave_PitchClass' value, ie. ensure pitch-class is in (0,11).
-octave_pitchclass_nrm :: Integral i => Octave_PitchClass i -> Octave_PitchClass i
+octave_pitchclass_nrm :: (Ord i,Num i) => Octave_PitchClass i -> Octave_PitchClass i
 octave_pitchclass_nrm (o,pc) =
     if pc > 11
     then octave_pitchclass_nrm (o+1,pc-12)
@@ -28,80 +34,125 @@
 -- | Transpose 'Octave_PitchClass' value.
 octave_pitchclass_trs :: Integral i => i -> Octave_PitchClass i -> Octave_PitchClass i
 octave_pitchclass_trs n (o,pc) =
-    let pc' = fromIntegral pc
-        k = pc' + n
+    let k = pc + n
         (i,j) = k `divMod` 12
-    in (fromIntegral o + fromIntegral i,fromIntegral j)
+    in (o + i,j)
 
 -- | 'Octave_PitchClass' value to integral /midi/ note number.
-octave_pitchclass_to_midi :: Integral i => Octave_PitchClass i -> i
+--
+-- > map octave_pitchclass_to_midi [(-1,9),(8,0)] == map (+ 9) [0,99]
+octave_pitchclass_to_midi :: Num i => Octave_PitchClass i -> i
 octave_pitchclass_to_midi (o,pc) = 60 + ((o - 4) * 12) + pc
 
 -- | Inverse of 'octave_pitchclass_to_midi'.
-midi_to_octave_pitchclass :: Integral i => i -> Octave_PitchClass i
-midi_to_octave_pitchclass n = (n - 12) `divMod` 12
+--
+-- > map midi_to_octave_pitchclass [0,36,60,84,91] == [(-1,0),(2,0),(4,0),(6,0),(6,7)]
+midi_to_octave_pitchclass :: (Integral m,Integral i) => m -> Octave_PitchClass i
+midi_to_octave_pitchclass n = (fromIntegral n - 12) `divMod` 12
 
+{- | One-indexed piano key number (for standard 88 key piano) to pitch class.
+     This has the mnemonic that 49 maps to (4,9).
+
+> map pianokey_to_octave_pitchclass [1,49,88] == [(0,9),(4,9),(8,0)]
+-}
+pianokey_to_octave_pitchclass :: (Integral m,Integral i) => m -> Octave_PitchClass i
+pianokey_to_octave_pitchclass = midi_to_octave_pitchclass . (+) 20
+
 -- * Octave & PitchClass
 
--- | Pitch classes are modulo twelve integers.
+-- | Pitch classes are modulo twelve integers (0-11)
 type PitchClass = Int
 
 -- | Octaves are integers, the octave of middle C is @4@.
 type Octave = Int
 
 -- | 'Octave' and 'PitchClass' duple.
-type OctPC = (Octave,PitchClass)
+type OctPc = (Octave,PitchClass)
 
 -- | Translate from generic octave & pitch-class duple.
-to_octpc :: (Integral pc, Integral oct) => (oct,pc) -> OctPC
-to_octpc (oct,pc) = (fromIntegral oct,fromIntegral pc)
+octave_pitchclass_to_octpc :: (Integral pc, Integral oct) => (oct,pc) -> OctPc
+octave_pitchclass_to_octpc (oct,pc) = (fromIntegral oct,fromIntegral pc)
 
--- | Normalise 'OctPC'.
+-- | Normalise 'OctPc'.
 --
 -- > octpc_nrm (4,16) == (5,4)
-octpc_nrm :: OctPC -> OctPC
+octpc_nrm :: OctPc -> OctPc
 octpc_nrm = octave_pitchclass_nrm
 
--- | Transpose 'OctPC'.
+-- | Transpose 'OctPc'.
 --
 -- > octpc_trs 7 (4,9) == (5,4)
 -- > octpc_trs (-11) (4,9) == (3,10)
-octpc_trs :: Int -> OctPC -> OctPC
+octpc_trs :: Int -> OctPc -> OctPc
 octpc_trs = octave_pitchclass_trs
 
 -- | Enumerate range, inclusive.
 --
 -- > octpc_range ((3,8),(4,1)) == [(3,8),(3,9),(3,10),(3,11),(4,0),(4,1)]
-octpc_range :: (OctPC,OctPC) -> [OctPC]
+octpc_range :: (OctPc,OctPc) -> [OctPc]
 octpc_range (l,r) =
     let (l',r') = (octpc_to_midi l,octpc_to_midi r)
     in map midi_to_octpc [l' .. r']
 
--- * Midi note number
+-- * Midi note number (0 - 127)
 
--- | Midi note number
+{- | Midi note number (0 - 127).
+     Midi data values are unsigned 7-bit integers, however using an unsigned type would be problematic.
+     It would make transposition, for instance, awkward.
+     x - 12 would transpose down an octave, but the transposition interval itself could not be negative.
+-}
 type Midi = Int
 
--- | 'OctPC' value to integral /midi/ note number.
+-- | Type conversion
+midi_to_int :: Midi -> Int
+midi_to_int = id
+
+-- | Type-specialise /f/, ie. round, ceiling, truncate
+double_to_midi :: (Double -> Midi) -> Double -> Midi
+double_to_midi = T.double_to_int
+
+-- | 'OctPc' value to integral /midi/ note number.
 --
--- > map octpc_to_midi [(0,0),(2,6),(4,9),(9,0)] == [12,42,69,120]
+-- > map octpc_to_midi [(0,0),(2,6),(4,9),(6,2),(9,0)] == [12,42,69,86,120]
 -- > map octpc_to_midi [(0,9),(8,0)] == [21,108]
-octpc_to_midi :: OctPC -> Midi
+octpc_to_midi :: OctPc -> Midi
 octpc_to_midi = octave_pitchclass_to_midi
 
 -- | Inverse of 'octpc_to_midi'.
 --
 -- > map midi_to_octpc [40,69] == [(2,4),(4,9)]
-midi_to_octpc :: Midi -> OctPC
+midi_to_octpc :: Midi -> OctPc
 midi_to_octpc = midi_to_octave_pitchclass
 
 -- * Octave & fractional pitch-class
 
+-- | (octave,pitch-class) to fractional octave.
+--   This is an odd notation, but can be useful for writing pitch data where a float is required.
+--   Note this is not a linear octave, for that see 'Sound.SC3.Common.Math.oct_to_cps'.
+--
+-- > map octpc_to_foct [(4,0),(4,7),(5,11)] == [4.00,4.07,5.11]
+octpc_to_foct :: (Integral i, Fractional r) => (i,i) -> r
+octpc_to_foct (o,pc) = fromIntegral o + (fromIntegral pc / 100)
+
+-- | Inverse of 'octpc_to_foct'.
+--
+-- > map foct_to_octpc [3.11,4.00,4.07,5.11] == [(3,11),(4,0),(4,7),(5,11)]
+foct_to_octpc :: (Integral i, RealFrac r) => r -> (i,i)
+foct_to_octpc x =
+  let (p,q) = T.integral_and_fractional_parts x
+  in (p,round (q * 100))
+
+-- | 'octpc_to_midi' of 'foct_to_octpc'.
+foct_to_midi :: (Integral i, RealFrac r) => r -> i
+foct_to_midi = octave_pitchclass_to_midi . foct_to_octpc
+
+-- * FMIDI
+
 -- | Fractional midi note number.
 type FMidi = Double
 
 -- | Fractional octave pitch-class (octave is integral, pitch-class is fractional).
-type FOctPC = (Int,Double)
+type FOctPc = (Int,Double)
 
 -- | 'fromIntegral' of 'octpc_to_midi'.
 octpc_to_fmidi :: (Integral i,Num n) => Octave_PitchClass i -> n
@@ -126,11 +177,22 @@
 fmidi_in_octave :: RealFrac f => Octave -> f -> f
 fmidi_in_octave o m = let (_,pc) = fmidi_to_foctpc m in foctpc_to_fmidi (o,pc)
 
+-- | Print fractional midi note number as ET12 pitch with cents detune in parentheses.
+--
+-- > fmidi_et12_cents_pp T.pc_spell_ks 66.5 == "F♯4(+50)"
+fmidi_et12_cents_pp :: Spelling PitchClass -> FMidi -> String
+fmidi_et12_cents_pp sp =
+    let f (m,c) =
+            let d = T.num_diff_str (round c :: Int)
+                d' = if null d then "" else "(" ++ d ++ ")"
+            in pitch_pp (midi_to_pitch sp m) ++ d'
+    in f . midi_detune_normalise . fmidi_to_midi_detune
+
 -- * Pitch
 
 -- | Common music notation pitch value.
-data Pitch = Pitch {note :: T.Note_T
-                   ,alteration :: T.Alteration_T
+data Pitch = Pitch {note :: T.Note
+                   ,alteration :: T.Alteration
                    ,octave :: Octave}
            deriving (Eq,Show)
 
@@ -139,8 +201,8 @@
 
 -- | Simplify 'Pitch' to standard 12ET by deleting quarter tones.
 --
--- > let p = Pitch A QuarterToneSharp 4
--- > in alteration (pitch_clear_quarter_tone p) == Sharp
+-- > let p = Pitch T.A T.QuarterToneSharp 4
+-- > alteration (pitch_clear_quarter_tone p) == T.Sharp
 pitch_clear_quarter_tone :: Pitch -> Pitch
 pitch_clear_quarter_tone p =
     let Pitch n a o = p
@@ -150,7 +212,7 @@
 --
 -- > pitch_to_octpc (Pitch F Sharp 4) == (4,6)
 pitch_to_octpc :: Integral i => Pitch -> Octave_PitchClass i
-pitch_to_octpc = midi_to_octave_pitchclass . pitch_to_midi
+pitch_to_octpc = midi_to_octave_pitchclass . T.int_id . pitch_to_midi
 
 -- | Is 'Pitch' 12-ET.
 pitch_is_12et :: Pitch -> Bool
@@ -194,12 +256,12 @@
 -- * Spelling
 
 -- | Function to spell a 'PitchClass'.
-type Spelling n = n -> (T.Note_T,T.Alteration_T)
+type Spelling n = n -> (T.Note,T.Alteration)
 
 -- | Variant of 'Spelling' for incomplete functions.
-type Spelling_M i = i -> Maybe (T.Note_T,T.Alteration_T)
+type Spelling_M i = i -> Maybe (T.Note,T.Alteration)
 
--- | Given 'Spelling' function translate from 'OctPC' notation to 'Pitch'.
+-- | Given 'Spelling' function translate from 'OctPc' notation to 'Pitch'.
 --
 -- > octpc_to_pitch T.pc_spell_sharp (4,6) == Pitch T.F T.Sharp 4
 octpc_to_pitch :: Integral i => Spelling i -> Octave_PitchClass i -> Pitch
@@ -209,28 +271,20 @@
 
 -- | Midi note number to 'Pitch'.
 --
+-- > import Music.Theory.Pitch.Spelling.Table as T
 -- > let r = ["C4","E♭4","F♯4"]
--- > in map (pitch_pp . midi_to_pitch pc_spell_ks) [60,63,66] == r
-midi_to_pitch :: Integral i => Spelling i -> i -> Pitch
+-- > map (pitch_pp . midi_to_pitch T.pc_spell_ks) [60,63,66] == r
+midi_to_pitch :: (Integral i,Integral k) => Spelling k -> i -> Pitch
 midi_to_pitch sp = octpc_to_pitch sp . midi_to_octave_pitchclass
 
--- | Print fractional midi note number as ET12 pitch with cents detune in parentheses.
---
--- > fmidi_et12_cents_pp 66.5 == "F♯4(+50)"
-fmidi_et12_cents_pp :: Spelling PitchClass -> Double -> String
-fmidi_et12_cents_pp sp =
-    let f (m,c) =
-            let d = T.num_diff_str (round c :: Int)
-                d' = if null d then "" else "(" ++ d ++ ")"
-            in pitch_pp (midi_to_pitch sp m) ++ d'
-    in f . midi_detune_normalise . fmidi_to_midi_detune
+{- | Fractional midi note number to 'Pitch'.
 
--- | Fractional midi note number to 'Pitch'.
---
--- > fmidi_to_pitch pc_spell_ks 69.25 == Nothing
+> p = Pitch T.B T.ThreeQuarterToneFlat 4
+> map (fmidi_to_pitch T.pc_spell_ks) [69.25,69.5] == [Nothing,Just p]
+-}
 fmidi_to_pitch :: RealFrac n => Spelling PitchClass -> n -> Maybe Pitch
 fmidi_to_pitch sp m =
-    let m' = round m
+    let m' = T.real_round_int m
         (Pitch n a o) = midi_to_pitch sp m'
         q = m - fromIntegral m'
     in case T.alteration_edit_quarter_tone q a of
@@ -239,11 +293,11 @@
 
 -- | Erroring variant.
 --
--- > import Music.Theory.Pitch.Spelling
--- > pitch_pp (fmidi_to_pitch_err pc_spell_ks 65.5) == "F𝄲4"
--- > pitch_pp (fmidi_to_pitch_err pc_spell_ks 66.5) == "F𝄰4"
--- > pitch_pp (fmidi_to_pitch_err pc_spell_ks 67.5) == "A𝄭4"
--- > pitch_pp (fmidi_to_pitch_err pc_spell_ks 69.5) == "B𝄭4"
+-- > import Music.Theory.Pitch.Spelling as T
+-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 65.5) == "F𝄲4"
+-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 66.5) == "F𝄰4"
+-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 67.5) == "A𝄭4"
+-- > pitch_pp (fmidi_to_pitch_err T.pc_spell_ks 69.5) == "B𝄭4"
 fmidi_to_pitch_err :: (Show n,RealFrac n) => Spelling Int -> n -> Pitch
 fmidi_to_pitch_err sp m = fromMaybe (error (show ("fmidi_to_pitch",m))) (fmidi_to_pitch sp m)
 
@@ -251,10 +305,9 @@
 --
 -- > import Music.Theory.Pitch.Name as T
 -- > import Music.Theory.Pitch.Spelling as T
---
--- > pitch_tranpose T.pc_spell_ks 2 T.ees5 == T.f5
-pitch_tranpose :: (RealFrac n,Show n) => Spelling Int -> n -> Pitch -> Pitch
-pitch_tranpose sp n p =
+-- > pitch_transpose_fmidi T.pc_spell_ks 2 T.ees5 == T.f5
+pitch_transpose_fmidi :: (RealFrac n,Show n) => Spelling Int -> n -> Pitch -> Pitch
+pitch_transpose_fmidi sp n p =
     let m = pitch_to_fmidi p
     in fmidi_to_pitch_err sp (m + n)
 
@@ -264,8 +317,9 @@
 
 -- | Octave displacement of /m2/ that is nearest /m1/.
 --
--- > let {p = octpc_to_fmidi (2,1);q = map octpc_to_fmidi [(4,11),(4,0),(4,1)]}
--- > in map (fmidi_in_octave_nearest p) q == [35,36,37]
+-- > let p = octpc_to_fmidi (2,1)
+-- > let q = map octpc_to_fmidi [(4,11),(4,0),(4,1)]
+-- > map (fmidi_in_octave_nearest p) q == [35,36,37]
 fmidi_in_octave_nearest :: RealFrac n => n -> n -> n
 fmidi_in_octave_nearest m1 m2 =
     let m2' = fmidi_in_octave (fmidi_octave m1) m2
@@ -290,45 +344,51 @@
 fmidi_in_octave_below :: RealFrac a => a -> a -> a
 fmidi_in_octave_below p q = let r = fmidi_in_octave_nearest p q in if r > p then r - 12 else r
 
-cps_in_octave' :: Floating f => (f -> f -> f) -> f -> f -> f
-cps_in_octave' f p = fmidi_to_cps . f (cps_to_fmidi p) . cps_to_fmidi
+-- | CPS form of binary /fmidi/ function /f/.
+lift_fmidi_binop_to_cps :: Floating f => (f -> f -> f) -> f -> f -> f
+lift_fmidi_binop_to_cps f p = T.fmidi_to_cps . f (cps_to_fmidi p) . cps_to_fmidi
 
 -- | CPS form of 'fmidi_in_octave_nearest'.
 --
 -- > map cps_octave [440,256] == [4,4]
 -- > round (cps_in_octave_nearest 440 256) == 512
 cps_in_octave_nearest :: (Floating f,RealFrac f) => f -> f -> f
-cps_in_octave_nearest = cps_in_octave' fmidi_in_octave_nearest
+cps_in_octave_nearest = lift_fmidi_binop_to_cps fmidi_in_octave_nearest
 
--- | Raise or lower the frequency /q/ by octaves until it is in the
--- octave starting at /p/.
+-- | CPS form of 'fmidi_in_octave_above'.
 --
--- > cps_in_octave_above 55.0 392.0 == 98.0
-cps_in_octave_above :: (Ord a, Fractional a) => a -> a -> a
-cps_in_octave_above p =
-    let go q = if q > p * 2 then go (q / 2) else if q < p then go (q * 2) else q
-    in go
-
--- > cps_in_octave_above' 55.0 392.0 == 97.99999999999999
-cps_in_octave_above' :: (Floating f,RealFrac f) => f -> f -> f
-cps_in_octave_above' = cps_in_octave' fmidi_in_octave_above
+-- > cps_in_octave_above 55.0 392.0 == 97.99999999999999
+cps_in_octave_above :: (Floating f,RealFrac f) => f -> f -> f
+cps_in_octave_above = lift_fmidi_binop_to_cps fmidi_in_octave_above
 
+-- | CPS form of 'fmidi_in_octave_above'.
 cps_in_octave_below :: (Floating f,RealFrac f) => f -> f -> f
-cps_in_octave_below = cps_in_octave' fmidi_in_octave_below
+cps_in_octave_below = lift_fmidi_binop_to_cps fmidi_in_octave_below
 
+-- | Direct implementation of 'cps_in_octave_above'.
+--   Raise or lower the frequency /q/ by octaves until it is in the
+--   octave starting at /p/.
+--
+-- > cps_in_octave_above_direct 55.0 392.0 == 98.0
+cps_in_octave_above_direct :: (Ord a, Fractional a) => a -> a -> a
+cps_in_octave_above_direct p q =
+  let f = cps_in_octave_above_direct p
+  in if q > p * 2 then f (q / 2) else if q < p then f (q * 2) else q
+
 -- | Set octave of /p2/ so that it nearest to /p1/.
 --
+-- > import Music.Theory.Pitch
 -- > import Music.Theory.Pitch.Name as T
---
--- > let {r = ["B1","C2","C#2"];f = pitch_in_octave_nearest T.cis2}
--- > in map (pitch_pp_iso . f) [T.b4,T.c4,T.cis4] == r
+-- > let r = ["B1","C2","C#2"]
+-- > let f = pitch_in_octave_nearest T.cis2
+-- > map (pitch_pp_iso . f) [T.b4,T.c4,T.cis4] == r
 pitch_in_octave_nearest :: Pitch -> Pitch -> Pitch
 pitch_in_octave_nearest p1 p2 =
     let f = pitch_to_fmidi :: Pitch -> Double
         o = fmidi_octave (fmidi_in_octave_nearest (f p1) (f p2))
     in p2 {octave = o}
 
--- | Raise 'Note_T' of 'Pitch', account for octave transposition.
+-- | Raise 'Note' of 'Pitch', account for octave transposition.
 --
 -- > pitch_note_raise (Pitch B Natural 3) == Pitch C Natural 4
 pitch_note_raise :: Pitch -> Pitch
@@ -337,7 +397,7 @@
     then Pitch minBound a (o + 1)
     else Pitch (succ n) a o
 
--- | Lower 'Note_T' of 'Pitch', account for octave transposition.
+-- | Lower 'Note' of 'Pitch', account for octave transposition.
 --
 -- > pitch_note_lower (Pitch C Flat 4) == Pitch B Flat 3
 pitch_note_lower :: Pitch -> Pitch
@@ -349,9 +409,9 @@
 -- | Rewrite 'Pitch' to not use @3/4@ tone alterations, ie. re-spell
 -- to @1/4@ alteration.
 --
--- > let {p = Pitch A ThreeQuarterToneFlat 4
--- >     ;q = Pitch G QuarterToneSharp 4}
--- > in pitch_rewrite_threequarter_alteration p == q
+-- > let p = Pitch T.A T.ThreeQuarterToneFlat 4
+-- > let q = Pitch T.G T.QuarterToneSharp 4
+-- > pitch_rewrite_threequarter_alteration p == q
 pitch_rewrite_threequarter_alteration :: Pitch -> Pitch
 pitch_rewrite_threequarter_alteration (Pitch n a o) =
     case a of
@@ -361,81 +421,63 @@
 
 -- | Apply function to 'octave' of 'PitchClass'.
 --
--- > pitch_edit_octave (+ 1) (Pitch A Natural 4) == Pitch A Natural 5
+-- > pitch_edit_octave (+ 1) (Pitch T.A T.Natural 4) == Pitch T.A T.Natural 5
 pitch_edit_octave :: (Octave -> Octave) -> Pitch -> Pitch
 pitch_edit_octave f (Pitch n a o) = Pitch n a (f o)
 
 -- * Frequency (CPS)
 
--- | /Midi/ note number to cycles per second, given frequency of ISO A4.
-midi_to_cps_f0 :: (Integral i,Floating f) => f -> i -> f
-midi_to_cps_f0 f0 = fmidi_to_cps_f0 f0 . fromIntegral
-
--- | 'midi_to_cps_f0' 440.
---
--- > map midi_to_cps [60,69] == [261.6255653005986,440.0]
-midi_to_cps :: (Integral i,Floating f) => i -> f
-midi_to_cps = midi_to_cps_f0 440
-
--- | Fractional /midi/ note number to cycles per second, given frequency of ISO A4.
-fmidi_to_cps_f0 :: Floating a => a -> a -> a
-fmidi_to_cps_f0 f0 i = f0 * (2 ** ((i - 69) * (1 / 12)))
-
--- | 'fmidi_to_cps_f0' 440.
---
--- > map fmidi_to_cps [69,69.1] == [440.0,442.5488940698553]
-fmidi_to_cps :: Floating a => a -> a
-fmidi_to_cps = fmidi_to_cps_f0 440
+-- | 'fmidi_to_cps' of 'pitch_to_fmidi', given (k0,f0).
+pitch_to_cps_k0 :: Floating n => (n,n) -> Pitch -> n
+pitch_to_cps_k0 o = T.fmidi_to_cps_k0 o . pitch_to_fmidi
 
 -- | 'fmidi_to_cps' of 'pitch_to_fmidi', given frequency of ISO A4.
 pitch_to_cps_f0 :: Floating n => n -> Pitch -> n
-pitch_to_cps_f0 f0 = fmidi_to_cps_f0 f0 . pitch_to_fmidi
+pitch_to_cps_f0 f0 = pitch_to_cps_k0 (69,f0)
 
--- | 'pitch_to_cps_f0' 440.
+-- | 'pitch_to_cps_k0' (60,440).
 pitch_to_cps :: Floating n => Pitch -> n
-pitch_to_cps = pitch_to_cps_f0 440
+pitch_to_cps = pitch_to_cps_k0 (69,440)
 
 -- | Frequency (cps = cycles per second) to fractional /midi/ note
 -- number, given frequency of ISO A4 (mnn = 69).
-cps_to_fmidi_f0 :: Floating a => a -> a -> a
-cps_to_fmidi_f0 f0 a = (logBase 2 (a * (1 / f0)) * 12) + 69
+cps_to_fmidi_k0 :: Floating a => (a,a) -> a -> a
+cps_to_fmidi_k0 (k0,f0) a = (logBase 2 (a * (1 / f0)) * 12) + k0
 
--- | 'cps_to_fmidi_f0' @440@.
+-- | 'cps_to_fmidi_k0' @(69,440)@.
 --
 -- > cps_to_fmidi 440 == 69
 -- > cps_to_fmidi (fmidi_to_cps 60.25) == 60.25
 cps_to_fmidi :: Floating a => a -> a
-cps_to_fmidi = cps_to_fmidi_f0 440
+cps_to_fmidi = cps_to_fmidi_k0 (69,440)
 
--- | Frequency (cycles per second) to /midi/ note number, ie. 'round'
--- of 'cps_to_fmidi'.
+-- | Frequency (cycles per second) to /midi/ note number,
+-- ie. 'round' of 'cps_to_fmidi'.
 --
 -- > map cps_to_midi [261.6,440] == [60,69]
 cps_to_midi :: (Integral i,Floating f,RealFrac f) => f -> i
 cps_to_midi = round . cps_to_fmidi
 
--- | 'midi_to_cps_f0' of 'octpc_to_midi', given frequency of ISO A4.
-octpc_to_cps_f0 :: (Integral i,Floating n) => n -> Octave_PitchClass i -> n
-octpc_to_cps_f0 f0 = midi_to_cps_f0 f0 . octave_pitchclass_to_midi
+-- | 'midi_to_cps_f0' of 'octpc_to_midi', given (k0,f0)
+octpc_to_cps_k0 :: (Integral i,Floating n) => (n,n) -> Octave_PitchClass i -> n
+octpc_to_cps_k0 o = T.midi_to_cps_k0 o . octave_pitchclass_to_midi
 
--- | 'octpc_to_cps_f0' 440.
---
--- > octpc_to_cps (4,9) == 440
+{- | 'octpc_to_cps_k0' (69,440).
+
+> map (round . octpc_to_cps) [(-1,0),(0,0),(4,9),(9,0)] == [8,16,440,8372]
+-}
 octpc_to_cps :: (Integral i,Floating n) => Octave_PitchClass i -> n
-octpc_to_cps = octpc_to_cps_f0 440
+octpc_to_cps = octpc_to_cps_k0 (69,440)
 
 -- | 'midi_to_octpc' of 'cps_to_midi'.
 cps_to_octpc :: (Floating f,RealFrac f,Integral i) => f -> Octave_PitchClass i
-cps_to_octpc = midi_to_octave_pitchclass . cps_to_midi
+cps_to_octpc = midi_to_octave_pitchclass . T.real_round_int . cps_to_fmidi
 
 cps_octave :: (Floating f,RealFrac f) => f -> Octave
 cps_octave = fst . cps_to_octpc
 
 -- * MIDI detune (cents)
 
--- | Midi note number with cents detune.
-type Midi_Detune' c = (Int,c)
-
 -- | Is cents in (-50,+50].
 --
 -- > map cents_is_normal [-250,-75,75,250] == replicate 4 False
@@ -443,45 +485,60 @@
 cents_is_normal c = c > (-50) && c <= 50
 
 -- | 'cents_is_normal' of 'snd'.
-midi_detune_is_normal :: (Num c, Ord c) => Midi_Detune' c -> Bool
+midi_detune_is_normal :: (Num c, Ord c) => (x,c) -> Bool
 midi_detune_is_normal = cents_is_normal . snd
 
 -- | In normal form the detune is in the range (-50,+50] instead of [0,100) or wider.
 --
 -- > map midi_detune_normalise [(60,-250),(60,-75),(60,75),(60,250)]
-midi_detune_normalise :: (Ord c,Num c) => Midi_Detune' c -> Midi_Detune' c
-midi_detune_normalise (m,c) =
-    if c > 50
-    then midi_detune_normalise (m + 1,c - 100)
-    else if c > (-50)
-         then (m,c)
-         else midi_detune_normalise (m - 1,c + 100)
+midi_detune_normalise :: (Num m,Ord c,Num c) => (m,c) -> (m,c)
+midi_detune_normalise =
+  let recur (m,c) =
+        if c > 50
+        then recur (m + 1,c - 100)
+        else if c > (-50)
+             then (m,c)
+             else recur (m - 1,c + 100)
+  in recur
 
+-- | In normal-positive form the detune is in the range (0,+100].
+--
+-- > map midi_detune_normalise_positive [(60,-250),(60,-75),(60,75),(60,250)]
+midi_detune_normalise_positive :: (Num m,Ord m,Ord c,Num c) => (m,c) -> (m,c)
+midi_detune_normalise_positive =
+  let recur (m,c) =
+        if c < 0
+        then recur (m - 1,c + 100)
+        else if c > 100
+        then recur (m + 1,c - 100)
+        else (m,c)
+  in recur
+
 -- | Inverse of 'cps_to_midi_detune', given frequency of ISO @A4@.
-midi_detune_to_cps_f0 :: Real c => Double -> Midi_Detune' c -> Double
-midi_detune_to_cps_f0 f0 (m,c) = fmidi_to_cps_f0 f0 (fromIntegral m + (realToFrac c / 100))
+midi_detune_to_cps_f0 :: (Integral m,Real c) => Double -> (m,c) -> Double
+midi_detune_to_cps_f0 f0 (m,c) = T.fmidi_to_cps_f0 f0 (fromIntegral m + (realToFrac c / 100))
 
 -- | Inverse of 'cps_to_midi_detune'.
 --
 -- > map midi_detune_to_cps [(69,0),(68,100)] == [440,440]
-midi_detune_to_cps :: Real c => Midi_Detune' c -> Double
+midi_detune_to_cps :: (Integral m,Real c) => (m,c) -> Double
 midi_detune_to_cps = midi_detune_to_cps_f0 440
 
 -- | 'Midi_Detune' to fractional midi note number.
 --
 -- > midi_detune_to_fmidi (60,50.0) == 60.50
-midi_detune_to_fmidi :: Real c => Midi_Detune' c -> Double
+midi_detune_to_fmidi :: (Integral m,Real c) => (m,c) -> Double
 midi_detune_to_fmidi (mnn,c) = fromIntegral mnn + (realToFrac c / 100)
 
 -- | 'Midi_Detune' to 'Pitch', detune must be precisely at a notateable Pitch.
 --
--- > let p = Pitch {note = C, alteration = QuarterToneSharp, octave = 4}
--- > in midi_detune_to_pitch T.pc_spell_ks (midi_detune_nearest_24et (60,35)) == p
-midi_detune_to_pitch :: Real c => Spelling Int -> Midi_Detune' c -> Pitch
+-- > let p = Pitch {note = T.C, alteration = T.QuarterToneSharp, octave = 4}
+-- > midi_detune_to_pitch T.pc_spell_ks (midi_detune_nearest_24et (60,35)) == p
+midi_detune_to_pitch :: (Integral m,Real c) => Spelling Int -> (m,c) -> Pitch
 midi_detune_to_pitch sp = fmidi_to_pitch_err sp . cps_to_fmidi . midi_detune_to_cps
 
 -- | Midi note number with real-valued cents detune.
-type Midi_Detune = Midi_Detune' Double
+type Midi_Detune = (Midi,Double)
 
 -- | Fractional midi note number to 'Midi_Detune'.
 --
@@ -506,7 +563,7 @@
 -- * MIDI cents
 
 -- | Midi note number with integral cents detune.
-type Midi_Cents = Midi_Detune' Int
+type Midi_Cents = (Midi,Int)
 
 midi_detune_to_midi_cents :: Midi_Detune -> Midi_Cents
 midi_detune_to_midi_cents (m,c) = (m,round c)
@@ -517,41 +574,86 @@
 midi_cents_pp :: Midi_Cents -> String
 midi_cents_pp (m,c) = if cents_is_normal c then printf "%d.%02d" m c else error "midi_cents_pp"
 
+-- * 24ET
+
+{- | The 24ET pitch-class universe, with /sharp/ spellings, in octave '4'.
+
+> length pc24et_univ == 24
+
+> let r = "C C𝄲 C♯ C𝄰 D D𝄲 D♯ D𝄰 E E𝄲 F F𝄲 F♯ F𝄰 G G𝄲 G♯ G𝄰 A A𝄲 A♯ A𝄰 B B𝄲"
+> unwords (map pitch_class_pp pc24et_univ) == r
+
+-}
+pc24et_univ :: [Pitch]
+pc24et_univ =
+    let a = [T.Natural,T.QuarterToneSharp,T.Sharp,T.ThreeQuarterToneSharp]
+        f (n,k) = map (\i -> Pitch n (a !! i) 4) [0 .. k - 1]
+    in concatMap f (zip T.note_seq [4,4,2,4,4,4,2])
+
+-- | 'genericIndex' into 'pc24et_univ'.
+--
+-- > pitch_class_pp (pc24et_to_pitch 13) == "F𝄰"
+pc24et_to_pitch :: Integral i => i -> Pitch
+pc24et_to_pitch = genericIndex pc24et_univ
+
+-- * Pitch, rational alteration.
+
+-- | Generalised pitch, given by a generalised alteration.
+data Pitch_R = Pitch_R T.Note T.Alteration_R Octave
+               deriving (Eq,Show)
+
+-- | Pretty printer for 'Pitch_R'.
+pitch_r_pp :: Pitch_R -> String
+pitch_r_pp (Pitch_R n (_,a) o) = show n ++ a ++ show o
+
+-- | 'Pitch_R' printed without octave.
+pitch_r_class_pp :: Pitch_R -> String
+pitch_r_class_pp = T.dropWhileRight isDigit . pitch_r_pp
+
 -- * Parsers
 
+-- | Parser for single digit ISO octave (C4 = middle-C)
+p_octave_iso :: T.P Octave
+p_octave_iso = fmap digitToInt P.digit
+
+-- | Parser for single digit ISO octave with default value in case of no parse.
+p_octave_iso_opt :: Octave -> T.P Octave
+p_octave_iso_opt def_o = do
+  o <- P.optionMaybe p_octave_iso
+  return (fromMaybe def_o o)
+
+-- | Parser for ISO pitch notation.
+p_iso_pitch_strict :: T.P Pitch
+p_iso_pitch_strict = do
+  n <- T.p_note_t
+  a <- T.p_alteration_t_iso True
+  o <- p_octave_iso
+  return (Pitch  n a o)
+
+-- | Parser for extended form of ISO pitch notation.
+p_iso_pitch_oct :: Octave -> T.P Pitch
+p_iso_pitch_oct def_o = do
+  n <- T.p_note_t_ci -- ISO is requires upper case note names
+  a <- T.p_alteration_t_iso False -- ISO does not allow ##
+  o <- p_octave_iso_opt def_o -- ISO requires octave
+  return (Pitch  n a o)
+
 -- | Parse possible octave from single integer.
 --
--- > map (parse_octave 2) ["","4","x","11"]
-parse_octave :: Num a => a -> String -> Maybe a
-parse_octave def_o o =
-    case o of
-      [] -> Just def_o
-      [n] -> if isDigit n
-             then Just (fromIntegral (digitToInt n))
-             else Nothing
-      _ -> Nothing
+-- > map (parse_octave 2) ["","4","x","11"] == [2,4,2,1]x
+parse_octave :: Octave -> String -> Octave
+parse_octave def_o = T.run_parser_error (p_octave_iso_opt def_o)
 
--- | Slight generalisation of ISO pitch representation.  Allows octave
+-- | Generalisation of ISO pitch representation.  Allows octave
 -- to be elided, pitch names to be lower case, and double sharps
 -- written as @##@.
 --
 -- See <http://www.musiccog.ohio-state.edu/Humdrum/guide04.html>
 --
--- > let r = [Pitch C Natural 4,Pitch A Flat 5,Pitch F DoubleSharp 6]
--- > in mapMaybe (parse_iso_pitch_oct 4) ["C","Ab5","f##6",""] == r
+-- > let r = [Pitch T.C T.Natural 4,Pitch T.A T.Flat 5,Pitch T.F T.DoubleSharp 6]
+-- > mapMaybe (parse_iso_pitch_oct 4) ["C","Ab5","f##6",""] == r
 parse_iso_pitch_oct :: Octave -> String -> Maybe Pitch
-parse_iso_pitch_oct def_o s =
-    let mk n a o = case T.parse_note_t True n of
-                   Nothing -> Nothing
-                   Just n' -> fmap (Pitch n' a) (parse_octave def_o o)
-    in case s of
-         [] -> Nothing
-         n:'b':'b':o -> mk n T.DoubleFlat o
-         n:'#':'#':o -> mk n T.DoubleSharp o
-         n:'x':o -> mk n T.DoubleSharp o
-         n:'b':o -> mk n T.Flat o
-         n:'#':o -> mk n T.Sharp o
-         n:o -> mk n T.Natural o
+parse_iso_pitch_oct def_o = T.run_parser_maybe (p_iso_pitch_oct def_o)
 
 -- | Variant of 'parse_iso_pitch_oct' requiring octave.
 parse_iso_pitch :: String -> Maybe Pitch
@@ -590,11 +692,12 @@
 
 -- | Sequential list of /n/ pitch class names starting from /k/.
 --
--- > unwords (pitch_class_names_12et 0 12) == "C C♯ D E♭ E F F♯ G A♭ A B♭ B"
--- > pitch_class_names_12et 11 2 == ["B","C"]
+-- > import Music.Theory.Pitch.Spelling.Table
+-- > unwords (pitch_class_names_12et pc_spell_ks 0 12) == "C C♯ D E♭ E F F♯ G A♭ A B♭ B"
+-- > pitch_class_names_12et pc_spell_ks 11 2 == ["B","C"]
 pitch_class_names_12et :: Integral n => Spelling n -> n -> n -> [String]
 pitch_class_names_12et sp k n =
-    let f = pitch_class_pp . midi_to_pitch sp
+    let f = pitch_class_pp . midi_to_pitch sp . T.from_integral_to_int
     in map f [60 + k .. 60 + k + n - 1]
 
 -- | Pretty printer for 'Pitch' (ISO, ASCII, see 'alteration_iso').
@@ -605,6 +708,28 @@
 pitch_pp_iso :: Pitch -> String
 pitch_pp_iso (Pitch n a o) = show n ++ T.alteration_iso a ++ show o
 
+-- | Lilypond octave syntax.
+ly_octave_tbl :: [(Octave, String)]
+ly_octave_tbl =
+  [(-1,",,,,")
+  ,( 0,",,,")
+  ,( 1,",,")
+  ,( 2,",")
+  ,( 3,"")
+  ,( 4,"'")
+  ,( 5,"''")
+  ,( 6,"'''")
+  ,( 7,"''''")
+  ,( 8,"'''''")]
+
+-- | Lookup 'ly_octave_tbl'.
+octave_pp_ly :: Octave -> String
+octave_pp_ly o = T.lookup_err o ly_octave_tbl
+
+-- | Parse lilypond octave indicator.
+octave_parse_ly :: String -> Maybe Octave
+octave_parse_ly s = T.reverse_lookup s ly_octave_tbl
+
 -- | Pretty printer for 'Pitch' (ASCII, see 'alteration_tonh').
 --
 -- > pitch_pp_hly (Pitch E Flat 4) == "ees4"
@@ -631,39 +756,34 @@
          (T.E,T.Flat) -> "Es" ++ o'
          _ -> show n ++ T.alteration_tonh a ++ o'
 
--- * 24ET
-
-{-  The 24ET pitch-class universe, with /sharp/ spellings, in octave '4'.
-
-> length pc24et_univ == 24
+-- * Parsers
 
-> let r = "C C𝄲 C♯ C𝄰 D D𝄲 D♯ D𝄰 E E𝄲 F F𝄲 F♯ F𝄰 G G𝄲 G♯ G𝄰 A A𝄲 A♯ A𝄰 B B𝄲"
-> in unwords (map pitch_class_pp pc24et_univ) == r
+p_octave_ly :: T.P Octave
+p_octave_ly =
+    fmap
+    (fromMaybe (error "p_octave_ly") . octave_parse_ly)
+    (P.many1 (P.oneOf ",'"))
 
--}
-pc24et_univ :: [Pitch]
-pc24et_univ =
-    let a = [T.Natural,T.QuarterToneSharp,T.Sharp,T.ThreeQuarterToneSharp]
-        f (n,k) = map (\i -> Pitch n (a !! i) 4) [0 .. k - 1]
-    in concatMap f (zip T.note_seq [4,4,2,4,4,4,2])
+p_pitch_ly :: T.P Pitch
+p_pitch_ly = do
+  (n,a) <- T.p_note_alteration_ly
+  o <- P.optionMaybe p_octave_ly
+  return (Pitch n (fromMaybe T.Natural a) (fromMaybe 3 o))
 
--- | 'genericIndex' into 'pc24et_univ'.
+-- | Run 'p_pitch_ly'.
 --
--- > pitch_class_pp (pc24et_to_pitch 13) == "F𝄰"
-pc24et_to_pitch :: Integral i => i -> Pitch
-pc24et_to_pitch = genericIndex pc24et_univ
-
--- * Pitch, rational alteration.
-
--- | Generalised pitch, given by a generalised alteration.
-data Pitch_R = Pitch_R T.Note_T T.Alteration_R Octave
-               deriving (Eq,Show)
-
--- | Pretty printer for 'Pitch_R'.
-pitch_r_pp :: Pitch_R -> String
-pitch_r_pp (Pitch_R n (_,a) o) = show n ++ a ++ show o
+-- > map (pitch_pp . pitch_parse_ly_err) ["c","d'","ees,","fisis''"] == ["C3","D4","E♭2","F𝄪5"]
+pitch_parse_ly_err :: String -> Pitch
+pitch_parse_ly_err = T.run_parser_error p_pitch_ly
 
--- | 'Pitch_R' printed without octave.
-pitch_r_class_pp :: Pitch_R -> String
-pitch_r_class_pp = T.dropWhileRight isDigit . pitch_r_pp
+-- | Parser for hly notation.
+p_pitch_hly :: T.P Pitch
+p_pitch_hly = do
+  (n,a) <- T.p_note_alteration_ly
+  fmap (Pitch n (fromMaybe T.Natural a)) p_octave_iso
 
+-- | Run 'p_pitch_hly'.
+--
+-- > map (pitch_pp . pitch_parse_hly) ["ees4","fih3","b6"] == ["E♭4","F𝄲3","B6"]
+pitch_parse_hly :: String -> Pitch
+pitch_parse_hly = T.run_parser_error p_pitch_hly
diff --git a/Music/Theory/Pitch/Bark.hs b/Music/Theory/Pitch/Bark.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Pitch/Bark.hs
@@ -0,0 +1,69 @@
+-- | Zwicker, E. (1961) "Subdivision of the audible frequency range into critical bands"
+--   The Journal of the Acoustical Society of America, Volume 33, Issue 2, p. 248 (1961)
+--
+-- <https://ccrma.stanford.edu/courses/120-fall-2003/lecture-5.html>
+module Music.Theory.Pitch.Bark where
+
+-- * TABLES
+
+-- | Center freqencies of Bark scale critical bands (hz).
+bark_center :: Num n => [n]
+bark_center =
+  [50,150,250,350,450,570,700,840,1000,1170
+  ,1370,1600,1850,2150,2500,2900,3400,4000,4800,5800
+  ,7000,8500,10500,13500]
+
+-- | Edge freqencies of Bark scale critical bands (hz).
+bark_edge :: Num n => [n]
+bark_edge =
+  [0,100,200,300,400,510,630,770,920,1080,1270
+  ,1480,1720,2000,2320,2700,3150,3700,4400,5300,6400
+  ,7700,9500,12000,15500]
+
+-- | Bandwidths of Bark scale critical bands (hz).
+bark_bandwidth :: Num n => [n]
+bark_bandwidth = let c = bark_edge in zipWith (-) (tail c) c
+
+-- * FUNCTIONS
+
+-- | Zwicker & Terhardt (1980)
+--
+-- > map (round . cps_to_bark_zwicker) bark_centre == concat [[0..7],[9..15],[15..19],[21..24]]
+-- > let f = [0,100 .. 8000] in Sound.SC3.Plot.plot_p2_ln [zip f (map cps_to_bark_zwicker f)]
+cps_to_bark_zwicker :: Floating a => a -> a
+cps_to_bark_zwicker x = 13 * atan (0.00076 * x) + 3.5 * atan ((x / 7500) ** 2)
+
+-- | Traunmüller, Hartmut.
+--   "Analytical Expressions for the Tonotopic Sensory Scale."
+--   Journal of the Acoustical Society of America. Vol. 88, Issue 1, 1990, pp. 97-100.
+--
+-- > r = concat [[0,1],[3,4],[4],[6..9],[9,10],[12],[12..17],[19,20],[20..23]]
+-- > map (round . cps_to_bark_traunmuller) bark_centre == r
+-- > let f = [0,100 .. 8000] in Sound.SC3.Plot.plot_p2_ln [zip f (map cps_to_bark_traunmuller f)]
+cps_to_bark_traunmuller :: (Fractional n,Ord n) => n -> n
+cps_to_bark_traunmuller x =
+  let y = ((26.81 * x) / (1960 + x)) - 0.53
+  in if y < 2 then y + 0.15 * (2 - y) else if y > 20.1 then y + 0.22 * (y - 20.1) else y
+
+-- | Traunmüller (1990)
+--
+-- > Sound.SC3.Plot.plot_p2_ln [zip (map bark_to_cps_traunmuller [0..23]) [0..23]]
+bark_to_cps_traunmuller :: (Fractional n,Ord n) => n -> n
+bark_to_cps_traunmuller y =
+  let f x = 1960 * ((x + 0.53) / (26.28 - x))
+  in if y < 2 then f ((y - 0.3) / 0.85) else if y > 20.1 then f ((y + 4.422) / 1.22) else f y
+
+-- | Wang, Sekey & Gersho (1992)
+--
+-- > map (round . cps_to_bark_wsg) bark_centre == concat [[0..9],[9..21],[23]]
+-- > let f = [0,100 .. 8000] in Sound.SC3.Plot.plot_p2_ln [zip f (map cps_to_bark_wsg f)]
+cps_to_bark_wsg :: Floating a => a -> a
+cps_to_bark_wsg x = 6 * asinh (x / 600)
+
+-- | Wang, Sekey & Gersho (1992)
+--
+-- > r = [100,204,313,430,560,705,870,1059,1278,1532,1828,2176,2584,3065,3630,4297,5083,6011,7106,8399]
+-- > map (round . bark_to_cps_wsg) [1 .. 20] == r
+-- > Sound.SC3.Plot.plot_p2_ln [zip (map bark_to_cps_wsg [0..23]) [0..23]]
+bark_to_cps_wsg :: Floating a => a -> a
+bark_to_cps_wsg x = 600 * sinh (x / 6)
diff --git a/Music/Theory/Pitch/Chord.hs b/Music/Theory/Pitch/Chord.hs
--- a/Music/Theory/Pitch/Chord.hs
+++ b/Music/Theory/Pitch/Chord.hs
@@ -3,15 +3,16 @@
 import Data.List {- base -}
 import Data.Maybe {- base -}
 
-import qualified Text.ParserCombinators.Parsec as P {- parsec -}
+import qualified Text.Parsec as P {- parsec -}
 
 import qualified Music.Theory.Key as T {- hmt -}
 import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Parse as T {- hmt -}
 import qualified Music.Theory.Pitch.Note as T {- hmt -}
 
-type PC = (T.Note_T,T.Alteration_T)
+type Pc = (T.Note,T.Alteration)
 
-pc_pp :: (T.Note_T, T.Alteration_T) -> [Char]
+pc_pp :: Pc -> [Char]
 pc_pp (n,a) = T.note_pp n : T.alteration_iso a
 
 -- | D = dominant, M = major
@@ -61,25 +62,25 @@
 chord_type_pcset = snd . chord_type_dat
 
 -- (root,mode,extensions,bass)
-data Chord = CH PC Chord_Type (Maybe Extension) (Maybe PC)
+data Chord = Chord Pc Chord_Type (Maybe Extension) (Maybe Pc)
              deriving (Show)
 
 chord_pcset :: Chord -> (Maybe Int,[Int])
-chord_pcset (CH pc ty ex bs) =
+chord_pcset (Chord pc ty ex bs) =
     let get = m_error "chord_pcset" . T.note_alteration_to_pc
         pc' = get pc
         ty' = chord_type_pcset ty
         ex' = fmap extension_to_pc ex
         bs' = fmap get bs
         ch = map ((`mod` 12) . (+ pc')) (ty' ++ maybe [] return ex')
-        ch' = maybe ch (flip delete ch) bs'
+        ch' = maybe ch (`delete` ch) bs'
     in (bs',ch')
 
-bass_pp :: PC -> String
+bass_pp :: Pc -> String
 bass_pp = ('/' :) . pc_pp
 
 chord_pp :: Chord -> String
-chord_pp (CH pc ty ex bs) =
+chord_pp (Chord pc ty ex bs) =
     let (pre_ty,post_ty) = if is_suspended ty
                            then (Nothing,Just ty)
                            else (Just ty,Nothing)
@@ -89,33 +90,19 @@
               ,maybe "" chord_type_pp post_ty
               ,maybe "" bass_pp bs]
 
-type P a = P.GenParser Char () a
-
 m_error :: String -> Maybe a -> a
 m_error txt = fromMaybe (error txt)
 
-p_note_t :: P T.Note_T
-p_note_t =
-    fmap
-    (m_error "p_note_t" . T.parse_note_t False)
-    (P.oneOf "ABCDEFG")
-
-p_alteration_t_iso :: P T.Alteration_T
-p_alteration_t_iso =
-    fmap
-    (m_error "p_alteration_t_iso" . T.symbol_to_alteration_iso)
-    (P.oneOf "b#x")
-
-p_pc :: P PC
+p_pc :: T.P Pc
 p_pc = do
-  n <- p_note_t
-  a <- P.optionMaybe p_alteration_t_iso
+  n <- T.p_note_t
+  a <- P.optionMaybe (T.p_alteration_t_iso True)
   return (n,fromMaybe T.Natural a)
 
-p_mode_m :: P T.Mode_T
+p_mode_m :: T.P T.Mode
 p_mode_m = P.option T.Major_Mode (P.char 'm' >> return T.Minor_Mode)
 
-p_chord_type :: P Chord_Type
+p_chord_type :: T.P Chord_Type
 p_chord_type =
     let m = P.char 'm' >> return Minor
         au = P.char '+' >> return Augmented
@@ -126,16 +113,16 @@
         sus4 = P.try (P.string "sus4" >> return Suspended_4)
     in P.option Major (P.choice [dm7,dm,hdm,au,sus2,sus4,m])
 
-p_extension :: P Extension
+p_extension :: T.P Extension
 p_extension =
     let d7 = P.char '7' >> return D7
         m7 = P.try (P.string "M7" >> return M7)
     in P.choice [d7,m7]
 
-p_bass :: P (Maybe PC)
+p_bass :: T.P (Maybe Pc)
 p_bass = P.optionMaybe (P.char '/' >> p_pc)
 
-p_chord :: P Chord
+p_chord :: T.P Chord
 p_chord = do
   pc <- p_pc
   ty <- p_chord_type
@@ -147,8 +134,10 @@
                (Major,Suspended_4) -> Suspended_4
                (_,Major) -> ty -- ie. nothing
                _ -> error ("trailing type not sus2 or sus4: " ++ show ty')
-  return (CH pc ty'' ex b)
+  return (Chord pc ty'' ex b)
 
+-- | Parse chord.
+--
 -- > let ch = words "CmM7 C#o EbM7 Fo7 Gx/D C/E GØ/F Bbsus4/C E7sus2"
 -- > let c = map parse_chord ch
 -- > map chord_pp c == ch
diff --git a/Music/Theory/Pitch/Note.hs b/Music/Theory/Pitch/Note.hs
--- a/Music/Theory/Pitch/Note.hs
+++ b/Music/Theory/Pitch/Note.hs
@@ -4,62 +4,72 @@
 import Data.Char {- base -}
 import Data.Maybe {- base -}
 
+import qualified Text.Parsec as P {- parsec -}
+
 import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Parse as T {- hmt -}
 
--- * Note_T
+-- * Note
 
 -- | Enumeration of common music notation note names (@C@ to @B@).
-data Note_T = C | D | E | F | G | A | B
+data Note = C | D | E | F | G | A | B
               deriving (Eq,Enum,Bounded,Ord,Read,Show)
 
 -- | Note sequence as usually understood, ie. 'C' - 'B'.
-note_seq :: [Note_T]
+note_seq :: [Note]
 note_seq = [C .. B]
 
 -- | Char variant of 'show'.
-note_pp :: Note_T -> Char
+note_pp :: Note -> Char
 note_pp = head . show
 
--- | Table of 'Note_T' and corresponding pitch-classes.
-note_pc_tbl :: Num i => [(Note_T,i)]
+-- | Note name in lilypond syntax (ie. lower case).
+note_pp_ly :: Note -> String
+note_pp_ly = map toLower . show
+
+-- | Table of 'Note' and corresponding pitch-classes.
+note_pc_tbl :: Num i => [(Note,i)]
 note_pc_tbl = zip [C .. B] [0,2,4,5,7,9,11]
 
--- | Transform 'Note_T' to pitch-class number.
+-- | Transform 'Note' to pitch-class number.
 --
 -- > map note_to_pc [C,E,G] == [0,4,7]
-note_to_pc :: Num i => Note_T -> i
-note_to_pc n = fromMaybe (error "note_to_pc") (lookup n note_pc_tbl)
+note_to_pc :: Num i => Note -> i
+note_to_pc n = T.lookup_err_msg "note_to_pc" n note_pc_tbl
 
 -- | Inverse of 'note_to_pc'.
 --
 -- > mapMaybe pc_to_note [0,4,7] == [C,E,G]
-pc_to_note :: (Eq i,Num i) => i -> Maybe Note_T
+pc_to_note :: (Eq i,Num i) => i -> Maybe Note
 pc_to_note i = T.reverse_lookup i note_pc_tbl
 
--- | Modal transposition of 'Note_T' value.
+-- | Modal transposition of 'Note' value.
 --
 -- > note_t_transpose C 2 == E
-note_t_transpose :: Note_T -> Int -> Note_T
+note_t_transpose :: Note -> Int -> Note
 note_t_transpose x n =
     let x' = fromEnum x
-        n' = fromEnum (maxBound::Note_T) + 1
+        n' = fromEnum (maxBound::Note) + 1
     in toEnum ((x' + n) `mod` n')
 
 -- | Parser from 'Char', case insensitive flag.
 --
 -- > mapMaybe (parse_note True) "CDEFGab" == [C,D,E,F,G,A,B]
-parse_note_t :: Bool -> Char -> Maybe Note_T
+parse_note_t :: Bool -> Char -> Maybe Note
 parse_note_t ci c =
     let tbl = zip "CDEFGAB" [C,D,E,F,G,A,B]
     in lookup (if ci then toUpper c else c) tbl
 
--- | Inclusive set of 'Note_T' within indicated interval.  This is not
+char_to_note_t :: Bool -> Char -> Note
+char_to_note_t ci = fromMaybe (error "char_to_note_t") . parse_note_t ci
+
+-- | Inclusive set of 'Note' within indicated interval.  This is not
 -- equal to 'enumFromTo' which is not circular.
 --
 -- > note_span E B == [E,F,G,A,B]
 -- > note_span B D == [B,C,D]
 -- > enumFromTo B D == []
-note_span :: Note_T -> Note_T -> [Note_T]
+note_span :: Note -> Note -> [Note]
 note_span n1 n2 =
     let fn x = toEnum (x `mod` 7)
         n1' = fromEnum n1
@@ -70,7 +80,7 @@
 -- * Alteration
 
 -- | Enumeration of common music notation note alterations.
-data Alteration_T =
+data Alteration =
     DoubleFlat
   | ThreeQuarterToneFlat | Flat | QuarterToneFlat
   | Natural
@@ -79,7 +89,7 @@
     deriving (Eq,Enum,Bounded,Ord,Show)
 
 -- | Generic form.
-generic_alteration_to_diff :: Integral i => Alteration_T -> Maybe i
+generic_alteration_to_diff :: Integral i => Alteration -> Maybe i
 generic_alteration_to_diff a =
     case a of
       DoubleFlat -> Just (-2)
@@ -89,30 +99,30 @@
       DoubleSharp -> Just 2
       _ -> Nothing
 
--- | Transform 'Alteration_T' to semitone alteration.  Returns
+-- | Transform 'Alteration' to semitone alteration.  Returns
 -- 'Nothing' for non-semitone alterations.
 --
 -- > map alteration_to_diff [Flat,QuarterToneSharp] == [Just (-1),Nothing]
-alteration_to_diff :: Alteration_T -> Maybe Int
+alteration_to_diff :: Alteration -> Maybe Int
 alteration_to_diff = generic_alteration_to_diff
 
--- | Is 'Alteration_T' 12-ET.
-alteration_is_12et :: Alteration_T -> Bool
+-- | Is 'Alteration' 12-ET.
+alteration_is_12et :: Alteration -> Bool
 alteration_is_12et = isJust . alteration_to_diff
 
--- | Transform 'Alteration_T' to semitone alteration.
+-- | Transform 'Alteration' to semitone alteration.
 --
 -- > map alteration_to_diff_err [Flat,Sharp] == [-1,1]
-alteration_to_diff_err :: Integral i => Alteration_T -> i
+alteration_to_diff_err :: Integral i => Alteration -> i
 alteration_to_diff_err =
     let err = error "alteration_to_diff: quarter tone"
     in fromMaybe err . generic_alteration_to_diff
 
--- | Transform 'Alteration_T' to fractional semitone alteration,
+-- | Transform 'Alteration' to fractional semitone alteration,
 -- ie. allow quarter tones.
 --
 -- > alteration_to_fdiff QuarterToneSharp == 0.5
-alteration_to_fdiff :: Fractional n => Alteration_T -> n
+alteration_to_fdiff :: Fractional n => Alteration -> n
 alteration_to_fdiff a =
     case a of
       ThreeQuarterToneFlat -> -1.5
@@ -121,12 +131,12 @@
       ThreeQuarterToneSharp -> 1.5
       _ -> fromInteger (alteration_to_diff_err a)
 
--- | Transform fractional semitone alteration to 'Alteration_T',
+-- | Transform fractional semitone alteration to 'Alteration',
 -- ie. allow quarter tones.
 --
 -- > map fdiff_to_alteration [-0.5,0.5] == [Just QuarterToneFlat
 -- >                                       ,Just QuarterToneSharp]
-fdiff_to_alteration :: (Fractional n,Eq n) => n -> Maybe Alteration_T
+fdiff_to_alteration :: (Fractional n,Eq n) => n -> Maybe Alteration
 fdiff_to_alteration d =
     case d of
       -2 -> Just DoubleFlat
@@ -140,29 +150,29 @@
       2 -> Just DoubleSharp
       _ -> undefined
 
--- | Raise 'Alteration_T' by a quarter tone where possible.
+-- | Raise 'Alteration' by a quarter tone where possible.
 --
 -- > alteration_raise_quarter_tone Flat == Just QuarterToneFlat
 -- > alteration_raise_quarter_tone DoubleSharp == Nothing
-alteration_raise_quarter_tone :: Alteration_T -> Maybe Alteration_T
+alteration_raise_quarter_tone :: Alteration -> Maybe Alteration
 alteration_raise_quarter_tone a =
     if a == maxBound then Nothing else Just (toEnum (fromEnum a + 1))
 
--- | Lower 'Alteration_T' by a quarter tone where possible.
+-- | Lower 'Alteration' by a quarter tone where possible.
 --
 -- > alteration_lower_quarter_tone Sharp == Just QuarterToneSharp
 -- > alteration_lower_quarter_tone DoubleFlat == Nothing
-alteration_lower_quarter_tone :: Alteration_T -> Maybe Alteration_T
+alteration_lower_quarter_tone :: Alteration -> Maybe Alteration
 alteration_lower_quarter_tone a =
     if a == minBound then Nothing else Just (toEnum (fromEnum a - 1))
 
--- | Edit 'Alteration_T' by a quarter tone where possible, @-0.5@
+-- | Edit 'Alteration' by a quarter tone where possible, @-0.5@
 -- lowers, @0@ retains, @0.5@ raises.
 --
 -- > import Data.Ratio
 -- > alteration_edit_quarter_tone (-1 % 2) Flat == Just ThreeQuarterToneFlat
 alteration_edit_quarter_tone :: (Fractional n,Eq n) =>
-                                n -> Alteration_T -> Maybe Alteration_T
+                                n -> Alteration -> Maybe Alteration
 alteration_edit_quarter_tone n a =
     case n of
       -0.5 -> alteration_lower_quarter_tone a
@@ -170,10 +180,10 @@
       0.5 -> alteration_raise_quarter_tone a
       _ -> Nothing
 
--- | Simplify 'Alteration_T' to standard 12ET by deleting quarter tones.
+-- | Simplify 'Alteration' to standard 12ET by deleting quarter tones.
 --
 -- > Data.List.nub (map alteration_clear_quarter_tone [minBound..maxBound])
-alteration_clear_quarter_tone :: Alteration_T -> Alteration_T
+alteration_clear_quarter_tone :: Alteration -> Alteration
 alteration_clear_quarter_tone x =
     case x of
       ThreeQuarterToneFlat -> Flat
@@ -182,7 +192,8 @@
       ThreeQuarterToneSharp -> Sharp
       _ -> x
 
-alteration_symbol_tbl :: [(Alteration_T,Char)]
+-- | Table of Unicode characters for alterations.
+alteration_symbol_tbl :: [(Alteration,Char)]
 alteration_symbol_tbl =
     [(DoubleFlat,'𝄫')
     ,(ThreeQuarterToneFlat,'𝄭')
@@ -200,26 +211,43 @@
 -- UP@.
 --
 -- > map alteration_symbol [minBound .. maxBound] == "𝄫𝄭♭𝄳♮𝄲♯𝄰𝄪"
-alteration_symbol :: Alteration_T -> Char
+alteration_symbol :: Alteration -> Char
 alteration_symbol a = fromMaybe (error "alteration_symbol") (lookup a alteration_symbol_tbl)
 
 -- | Inverse of 'alteration_symbol'.
 --
 -- > mapMaybe symbol_to_alteration "♭♮♯" == [Flat,Natural,Sharp]
-symbol_to_alteration :: Char -> Maybe Alteration_T
+symbol_to_alteration :: Char -> Maybe Alteration
 symbol_to_alteration c = T.reverse_lookup c alteration_symbol_tbl
 
--- | Variant of 'symbol_to_alteration' that /also/ recognises @b@ for 'Flat'
--- and @#@ for 'Sharp' and 'x' for double sharp.
-symbol_to_alteration_iso :: Char -> Maybe Alteration_T
-symbol_to_alteration_iso c =
+-- | ISO alteration notation.  When not strict extended to allow ## for x.
+symbol_to_alteration_iso :: Bool -> String -> Maybe Alteration
+symbol_to_alteration_iso strict txt =
+    case txt of
+      "bb" -> Just DoubleFlat
+      "b" -> Just Flat
+      "#" -> Just Sharp
+      "##" -> if strict then Nothing else Just DoubleSharp
+      "x" -> Just DoubleSharp
+      "" -> Just Natural
+      _ -> Nothing
+
+symbol_to_alteration_iso_err :: Bool -> String -> Alteration
+symbol_to_alteration_iso_err strict =
+  fromMaybe (error "symbol_to_alteration_iso") .
+  symbol_to_alteration_iso strict
+
+-- | 'symbol_to_alteration' extended to allow single character ISO notations.
+symbol_to_alteration_unicode_plus_iso :: Char -> Maybe Alteration
+symbol_to_alteration_unicode_plus_iso c =
     case c of
       'b' -> Just Flat
       '#' -> Just Sharp
       'x' -> Just DoubleSharp
       _ -> symbol_to_alteration c
 
-alteration_iso_tbl :: [(Alteration_T,String)]
+-- | ISO alteration table, strings not characters because of double flat.
+alteration_iso_tbl :: [(Alteration,String)]
 alteration_iso_tbl =
     [(DoubleFlat,"bb")
     ,(Flat,"b")
@@ -232,57 +260,72 @@
 --
 -- > mapMaybe alteration_iso_m [Flat .. Sharp] == ["b","","#"]
 -- > mapMaybe alteration_iso_m [DoubleFlat,DoubleSharp] == ["bb","x"]
-alteration_iso_m :: Alteration_T -> Maybe String
+alteration_iso_m :: Alteration -> Maybe String
 alteration_iso_m a = lookup a alteration_iso_tbl
 
 -- | The @ISO@ ASCII spellings for alterations.
-alteration_iso :: Alteration_T -> String
+alteration_iso :: Alteration -> String
 alteration_iso =
     let qt = error "alteration_iso: quarter tone"
     in fromMaybe qt . alteration_iso_m
 
 -- | The /Tonhöhe/ ASCII spellings for alterations.
+alteration_tonh_tbl :: [(Alteration, String)]
+alteration_tonh_tbl =
+  [(DoubleFlat,"eses")
+  ,(ThreeQuarterToneFlat,"eseh")
+  ,(Flat,"es")
+  ,(QuarterToneFlat,"eh")
+  ,(Natural,"")
+  ,(QuarterToneSharp,"ih")
+  ,(Sharp,"is")
+  ,(ThreeQuarterToneSharp,"isih")
+  ,(DoubleSharp,"isis")]
+
+-- | The /Tonhöhe/ ASCII spellings for alterations.
 --
 -- See <http://www.musiccog.ohio-state.edu/Humdrum/guide04.html> and
 -- <http://lilypond.org/doc/v2.16/Documentation/notation/writing-pitches>
 --
 -- > map alteration_tonh [Flat .. Sharp] == ["es","eh","","ih","is"]
-alteration_tonh :: Alteration_T -> String
-alteration_tonh a =
-    case a of
-      DoubleFlat -> "eses"
-      ThreeQuarterToneFlat -> "eseh"
-      Flat -> "es"
-      QuarterToneFlat -> "eh"
-      Natural -> ""
-      QuarterToneSharp -> "ih"
-      Sharp -> "is"
-      ThreeQuarterToneSharp -> "isih"
-      DoubleSharp -> "isis"
+alteration_tonh :: Alteration -> String
+alteration_tonh a = T.lookup_err a alteration_tonh_tbl
 
+-- | Inverse of 'alteration_tonh'.
+--
+-- > mapMaybe tonh_to_alteration ["es","eh","","ih","is"] == [Flat .. Sharp]
+tonh_to_alteration :: String -> Maybe Alteration
+tonh_to_alteration s = T.reverse_lookup s alteration_tonh_tbl
+
+tonh_to_alteration_err :: String -> Alteration
+tonh_to_alteration_err = fromMaybe (error "tonh_to_alteration") . tonh_to_alteration
+
 -- * 12-ET
 
-note_alteration_to_pc :: (Note_T,Alteration_T) -> Maybe Int
+-- | Note and alteration to pitch-class, or not.
+note_alteration_to_pc :: (Note,Alteration) -> Maybe Int
 note_alteration_to_pc (n,a) =
     let n_pc = note_to_pc n
     in fmap ((`mod` 12) . (+ n_pc)) (alteration_to_diff a)
 
+-- | Error variant.
+--
 -- > map note_alteration_to_pc_err [(A,DoubleSharp),(B,Sharp),(C,Flat),(C,DoubleFlat)]
-note_alteration_to_pc_err :: (Note_T, Alteration_T) -> Int
+note_alteration_to_pc_err :: (Note, Alteration) -> Int
 note_alteration_to_pc_err = fromMaybe (error "note_alteration_to_pc") . note_alteration_to_pc
 
 -- | Note & alteration sequence in key-signature spelling.
-note_alteration_ks :: [(Note_T, Alteration_T)]
+note_alteration_ks :: [(Note, Alteration)]
 note_alteration_ks =
     [(C,Natural),(C,Sharp),(D,Natural),(E,Flat),(E,Natural),(F,Natural)
     ,(F,Sharp),(G,Natural),(A,Flat),(A,Natural),(B,Flat),(B,Natural)]
 
 -- | Table connecting pitch class number with 'note_alteration_ks'.
-pc_note_alteration_ks_tbl :: Integral i => [((Note_T,Alteration_T),i)]
+pc_note_alteration_ks_tbl :: Integral i => [((Note,Alteration),i)]
 pc_note_alteration_ks_tbl = zip note_alteration_ks [0..11]
 
 -- | 'T.reverse_lookup' of 'pc_note_alteration_ks_tbl'.
-pc_to_note_alteration_ks :: Integral i => i -> Maybe (Note_T,Alteration_T)
+pc_to_note_alteration_ks :: Integral i => i -> Maybe (Note,Alteration)
 pc_to_note_alteration_ks i = T.reverse_lookup i pc_note_alteration_ks_tbl
 
 -- * Rational Alteration
@@ -291,9 +334,42 @@
 -- and a string representation of the alteration.
 type Alteration_R = (Rational,String)
 
--- | Transform 'Alteration_T' to 'Alteration_R'.
+-- | Transform 'Alteration' to 'Alteration_R'.
 --
 -- > let r = [(-1,"♭"),(0,"♮"),(1,"♯")]
--- > in map alteration_t' [Flat,Natural,Sharp] == r
-alteration_r :: Alteration_T -> Alteration_R
+-- > map alteration_r [Flat,Natural,Sharp] == r
+alteration_r :: Alteration -> Alteration_R
 alteration_r a = (alteration_to_fdiff a,[alteration_symbol a])
+
+-- * Parsers
+
+-- | Parser for ISO note name, upper case.
+--
+-- > map (T.run_parser_error p_note_t . return) "ABCDEFG"
+p_note_t :: T.P Note
+p_note_t = fmap (char_to_note_t False) (P.oneOf "ABCDEFG")
+
+-- | Note name in lower case (not ISO)
+p_note_t_lc :: T.P Note
+p_note_t_lc = fmap (char_to_note_t True) (P.oneOf "abcdefg")
+
+-- | Case-insensitive note name (not ISO).
+p_note_t_ci :: T.P Note
+p_note_t_ci = fmap (char_to_note_t True) (P.oneOf "abcdefgABCDEFG")
+
+-- | Parser for ISO alteration name.
+--
+-- > map (T.run_parser_error p_alteration_t_iso) (words "bb b # x ##")
+p_alteration_t_iso :: Bool -> T.P Alteration
+p_alteration_t_iso strict = fmap (symbol_to_alteration_iso_err strict) (P.many (P.oneOf "b#x"))
+
+-- > map (T.run_parser_error p_alteration_t_tonh) ["eses","es","is","isis"]
+p_alteration_t_tonh :: T.P Alteration
+p_alteration_t_tonh = fmap tonh_to_alteration_err (P.many1 (P.oneOf "ehis"))
+
+-- > map (T.run_parser_error p_note_alteration_ly) ["c","ees","fis","aeses"]
+p_note_alteration_ly :: T.P (Note,Maybe Alteration)
+p_note_alteration_ly = do
+  n <- p_note_t_lc
+  a <- P.optionMaybe p_alteration_t_tonh
+  return (n,a)
diff --git a/Music/Theory/Pitch/Note/Name.hs b/Music/Theory/Pitch/Note/Name.hs
--- a/Music/Theory/Pitch/Note/Name.hs
+++ b/Music/Theory/Pitch/Note/Name.hs
@@ -6,7 +6,7 @@
 
 import Music.Theory.Pitch.Note
 
-ceses,deses,eeses,feses,geses,aeses,beses :: (Note_T,Alteration_T)
+ceses,deses,eeses,feses,geses,aeses,beses :: (Note,Alteration)
 ceses = (C,DoubleFlat)
 deses = (D,DoubleFlat)
 eeses = (E,DoubleFlat)
@@ -15,7 +15,7 @@
 aeses = (A,DoubleFlat)
 beses = (B,DoubleFlat)
 
-ceseh,deseh,eeseh,feseh,geseh,aeseh,beseh :: (Note_T,Alteration_T)
+ceseh,deseh,eeseh,feseh,geseh,aeseh,beseh :: (Note,Alteration)
 ceseh = (C,ThreeQuarterToneFlat)
 deseh = (D,ThreeQuarterToneFlat)
 eeseh = (E,ThreeQuarterToneFlat)
@@ -24,7 +24,7 @@
 aeseh = (A,ThreeQuarterToneFlat)
 beseh = (B,ThreeQuarterToneFlat)
 
-ces,des,ees,fes,ges,aes,bes :: (Note_T,Alteration_T)
+ces,des,ees,fes,ges,aes,bes :: (Note,Alteration)
 ces = (C,Flat)
 des = (D,Flat)
 ees = (E,Flat)
@@ -33,7 +33,7 @@
 aes = (A,Flat)
 bes = (B,Flat)
 
-ceh,deh,eeh,feh,geh,aeh,beh :: (Note_T,Alteration_T)
+ceh,deh,eeh,feh,geh,aeh,beh :: (Note,Alteration)
 ceh = (C,QuarterToneFlat)
 deh = (D,QuarterToneFlat)
 eeh = (E,QuarterToneFlat)
@@ -42,7 +42,7 @@
 aeh = (A,QuarterToneFlat)
 beh = (B,QuarterToneFlat)
 
-c,d,e,f,g,a,b :: (Note_T,Alteration_T)
+c,d,e,f,g,a,b :: (Note,Alteration)
 c = (C,Natural)
 d = (D,Natural)
 e = (E,Natural)
@@ -51,7 +51,7 @@
 a = (A,Natural)
 b = (B,Natural)
 
-cih,dih,eih,fih,gih,aih,bih :: (Note_T,Alteration_T)
+cih,dih,eih,fih,gih,aih,bih :: (Note,Alteration)
 cih = (C,QuarterToneSharp)
 dih = (D,QuarterToneSharp)
 eih = (E,QuarterToneSharp)
@@ -60,7 +60,7 @@
 aih = (A,QuarterToneSharp)
 bih = (B,QuarterToneSharp)
 
-cis,dis,eis,fis,gis,ais,bis :: (Note_T,Alteration_T)
+cis,dis,eis,fis,gis,ais,bis :: (Note,Alteration)
 cis = (C,Sharp)
 dis = (D,Sharp)
 eis = (E,Sharp)
@@ -69,7 +69,7 @@
 ais = (A,Sharp)
 bis = (B,Sharp)
 
-cisih,disih,eisih,fisih,gisih,aisih,bisih :: (Note_T,Alteration_T)
+cisih,disih,eisih,fisih,gisih,aisih,bisih :: (Note,Alteration)
 cisih = (C,ThreeQuarterToneSharp)
 disih = (D,ThreeQuarterToneSharp)
 eisih = (E,ThreeQuarterToneSharp)
@@ -78,7 +78,7 @@
 aisih = (A,ThreeQuarterToneSharp)
 bisih = (B,ThreeQuarterToneSharp)
 
-cisis,disis,eisis,fisis,gisis,aisis,bisis :: (Note_T,Alteration_T)
+cisis,disis,eisis,fisis,gisis,aisis,bisis :: (Note,Alteration)
 cisis = (C,DoubleSharp)
 disis = (D,DoubleSharp)
 eisis = (E,DoubleSharp)
diff --git a/Music/Theory/Pitch/Spelling.hs b/Music/Theory/Pitch/Spelling.hs
--- a/Music/Theory/Pitch/Spelling.hs
+++ b/Music/Theory/Pitch/Spelling.hs
@@ -6,7 +6,7 @@
 import qualified Music.Theory.Pitch.Spelling.Key as T {- hmt -}
 import qualified Music.Theory.Pitch.Spelling.Table as T {- hmt -}
 
-spell_octpc_set :: [T.OctPC] -> [T.Pitch]
+spell_octpc_set :: [T.OctPc] -> [T.Pitch]
 spell_octpc_set o =
   case T.octpc_spell_implied_key o of
     Just r -> r
@@ -15,5 +15,5 @@
         Just r -> r
         Nothing -> map T.octpc_to_pitch_ks o
 
-spell_midi_set :: [T.Midi] -> [T.Pitch]
-spell_midi_set = spell_octpc_set . map T.midi_to_octpc
+spell_midi_set :: Integral i => [i] -> [T.Pitch]
+spell_midi_set = spell_octpc_set . map T.midi_to_octave_pitchclass
diff --git a/Music/Theory/Pitch/Spelling/Cluster.hs b/Music/Theory/Pitch/Spelling/Cluster.hs
--- a/Music/Theory/Pitch/Spelling/Cluster.hs
+++ b/Music/Theory/Pitch/Spelling/Cluster.hs
@@ -14,12 +14,12 @@
 cluster_normal_order :: [T.PitchClass] -> [T.PitchClass]
 cluster_normal_order =
     let with_bounds x = ((last x - head x) `mod` 12,x)
-    in snd . head . sort . map with_bounds . T.rotations
+    in snd . minimum . map with_bounds . T.rotations
 
 -- | Normal order starting in indicated octave.
 --
 -- > cluster_normal_order_octpc 3 [0,1,11] == [(3,11),(4,0),(4,1)]
-cluster_normal_order_octpc :: T.Octave -> [T.PitchClass] -> [T.OctPC]
+cluster_normal_order_octpc :: T.Octave -> [T.PitchClass] -> [T.OctPc]
 cluster_normal_order_octpc o pc =
     let pc_n = cluster_normal_order pc
         pc_0 = head pc_n
@@ -36,7 +36,7 @@
 --
 -- > let f (p,q) = (p == map T.note_alteration_to_pc_err q)
 -- > in all f spell_cluster_table
-spell_cluster_table :: [([T.PitchClass],[(T.Note_T,T.Alteration_T)])]
+spell_cluster_table :: [([T.PitchClass],[(T.Note,T.Alteration)])]
 spell_cluster_table =
     [([0,1,2,3],[bis,cis,d,ees])
     ,([0,1,2],[bis,cis,d])
@@ -130,13 +130,13 @@
     ,([9,10],[a,bes])
     ,([9],[a])]
 
-spell_cluster :: [T.PitchClass] -> Maybe [(T.Note_T,T.Alteration_T)]
+spell_cluster :: [T.PitchClass] -> Maybe [(T.Note,T.Alteration)]
 spell_cluster = flip lookup spell_cluster_table
 
--- | Spell an arbitrary sequence of 'T.OctPC' values.
+-- | Spell an arbitrary sequence of 'T.OctPc' values.
 --
 -- > fmap (map T.pitch_pp_iso) (spell_cluster_octpc [(3,11),(4,3),(4,11),(5,1)])
-spell_cluster_octpc :: [T.OctPC] -> Maybe [T.Pitch]
+spell_cluster_octpc :: [T.OctPc] -> Maybe [T.Pitch]
 spell_cluster_octpc o =
     let p = cluster_normal_order (sort (nub (map snd o)))
         na_f na =
@@ -150,7 +150,7 @@
 -- in octave @4@.
 --
 -- > let f = (fmap (map T.pitch_pp) . spell_cluster_c4)
--- > in map f [[11,0],[11]] == [Just ["B3","C4"],Just ["B4"]]
+-- > map f [[11,0],[11],[0,11]] == [Just ["B3","C4"],Just ["B4"],Nothing]
 --
 -- > fmap (map T.pitch_pp) (spell_cluster_c4 [10,11]) == Just ["A♯4","B4"]
 spell_cluster_c4 :: [T.PitchClass] -> Maybe [T.Pitch]
@@ -159,7 +159,7 @@
         oct = map fst (cluster_normal_order_octpc o_0 p)
     in case spell_cluster p of
          Nothing -> Nothing
-         Just na -> Just (map (\((n,alt),o) -> T.Pitch n alt o) (zip na oct))
+         Just na -> Just (zipWith (\(n,alt) o -> T.Pitch n alt o) na oct)
 
 -- | Variant of 'spell_cluster_c4' that runs 'pitch_edit_octave'.  An
 -- octave of @4@ is the identitiy, @3@ an octave below, @5@ an octave
@@ -177,17 +177,19 @@
 --
 -- > import Data.Maybe
 --
--- > let {f n = if n >= 11 then 3 else 4
--- >     ;g = map T.pitch_pp .fromJust . spell_cluster_f f
--- >     ;r = [["B3","C4"],["B3"],["C4"],["A♯4","B4"]]}
--- > in map g [[11,0],[11],[0],[10,11]] == r
+-- > let f n = if n >= 11 then 3 else 4
+-- > let g = map T.pitch_pp .fromJust . spell_cluster_f f
+-- > let r = [["B3","C4"],["B3"],["C4"],["A♯4","B4"]]
+-- > map g [[11,0],[11],[0],[10,11]] == r
+--
+-- > map (spell_cluster_f (const 4)) [[0,11],[11,0],[6,7],[7,6]]
 spell_cluster_f :: (T.PitchClass -> T.Octave) -> [T.PitchClass] -> Maybe [T.Pitch]
 spell_cluster_f o_f p =
     let fn r = case r of
                 [] -> []
                 l:_ -> let (o,n) = T.pitch_to_octpc l
                            oct_f = (+ (o_f n - o))
-                       in (map (T.pitch_edit_octave oct_f) r)
+                       in map (T.pitch_edit_octave oct_f) r
     in fmap fn (spell_cluster_c4 p)
 
 -- | Variant of 'spell_cluster_c4' that runs 'pitch_edit_octave' so
diff --git a/Music/Theory/Pitch/Spelling/Key.hs b/Music/Theory/Pitch/Spelling/Key.hs
--- a/Music/Theory/Pitch/Spelling/Key.hs
+++ b/Music/Theory/Pitch/Spelling/Key.hs
@@ -16,14 +16,14 @@
                      else Just T.pc_spell_sharp
 
 -- > map pcset_spell_implied_key [[0,1],[4,10],[3,9],[3,11]]
-pcset_spell_implied_key :: Integral i => [i] -> Maybe [(T.Note_T, T.Alteration_T)]
+pcset_spell_implied_key :: Integral i => [i] -> Maybe [(T.Note, T.Alteration)]
 pcset_spell_implied_key x =
     case pcset_spell_implied_key_f x of
       Just f -> Just (map f x)
       Nothing -> Nothing
 
 -- > map octpc_spell_implied_key [[(3,11),(4,1)],[(3,11),(4,10)]]
-octpc_spell_implied_key :: [T.OctPC] -> Maybe [T.Pitch]
+octpc_spell_implied_key :: [T.OctPc] -> Maybe [T.Pitch]
 octpc_spell_implied_key x =
     let f o (n,a) = T.Pitch n a o
     in fmap (zipWith f (map fst x)) (pcset_spell_implied_key (map snd x))
diff --git a/Music/Theory/Pitch/Spelling/Table.hs b/Music/Theory/Pitch/Spelling/Table.hs
--- a/Music/Theory/Pitch/Spelling/Table.hs
+++ b/Music/Theory/Pitch/Spelling/Table.hs
@@ -3,10 +3,10 @@
 
 import Data.Maybe {- base -}
 
-import Music.Theory.Pitch {- hmt -}
+import qualified Music.Theory.Pitch as T {- hmt -}
 import Music.Theory.Pitch.Note {- hmt -}
 
-type Spelling_Table i = [(i,(Note_T,Alteration_T))]
+type Spelling_Table i = [(i,(Note,Alteration))]
 
 -- | Spelling table for natural (♮) notes only.
 pc_spell_natural_tbl :: Integral i => Spelling_Table i
@@ -48,54 +48,58 @@
       ,(8,(A,Flat)) -- 3♭/3♯
       ,(10,(B,Flat))] -- 1♭
 
-pc_spell_tbl :: Integral i => Spelling_Table i -> Spelling i
+pc_spell_tbl :: Integral i => Spelling_Table i -> T.Spelling i
 pc_spell_tbl tbl = fromMaybe (error "pc_spell_tbl") . flip lookup tbl
 
 -- | Spell using indicated table prepended to and 'pc_spell_natural_tbl' and 'pc_spell_ks_tbl'
-pc_spell_tbl_ks :: Integral i => Spelling_Table i -> Spelling i
+pc_spell_tbl_ks :: Integral i => Spelling_Table i -> T.Spelling i
 pc_spell_tbl_ks tbl = pc_spell_tbl (tbl ++ pc_spell_natural_tbl ++ pc_spell_ks_tbl)
 
 -- | Spelling for natural (♮) notes only.
 --
 -- > map pc_spell_natural_m [0,1] == [Just (C,Natural),Nothing]
-pc_spell_natural_m :: Integral i => Spelling_M i
+pc_spell_natural_m :: Integral i => T.Spelling_M i
 pc_spell_natural_m = flip lookup pc_spell_natural_tbl
 
 -- | Erroring variant of 'pc_spell_natural_m'.
 --
 -- > map pc_spell_natural [0,5,7] == [(C,Natural),(F,Natural),(G,Natural)]
-pc_spell_natural :: Integral i => Spelling i
+pc_spell_natural :: Integral i => T.Spelling i
 pc_spell_natural = pc_spell_tbl pc_spell_natural_tbl
 
 -- | Lookup 'pc_spell_ks_tbl'.
 --
 -- > map pc_spell_ks [6,8] == [(F,Sharp),(A,Flat)]
-pc_spell_ks :: Integral i => Spelling i
+pc_spell_ks :: Integral i => T.Spelling i
 pc_spell_ks = pc_spell_tbl_ks []
 
 -- | Use always sharp (♯) spelling.
 --
 -- > map pc_spell_sharp [6,8] == [(F,Sharp),(G,Sharp)]
 -- > Data.List.nub (map (snd . pc_spell_sharp) [1,3,6,8,10]) == [Sharp]
-pc_spell_sharp :: Integral i => Spelling i
+pc_spell_sharp :: Integral i => T.Spelling i
 pc_spell_sharp = pc_spell_tbl (pc_spell_sharp_tbl ++ pc_spell_natural_tbl)
 
 -- | Use always flat (♭) spelling.
 --
 -- >  map pc_spell_flat [6,8] == [(G,Flat),(A,Flat)]
 -- >  Data.List.nub (map (snd . pc_spell_flat) [1,3,6,8,10]) == [Flat]
-pc_spell_flat :: Integral i => Spelling i
+pc_spell_flat :: Integral i => T.Spelling i
 pc_spell_flat = pc_spell_tbl (pc_spell_flat_tbl ++ pc_spell_natural_tbl)
 
-octpc_to_pitch_ks :: Integral i => Octave_PitchClass i -> Pitch
-octpc_to_pitch_ks = octpc_to_pitch pc_spell_ks
+octpc_to_pitch_ks :: Integral i => T.Octave_PitchClass i -> T.Pitch
+octpc_to_pitch_ks = T.octpc_to_pitch pc_spell_ks
 
--- | 'midi_to_pitch' 'T.pc_spell_ks'.
-midi_to_pitch_ks :: Integral i => i -> Pitch
-midi_to_pitch_ks = midi_to_pitch pc_spell_ks
+-- | 'T.midi_to_pitch' 'pc_spell_ks'.
+midi_to_pitch_ks :: Integral i => i -> T.Pitch
+midi_to_pitch_ks = T.midi_to_pitch (pc_spell_ks :: T.Spelling Int)
 
-fmidi_to_pitch_ks :: (Show n,RealFrac n) => n -> Pitch
-fmidi_to_pitch_ks = fmidi_to_pitch_err pc_spell_ks
+fmidi_to_pitch_ks :: (Show n,RealFrac n) => n -> T.Pitch
+fmidi_to_pitch_ks = T.fmidi_to_pitch_err pc_spell_ks
 
-midi_detune_to_pitch_ks :: Real c => Midi_Detune' c -> Pitch
-midi_detune_to_pitch_ks = midi_detune_to_pitch pc_spell_ks
+midi_detune_to_pitch_ks :: (Integral m,Real c) => (m,c) -> T.Pitch
+midi_detune_to_pitch_ks = T.midi_detune_to_pitch pc_spell_ks
+
+-- | 'T.midi_to_pitch' 'pc_spell_sharp'
+midi_to_pitch_sharp :: Integral i => i -> T.Pitch
+midi_to_pitch_sharp = T.midi_to_pitch (pc_spell_sharp :: T.Spelling Int)
diff --git a/Music/Theory/Random/I_Ching.hs b/Music/Theory/Random/I_Ching.hs
--- a/Music/Theory/Random/I_Ching.hs
+++ b/Music/Theory/Random/I_Ching.hs
@@ -1,14 +1,18 @@
-{-# Language BinaryLiterals #-}
-
+-- | YIJING / I-CHING
 module Music.Theory.Random.I_Ching where
 
 import Control.Monad {- base -}
 import Data.Maybe {- base -}
+import Data.Int {- base -}
 import System.Random {- random -}
 
-import qualified Music.Theory.Bits as T {- hmt -}
-import qualified Music.Theory.Tuple as T {- hmt -}
+import qualified Music.Theory.Bits as T {- hmt-base -}
+import qualified Music.Theory.Read as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
+import qualified Music.Theory.Unicode as T {- hmt-base -}
 
+-- * LINE
+
 -- | Line, indicated as sum.
 data Line = L6 | L7 | L8 | L9 deriving (Eq,Show)
 
@@ -19,23 +23,25 @@
 -}
 type Line_Stat = (Line,(Rational,Rational,String,String,String))
 
+-- | I-CHING chart as sequence of 4 'Line_Stat'.
 i_ching_chart :: [Line_Stat]
 i_ching_chart =
     [(L6,(1/16,2/16,"old yin","yin changing into yang","---x---"))
+    ,(L7,(5/16,6/16,"young yang","yang unchanging","-------"))
     ,(L8,(7/16,6/16,"young yin","yin unchanging","--- ---"))
-    ,(L9,(3/16,2/16,"old yang","yang changing into yin","---o---"))
-    ,(L7,(5/16,6/16,"young yang","yang unchanging","-------"))]
+    ,(L9,(3/16,2/16,"old yang","yang changing into yin","---o---"))]
 
 -- | Lines L6 and L7 are unbroken (since L6 is becoming L7).
 line_unbroken :: Line -> Bool
 line_unbroken n = n `elem` [L6,L7]
 
+-- | If /b/ then L7 else L8.
 line_from_bit :: Bool -> Line
 line_from_bit b = if b then L7 else L8
 
 -- | Seven character ASCII string for line.
 line_ascii_pp :: Line -> String
-line_ascii_pp n = fromMaybe (error "line_ascii_pp") (fmap T.p5_fifth (lookup n i_ching_chart))
+line_ascii_pp n = maybe (error "line_ascii_pp") T.p5_fifth (lookup n i_ching_chart)
 
 -- | Is line (ie. sum) moving (ie. 6 or 9).
 line_is_moving :: Line -> Bool
@@ -49,16 +55,11 @@
       L9 -> Just L8
       _ -> Nothing
 
-type Hexagram = [Line]
-
--- | Hexagrams are drawn upwards.
-hexagram_pp :: Hexagram -> String
-hexagram_pp = unlines . reverse . map line_ascii_pp
-
 {- | Sequence of sum values assigned to ascending four bit numbers.
+     Sequence is in ascending probablity, ie: 1×6,3×9,5×7,7×8.
 
-> import  Music.Theory.Bits {- hmt -}
-> zip (map (gen_bitseq_pp 4) [0::Int .. 15]) (map line_ascii_pp_err four_coin_sequence)
+> import Music.Theory.Bits {- hmt -}
+> zip (map (gen_bitseq_pp 4) [0::Int .. 15]) (map line_ascii_pp four_coin_sequence)
 
 -}
 four_coin_sequence :: [Line]
@@ -68,6 +69,15 @@
     ,L7,L8,L8,L8
     ,L8,L8,L8,L8]
 
+-- * HEXAGRAM
+
+-- | Sequence of 6 'Line'.
+type Hexagram = [Line]
+
+-- | Hexagrams are drawn upwards.
+hexagram_pp :: Hexagram -> String
+hexagram_pp = unlines . reverse . map line_ascii_pp
+
 -- | Generate hexagram (ie. sequence of six lines given by sum) using 'four_coin_sequence'.
 --
 -- > four_coin_gen_hexagram >>= putStrLn . hexagram_pp
@@ -88,7 +98,7 @@
     let f n = fromMaybe n (line_complement n)
     in if hexagram_has_complement h then Just (map f h) else Nothing
 
--- | Names of hexagrams, in King Wen order.
+-- | Names of hexagrams, in King Wen order (see also data/csv/combinatorics/yijing.csv)
 --
 -- > length hexagram_names == 64
 hexagram_names :: [(String,String)]
@@ -163,30 +173,47 @@
 -- > import Data.List.Split {- split -}
 -- > mapM_ putStrLn (chunksOf 8 hexagram_unicode_sequence)
 hexagram_unicode_sequence :: [Char]
-hexagram_unicode_sequence = map toEnum [0x4DC0 .. 0x4DFF]
+hexagram_unicode_sequence = map (toEnum . fst) T.yijing_tbl
 
-hexagram_to_binary :: Hexagram -> Int
+-- | Binary form of 'Hexagram'.
+hexagram_to_binary :: Hexagram -> Int8
 hexagram_to_binary = T.pack_bitseq . map line_unbroken
 
--- > let h = hexagram_from_binary 0b100010
--- > putStrLn (hexagram_pp h)
--- > gen_bitseq_pp 6 (hexagram_to_binary h) == "100010"
-hexagram_from_binary :: Int -> Hexagram
+-- | Show binary form.
+hexagram_to_binary_str :: Hexagram -> String
+hexagram_to_binary_str = T.gen_bitseq_pp 6 . hexagram_to_binary
+
+-- | Inverse of 'hexagram_to_binary'.
+hexagram_from_binary :: Int8 -> Hexagram
 hexagram_from_binary = map line_from_bit . T.gen_bitseq 6
 
+-- | Read binary form.
+--
+-- > let h = hexagram_from_binary_str "100010"
+-- > putStrLn (hexagram_pp h)
+-- > hexagram_to_binary_str h == "100010"
+hexagram_from_binary_str :: String -> Hexagram
+hexagram_from_binary_str = hexagram_from_binary . T.read_bin_err
+
+-- * TRIGRAM
+
+-- | Unicode sequence of trigrams (unicode order).
+--
 -- > import Data.List {- base -}
 -- > putStrLn (intersperse ' ' trigram_unicode_sequence)
 trigram_unicode_sequence :: [Char]
-trigram_unicode_sequence = map toEnum [0x2630 .. 0x2637]
+trigram_unicode_sequence = map (toEnum . fst) T.bagua_tbl
 
--- > map p8_third trigram_chart == [7,6,5,4,3,2,1,0]
-trigram_chart :: Num i => [(i, Char, i, Char, String, Char, String, Char)]
+-- | (INDEX,UNICODE,BIT-SEQUENCE,NAME,NAME-TRANSLITERATION,NATURE-IMAGE,DIRECTION,ANIMAL)
+--
+-- > map (T.read_bin_err . T.p8_third) trigram_chart == [7,6,5,4,3,2,1,0]
+trigram_chart :: [(Int, Char, String, Char, String, Char, String, Char)]
 trigram_chart =
-    [(1,'☰',0b111,'乾',"qián",'天',"NW",'馬')
-    ,(2,'☱',0b110,'兌',"duì",'澤',"W",'羊')
-    ,(3,'☲',0b101,'離',"lí",'火',"S",'雉')
-    ,(4,'☳',0b100,'震',"zhèn",'雷',"E",'龍')
-    ,(5,'☴',0b011,'巽',"xùn",'風',"SE",'雞')
-    ,(6,'☵',0b010,'坎',"kǎn",'水',"N",'豕')
-    ,(7,'☶',0b001,'艮',"gèn",'山',"NE",'狗')
-    ,(8,'☷',0b000,'坤',"kūn",'地',"SW",'牛')]
+    [(1,'☰',"111",'乾',"qián",'天',"NW",'馬')
+    ,(2,'☱',"110",'兌',"duì",'澤',"W",'羊')
+    ,(3,'☲',"101",'離',"lí",'火',"S",'雉')
+    ,(4,'☳',"100",'震',"zhèn",'雷',"E",'龍')
+    ,(5,'☴',"011",'巽',"xùn",'風',"SE",'雞')
+    ,(6,'☵',"010",'坎',"kǎn",'水',"N",'豕')
+    ,(7,'☶',"001",'艮',"gèn",'山',"NE",'狗')
+    ,(8,'☷',"000",'坤',"kūn",'地',"SW",'牛')]
diff --git a/Music/Theory/Random/Jones_1981.hs b/Music/Theory/Random/Jones_1981.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Random/Jones_1981.hs
@@ -0,0 +1,60 @@
+-- | Kevin Jones. "Compositional Applications of Stochastic Processes".
+--   Computer Music Journal, 5(2):45-58, 1981.
+module Music.Theory.Random.Jones_1981 where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import System.Random {- random -}
+
+-- * Stochastic Finite State Grammars
+
+data G a = T a | P (G a) (G a) deriving (Eq,Show)
+
+type Rule k a = k -> a -> Maybe (a,a)
+type Probablities k r = (r,[(k,r)])
+type SFSG k a r = (Rule k a,Probablities k r)
+
+-- > p_verify (1/2,[('a',1/4),('b',1/4)]) == True
+p_verify :: (Eq a,Num a) => Probablities k a -> Bool
+p_verify (t,k) = sum (t : map snd k) == 1
+
+p_select :: (Ord a, Num a) => Probablities k a -> a -> Maybe (Maybe k)
+p_select (t,k) =
+  let windex w n = findIndex (n <) (scanl1 (+) w)
+      (kk,kn) = unzip k
+      f i = case i of
+              0 -> Nothing
+              _ -> Just (kk !! (i - 1))
+  in fmap f . windex (t : kn)
+
+-- > let p = (1/2,[('a',1/4),('b',1/4)])
+-- > map (p_select_err p) [0,0.5,0.75] == [Nothing,Just 'a',Just 'b']
+p_select_err :: (Ord a, Num a) => Probablities k a -> a -> Maybe k
+p_select_err p = fromMaybe (error "p_select") . p_select p
+
+g_collect :: G a -> [a]
+g_collect g =
+  case g of
+    T e -> [e]
+    P p q -> g_collect p ++ g_collect q
+
+unfold :: (RandomGen g,Random r,Ord r,Num r) => SFSG k a r -> a -> g -> (G a,g)
+unfold (r,p) st g =
+  let (n,g') = randomR (0,1) g
+  in case p_select_err p n of
+       Nothing -> (T st,g')
+       Just k ->
+         case r k st of
+           Nothing -> (T st,g')
+           Just (i,j) ->
+             let (i',g'') = unfold (r,p) i g'
+                 (j',g''') = unfold (r,p) j g''
+             in (P i' j',g''')
+
+sfsg_chain :: (RandomGen g,Random r,Ord r,Num r) => SFSG k a r -> a -> g -> [G a]
+sfsg_chain gr st g =
+  let (x,g') = unfold gr st g
+  in x : sfsg_chain gr st g'
+
+sfsg_chain_n :: (RandomGen g,Random r,Ord r,Num r) => Int -> SFSG k a r -> a -> g -> [G a]
+sfsg_chain_n n gr st = take n . sfsg_chain gr st
diff --git a/Music/Theory/Read.hs b/Music/Theory/Read.hs
deleted file mode 100644
--- a/Music/Theory/Read.hs
+++ /dev/null
@@ -1,147 +0,0 @@
--- | Read functions.
-module Music.Theory.Read where
-
-import Data.Char {- base -}
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Data.Ratio {- base -}
-import Numeric {- base -}
-
--- | Transform 'ReadS' function into precise 'Read' function.
--- Requires using all the input to produce a single token.  The only
--- exception is a singular trailing white space character.
-reads_to_read_precise :: ReadS t -> (String -> Maybe t)
-reads_to_read_precise f s =
-    case f s of
-      [(r,[])] -> Just r
-      [(r,[c])] -> if isSpace c then Just r else Nothing
-      _ -> Nothing
-
--- | Error variant of 'reads_to_read_precise'.
-reads_to_read_precise_err :: String -> ReadS t -> String -> t
-reads_to_read_precise_err err f =
-    fromMaybe (error ("reads_to_read_precise_err:" ++ err)) .
-    reads_to_read_precise f
-
--- | 'reads_to_read_precise' of 'reads'.
--- space character.
-read_maybe :: Read a => String -> Maybe a
-read_maybe = reads_to_read_precise reads
-
--- | Variant of 'read_maybe' with default value.
---
--- > map (read_def 0) ["2","2:","2\n"] == [2,0,2]
-read_def :: Read a => a -> String -> a
-read_def x s = maybe x id (read_maybe s)
-
--- | Variant of 'read_maybe' that errors on 'Nothing'.
-read_err :: Read a => String -> a
-read_err s = maybe (error ("read_err: " ++ s)) id (read_maybe s)
-
--- | Variant of 'reads' requiring exact match, no trailing white space.
---
--- > map reads_exact ["1.5","2,5"] == [Just 1.5,Nothing]
-reads_exact :: Read a => String -> Maybe a
-reads_exact s =
-    case reads s of
-      [(r,"")] -> Just r
-      _ -> Nothing
-
--- | Variant of 'reads_exact' that errors on failure.
-reads_exact_err :: Read a => String -> String -> a
-reads_exact_err err_txt str =
-    let err = error ("reads: " ++ err_txt ++ ": " ++ str)
-    in fromMaybe err (reads_exact str)
-
--- * Type specific variants
-
--- | Allow commas as thousand separators.
---
--- > let r = [Just 123456,Just 123456,Nothing,Just 123456789]
--- > in map read_integral_allow_commas_maybe ["123456","123,456","1234,56","123,456,789"]
-read_integral_allow_commas_maybe :: Read i => String -> Maybe i
-read_integral_allow_commas_maybe s =
-    let c = filter ((== ',') . fst) (zip (reverse s) [0..])
-    in if null c
-       then read_maybe s
-       else if map snd c `isPrefixOf` [3::Int,7..]
-            then read_maybe (filter (not . (== ',')) s)
-            else Nothing
-
-read_integral_allow_commas_err :: (Integral i,Read i) => String -> i
-read_integral_allow_commas_err s =
-    let err = error ("read_integral_allow_commas: misplaced commas: " ++ s)
-    in fromMaybe err (read_integral_allow_commas_maybe s)
-
-read_int_allow_commas :: String -> Int
-read_int_allow_commas = read_integral_allow_commas_err
-
--- | Read a ratio where the division is given by @/@ instead of @%@
--- and the integers allow commas.
---
--- > map read_ratio_with_div_err ["123,456/7","123,456,789"] == [123456/7,123456789]
-read_ratio_with_div_err :: (Integral i, Read i) => String -> Ratio i
-read_ratio_with_div_err s =
-    let f = read_integral_allow_commas_err
-    in case break (== '/') s of
-         (n,'/':d) -> f n % f d
-         _ -> read_integral_allow_commas_err s % 1
-
--- | Read 'Ratio', allow commas for thousand separators.
---
--- > read_ratio_allow_commas_err "327,680" "177,147" == 327680 / 177147
-read_ratio_allow_commas_err :: (Integral i,Read i) => String -> String -> Ratio i
-read_ratio_allow_commas_err n d = let f = read_integral_allow_commas_err in f n % f d
-
--- | Delete trailing @.@, 'read' fails for @700.@.
-delete_trailing_point :: String -> String
-delete_trailing_point s =
-    case reverse s of
-      '.':s' -> reverse s'
-      _ -> s
-
--- | 'read_err' disallows trailing decimal points.
---
--- > map read_fractional_allow_trailing_point_err ["123.","123.4"] == [123.0,123.4]
-read_fractional_allow_trailing_point_err :: Read n => String -> n
-read_fractional_allow_trailing_point_err = read_err . delete_trailing_point
-
--- * Plain type specialisations
-
--- | Type specialised 'read_maybe'.
---
--- > map read_maybe_int ["2","2:","2\n"] == [Just 2,Nothing,Just 2]
-read_maybe_int :: String -> Maybe Int
-read_maybe_int = read_maybe
-
--- | Type specialised 'read_err'.
-read_int :: String -> Int
-read_int = read_err
-
--- | Type specialised 'read_maybe'.
-read_maybe_double :: String -> Maybe Double
-read_maybe_double = read_maybe
-
--- | Type specialised 'read_err'.
-read_double :: String -> Double
-read_double = read_err
-
--- | Type specialised 'read_maybe'.
---
--- > map read_maybe_rational ["1","1%2","1/2"] == [Nothing,Just (1/2),Nothing]
-read_maybe_rational :: String -> Maybe Rational
-read_maybe_rational = read_maybe
-
--- | Type specialised 'read_err'.
---
--- > read_rational "1%4"
-read_rational :: String -> Rational
-read_rational = read_err
-
--- * Numeric variants
-
--- | Error variant of 'readHex'.
---
--- > read_hex_err "F0B0" == 61616
-read_hex_err :: (Eq n,Num n) => String -> n
-read_hex_err = reads_to_read_precise_err "readHex" readHex
diff --git a/Music/Theory/Set/List.hs b/Music/Theory/Set/List.hs
--- a/Music/Theory/Set/List.hs
+++ b/Music/Theory/Set/List.hs
@@ -3,9 +3,10 @@
 
 import Control.Monad {- base -}
 import Data.List {- base -}
+
 import qualified Math.Combinatorics.Multiset as M {- multiset-comb -}
 
-import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.List as T {- hmt-base -}
 
 -- | 'sort' then 'nub'.
 --
@@ -28,9 +29,9 @@
 
 -- | Variant where result is sorted and the empty set is not given.
 --
--- > powerset' [1,2,3] == [[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]
-powerset' :: Ord a => [a] -> [[a]]
-powerset' = tail . T.sort_by_two_stage length id . powerset
+-- > powerset_sorted [1,2,3] == [[1],[2],[3],[1,2],[1,3],[2,3],[1,2,3]]
+powerset_sorted :: Ord a => [a] -> [[a]]
+powerset_sorted = tail . T.sort_by_two_stage_on length id . powerset
 
 -- | Two element subsets.
 --
@@ -41,12 +42,14 @@
       [] -> []
       x:s' -> [(x,y) | y <- s'] ++ pairs s'
 
--- | Three element subsets.
---
--- > triples [1..4] == [(1,2,3),(1,2,4),(1,3,4),(2,3,4)]
---
--- > let f n = genericLength (triples [1..n]) == nk_combinations n 3
--- > in all f [1..15]
+{- | Three element subsets.
+
+> triples [1..4] == [(1,2,3),(1,2,4),(1,3,4),(2,3,4)]
+
+> import Music.Theory.Combinations
+> let f n = genericLength (triples [1..n]) == nk_combinations n 3
+> all f [1..15]
+-}
 triples :: [a] -> [(a,a,a)]
 triples s =
     case s of
@@ -62,23 +65,18 @@
     then [xs]
     else nub (concatMap (expand_set n) [sort (y : xs) | y <- xs])
 
--- | All distinct multiset partitions, see 'M.partitions'.
---
--- > partitions "aab" == [["aab"],["a","ab"],["b","aa"],["b","a","a"]]
---
--- > partitions "abc" == [["abc"]
--- >                     ,["bc","a"],["b","ac"],["c","ab"]
--- >                     ,["c","b","a"]]
+{- | All distinct multiset partitions, see 'M.partitions'.
+
+> partitions "aab" == [["aab"],["a","ab"],["b","aa"],["b","a","a"]]
+> partitions "abc" == [["abc"],["bc","a"],["b","ac"],["c","ab"],["c","b","a"]]
+-}
 partitions :: Eq a => [a] -> [[[a]]]
 partitions = map (map M.toList . M.toList) . M.partitions . M.fromListEq
 
 {- | Cartesian product of two sets.
 
-> let r = [('a',1),('a',2),('b',1),('b',2),('c',1),('c',2)]
-> in cartesian_product "abc" [1,2] == r
-
+> cartesian_product "abc" [1,2] == [('a',1),('a',2),('b',1),('b',2),('c',1),('c',2)]
 > cartesian_product "abc" "" == []
-
 -}
 cartesian_product :: [a] -> [b] -> [(a,b)]
 cartesian_product p q = [(i,j) | i <- p, j <- q]
@@ -94,3 +92,10 @@
       [_] -> []
       [x,y] -> [[i,j] | i <- x, j <- y]
       x:l' -> concatMap (\e -> map (e :) (nfold_cartesian_product l')) x
+
+{- | Generate all distinct cycles, aka necklaces, with elements taken from a multiset.
+
+> concatMap multiset_cycles [replicate i 0 ++ replicate (6 - i) 1 | i <- [0 .. 6]]
+-}
+multiset_cycles :: Ord t => [t] -> [[t]]
+multiset_cycles = M.cycles . M.fromList
diff --git a/Music/Theory/Set/Set.hs b/Music/Theory/Set/Set.hs
--- a/Music/Theory/Set/Set.hs
+++ b/Music/Theory/Set/Set.hs
@@ -2,7 +2,8 @@
 module Music.Theory.Set.Set where
 
 import qualified Data.Set as S {- containers -}
-import qualified Music.Theory.Set.List as L
+
+import qualified Music.Theory.Set.List as L {- hmt -}
 
 set :: (Ord a) => [a] -> S.Set a
 set = S.fromList
diff --git a/Music/Theory/Show.hs b/Music/Theory/Show.hs
deleted file mode 100644
--- a/Music/Theory/Show.hs
+++ /dev/null
@@ -1,2 +0,0 @@
--- | Show functions.
-module Music.Theory.Show where
diff --git a/Music/Theory/String.hs b/Music/Theory/String.hs
deleted file mode 100644
--- a/Music/Theory/String.hs
+++ /dev/null
@@ -1,15 +0,0 @@
--- | String functions.
-module Music.Theory.String where
-
-import Data.Char {- base -}
-
--- | Remove @\r@.
-filter_cr :: String -> String
-filter_cr = filter (not . (==) '\r')
-
--- | Delete trailing 'Char' where 'isSpace' holds.
---
--- > delete_trailing_whitespace "   str   " == "   str"
-delete_trailing_whitespace :: String -> String
-delete_trailing_whitespace = reverse . dropWhile isSpace . reverse
-
diff --git a/Music/Theory/Tempo_Marking.hs b/Music/Theory/Tempo_Marking.hs
--- a/Music/Theory/Tempo_Marking.hs
+++ b/Music/Theory/Tempo_Marking.hs
@@ -4,16 +4,16 @@
 import Data.List {- base -}
 
 import Music.Theory.Duration
-import Music.Theory.Duration.RQ
+import Music.Theory.Duration.Rq
 import Music.Theory.Time_Signature
 
 -- | A tempo marking is in terms of a common music notation 'Duration'.
 type Tempo_Marking = (Duration,Rational)
 
--- | Duration of a RQ value, in seconds, given indicated tempo.
+-- | Duration of a Rq value, in seconds, given indicated tempo.
 --
 -- > rq_to_seconds (quarter_note,90) 1 == 60/90
-rq_to_seconds :: Tempo_Marking -> RQ -> Rational
+rq_to_seconds :: Tempo_Marking -> Rq -> Rational
 rq_to_seconds (d,n) x =
     let d' = duration_to_rq d
         s = 60 / n
diff --git a/Music/Theory/Tiling/Canon.hs b/Music/Theory/Tiling/Canon.hs
--- a/Music/Theory/Tiling/Canon.hs
+++ b/Music/Theory/Tiling/Canon.hs
@@ -1,5 +1,6 @@
 module Music.Theory.Tiling.Canon where
 
+import Control.Monad {- base -}
 import Data.List {- base -}
 import Data.List.Split {- split -}
 import Text.Printf {- base -}
@@ -37,16 +38,17 @@
 e_to_seq :: E -> [Int]
 e_to_seq (s,m,o) = map ((+ o) . (* m)) s
 
--- | Infer 'E' from sequence.
---
--- > e_from_seq [1,5,11] == ([0,2,5],2,1)
--- > e_from_seq [4,7] == ([0,1],3,4)
--- > e_from_seq [2] == ([0],1,2)
+{- | Infer 'E' from sequence.
+
+> e_from_seq [1,5,11] == ([0,2,5],2,1)
+> e_from_seq [4,7] == ([0,1],3,4)
+> e_from_seq [2] == ([0],1,2)
+-}
 e_from_seq :: [Int] -> E
 e_from_seq p =
-    let i:_ = p
+    let i = head p
         q = map (+ negate i) p
-        _:r = q
+        r = tail q
         n = if null r then 1 else foldl1 gcd r
     in (map (`div` n) q,n,i)
 
@@ -63,7 +65,7 @@
 -- | Retrograde of 'T', the result 'T' is sorted.
 --
 -- > let r = [[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]
--- > in t_retrograde [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
+-- > t_retrograde [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
 t_retrograde :: T -> T
 t_retrograde t =
     let n = maximum (concat t)
@@ -72,46 +74,47 @@
 -- | The normal form of 'T' is the 'min' of /t/ and it's 't_retrograde'.
 --
 -- > let r = [[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]
--- > in t_normal [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
+-- > t_normal [[0,7,14],[1,6,11],[2,3,4],[5,9,13],[8,10,12]] == r
 t_normal :: T -> T
 t_normal t = min t (t_retrograde t)
 
--- | Derive set of 'R' from 'T'.
---
--- > let {r = [(21,[0,1,2],[10,8,2,4,7,5,1],[0,1,2,3,5,8,14])]
--- >     ;t = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]}
--- > in r_from_t t == r
+{- | Derive set of 'R' from 'T'.
+
+> let r = [(21,[0,1,2],[10,8,2,4,7,5,1],[0,1,2,3,5,8,14])]
+> let t = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]
+> r_from_t t == r
+-}
 r_from_t :: T -> [R]
 r_from_t t =
     let e = map e_from_seq t
         n = maximum (concat t) + 1
         t3_1 (i,_,_) = i
-        f z = let (s:_,m,o) = unzip3 z in (n,s,m,o)
+        f z = let (s,m,o) = unzip3 z in (n,head s,m,o)
     in map f (T.group_on t3_1 e)
 
 -- * Construction
 
 -- | 'msum' '.' 'map' 'return'.
 --
--- > observeAll (fromList [1..7]) == [1..7]
-fromList :: L.MonadPlus m => [a] -> m a
-fromList = L.msum . map return
+-- > L.observeAll (fromList [1..7]) == [1..7]
+fromList :: MonadPlus m => [a] -> m a
+fromList = msum . map return
 
 -- | Search for /perfect/ tilings of the sequence 'S' using
 -- multipliers from /m/ to degree /n/ with /k/ parts.
-perfect_tilings_m :: L.MonadPlus m => [S] -> [Int] -> Int -> Int -> m T
+perfect_tilings_m :: MonadPlus m => [S] -> [Int] -> Int -> Int -> m T
 perfect_tilings_m s m n k =
     let rec p q =
             if length q == k
             then return (sort q)
             else do m' <- fromList m
-                    L.guard (m' `notElem` p)
+                    guard (m' `notElem` p)
                     s' <- fromList s
                     let i = n - (maximum s' * m') - 1
                     o <- fromList [0..i]
                     let s'' = e_to_seq (s',m',o)
                         q' = concat q
-                    L.guard (all (`notElem` q') s'')
+                    guard (all (`notElem` q') s'')
                     rec (m':p) (s'':q)
     in rec [] []
 
@@ -120,14 +123,12 @@
 > perfect_tilings [[0,1]] [1..3] 6 3 == []
 
 > let r = [[[0,7,14],[1,5,9],[2,4,6],[3,8,13],[10,11,12]]]
-> in perfect_tilings [[0,1,2]] [1,2,4,5,7] 15 5 == r
+> perfect_tilings [[0,1,2]] [1,2,4,5,7] 15 5 == r
 
 > length (perfect_tilings [[0,1,2]] [1..12] 15 5) == 1
 
-> let r = [[[0,1],[2,5],[3,7],[4,6]]
->         ,[[0,1],[2,6],[3,5],[4,7]]
->         ,[[0,2],[1,4],[3,7],[5,6]]]
-> in perfect_tilings [[0,1]] [1..4] 8 4 == r
+> let r = [[[0,1],[2,5],[3,7],[4,6]], [[0,1],[2,6],[3,5],[4,7]] ,[[0,2],[1,4],[3,7],[5,6]]]
+> perfect_tilings [[0,1]] [1..4] 8 4 == r
 
 > let r = [[[0,1],[2,5],[3,7],[4,9],[6,8]]
 >         ,[[0,1],[2,7],[3,5],[4,8],[6,9]]
@@ -139,10 +140,10 @@
 Johnson 2004, p.2
 
 > let r = [[0,6,12],[1,8,15],[2,11,20],[3,5,7],[4,9,14],[10,13,16],[17,18,19]]
-> in perfect_tilings [[0,1,2]] [1,2,3,5,6,7,9] 21 7 == [r]
+> perfect_tilings [[0,1,2]] [1,2,3,5,6,7,9] 21 7 == [r]
 
 > let r = [[0,10,20],[1,9,17],[2,4,6],[3,7,11],[5,12,19],[8,13,18],[14,15,16]]
-> in perfect_tilings [[0,1,2]] [1,2,4,5,7,8,10] 21 7 == [t_retrograde r]
+> perfect_tilings [[0,1,2]] [1,2,4,5,7,8,10] 21 7 == [t_retrograde r]
 
 -}
 perfect_tilings :: [S] -> [Int] -> Int -> Int -> [T]
diff --git a/Music/Theory/Time/Bel1990/R.hs b/Music/Theory/Time/Bel1990/R.hs
--- a/Music/Theory/Time/Bel1990/R.hs
+++ b/Music/Theory/Time/Bel1990/R.hs
@@ -11,7 +11,7 @@
   Centre National de la Recherche Scientifique, 1992. /GRTC 458/
   (<http://www.lpl.univ-aix.fr/~belbernard/music/2algorithms.pdf>)
 
-For details see <http://rd.slavepianos.org/t/hmt-texts>.
+For details see <http://rohandrape.net/?t=hmt-texts>.
 -}
 
 module Music.Theory.Time.Bel1990.R where
@@ -20,18 +20,18 @@
 import Data.Function {- base -}
 import Data.List {- base -}
 import Data.Ratio {- base -}
-import qualified Text.ParserCombinators.Parsec as P {- parsec -}
 
+import qualified Text.Parsec as P {- parsec -}
+
 import qualified Music.Theory.List as T
-import qualified Music.Theory.Math as T
+import qualified Music.Theory.Parse as T
+import qualified Music.Theory.Show as T
 
 -- * Bel
 
 -- | Types of 'Par' nodes.
-data Par_Mode = Par_Left | Par_Right
-              | Par_Min | Par_Max
-              | Par_None
-              deriving (Eq,Show)
+data Par_Mode = Par_Left | Par_Right | Par_Min | Par_Max | Par_None
+  deriving (Eq, Show)
 
 -- | The different 'Par' modes are indicated by bracket types.
 par_mode_brackets :: Par_Mode -> (String,String)
@@ -43,6 +43,17 @@
       Par_Max -> ("{","}")
       Par_None -> ("[","]")
 
+-- | Inverse of par_mode_brackets
+par_mode_kind :: (String, String) -> Par_Mode
+par_mode_kind brk =
+  case brk of
+    ("{","}") -> Par_Max
+    ("~{","}") -> Par_Min
+    ("(",")") -> Par_Left
+    ("~(",")") -> Par_Right
+    ("[","]") -> Par_None
+    _ -> error "par_mode_kind: incoherent par"
+
 bel_brackets_match :: (Char,Char) -> Bool
 bel_brackets_match (open,close) =
     case (open,close) of
@@ -51,25 +62,43 @@
       ('[',']') -> True
       _ -> False
 
--- | Tempo is rational.  The duration of a 'Term' is the reciprocal of
--- the 'Tempo' that is in place at the 'Term'.
+{- | Tempo is rational.
+The duration of a 'Term' is the reciprocal of the 'Tempo' that is in place at the 'Term'.
+-}
 type Tempo = Rational
 
 -- | Terms are the leaf nodes of the temporal structure.
-data Term a = Value a
-            | Rest
-            | Continue
-           deriving (Eq,Show)
+data Term a = Value a | Rest | Continue
+  deriving (Eq,Show)
 
+-- | Value of Term, else Nothing
+term_value :: Term t -> Maybe t
+term_value t =
+  case t of
+    Value x -> Just x
+    _ -> Nothing
+
 -- | Recursive temporal structure.
-data Bel a = Node (Term a) -- ^ Leaf node
-           | Iso (Bel a) -- ^ Isolate
-           | Seq (Bel a) (Bel a) -- ^ Sequence
-           | Par Par_Mode (Bel a) (Bel a) -- ^ Parallel
-           | Mul Tempo -- ^ Tempo multiplier
-           deriving (Eq,Show)
+data Bel a =
+  Node (Term a) -- ^ Leaf node
+  | Iso (Bel a) -- ^ Isolate
+  | Seq (Bel a) (Bel a) -- ^ Sequence
+  | Par Par_Mode (Bel a) (Bel a) -- ^ Parallel
+  | Mul Tempo -- ^ Tempo multiplier
+  deriving (Eq,Show)
 
--- | Pretty printer for 'Bel', given pretty printer for the term type.
+-- | Given a Par mode, generate either: 1. an Iso, 2. a Par, 3. a series of nested Par.
+par_of :: Par_Mode -> [Bel a] -> Bel a
+par_of m l =
+  case l of
+    [] -> error "par_of: null"
+    [e] -> Iso e
+    lhs : rhs : [] -> Par m lhs rhs
+    e : l' -> Par m e (par_of m l')
+
+{- | Pretty printer for 'Bel', given pretty printer for the term type.
+Note this does not write nested Par nodes in their simplified form.
+-}
 bel_pp :: (a -> String) -> Bel a -> String
 bel_pp f b =
     case b of
@@ -87,13 +116,14 @@
 bel_char_pp :: Bel Char -> String
 bel_char_pp = bel_pp return
 
--- | Analyse a Par node giving (duration,LHS-tempo-*,RHS-tempo-*).
---
--- > par_analyse 1 Par_Left (nseq "cd") (nseq "efg") == (2,1,3/2)
--- > par_analyse 1 Par_Right (nseq "cd") (nseq "efg") == (3,2/3,1)
--- > par_analyse 1 Par_Min (nseq "cd") (nseq "efg") == (2,1,3/2)
--- > par_analyse 1 Par_Max (nseq "cd") (nseq "efg") == (3,2/3,1)
--- > par_analyse 1 Par_None (nseq "cd") (nseq "efg") == (3,1,1)
+{- | Analyse a Par node giving (duration,LHS-tempo-*,RHS-tempo-*).
+
+> par_analyse 1 Par_Left (nseq "cd") (nseq "efg") == (2,1,3/2)
+> par_analyse 1 Par_Right (nseq "cd") (nseq "efg") == (3,2/3,1)
+> par_analyse 1 Par_Min (nseq "cd") (nseq "efg") == (2,1,3/2)
+> par_analyse 1 Par_Max (nseq "cd") (nseq "efg") == (3,2/3,1)
+> par_analyse 1 Par_None (nseq "cd") (nseq "efg") == (3,1,1)
+-}
 par_analyse :: Tempo -> Par_Mode -> Bel a -> Bel a -> (Rational,Rational,Rational)
 par_analyse t m p q =
     let (_,d_p) = bel_tdur t p
@@ -133,14 +163,17 @@
 -- | Time point.
 type Time = Rational
 
--- | Voices are named as a sequence of left and right directions
--- within nested 'Par' structures.
+{- | Voices are named as a sequence of left and right directions within nested 'Par' structures.
+l is left and r is right.
+-}
 type Voice = [Char]
 
--- | Linear state.  'Time' is the start time of the term, 'Tempo' is
--- the active tempo & therefore the reciprocal of the duration,
--- 'Voice' is the part label.
-type L_St = (Time,Tempo,Voice)
+{- | Linear state.
+'Time' is the start time of the term.
+'Tempo' is the active tempo & therefore the reciprocal of the duration.
+'Voice' is the part label.
+-}
+type L_St = (Time, Tempo, Voice)
 
 -- | Linear term.
 type L_Term a = (L_St,Term a)
@@ -157,6 +190,18 @@
 lterm_end_time :: L_Term a -> Time
 lterm_end_time e = lterm_time e + lterm_duration e
 
+-- | Voice of 'L_Term'.
+lterm_voice :: L_Term t -> Voice
+lterm_voice ((_,_,vc),_) = vc
+
+-- | Term of L_Term
+lterm_term :: L_Term t -> Term t
+lterm_term (_,t) = t
+
+-- | Value of Term of L_Term
+lterm_value :: L_Term t -> Maybe t
+lterm_value = term_value . lterm_term
+
 -- | Linear form of 'Bel', an ascending sequence of 'L_Term'.
 type L_Bel a = [L_Term a]
 
@@ -192,18 +237,25 @@
 lbel_tempo_mul :: Rational -> L_Bel a -> L_Bel a
 lbel_tempo_mul n = map (\((st,tm,vc),e) -> ((st / n,tm * n,vc),e))
 
--- | After normalisation all start times and durations are integral.
+{- | The multiplier that will normalise an L_Bel value.
+     After normalisation all start times and durations are integral.
+-}
+lbel_normalise_multiplier :: L_Bel t -> Rational
+lbel_normalise_multiplier b =
+  let t = lbel_tempi b
+      n = foldl1 lcm (map denominator t) % 1
+      m = foldl1 lcm (map (numerator . (* n)) t) % 1
+  in n / m
+
+-- | Calculate and apply L_Bel normalisation multiplier.
 lbel_normalise :: L_Bel a -> L_Bel a
-lbel_normalise b =
-    let t = lbel_tempi b
-        n = foldl1 lcm (map denominator t) % 1
-        m = foldl1 lcm (map numerator (map (* n) t)) % 1
-    in lbel_tempo_mul (n / m) b
+lbel_normalise b = lbel_tempo_mul (lbel_normalise_multiplier b) b
 
--- | All leftmost voices are re-written to the last non-left turning point.
---
--- > map voice_normalise ["","l","ll","lll"] == replicate 4 ""
--- > voice_normalise "lllrlrl" == "rlrl"
+{- | All leftmost voices are re-written to the last non-left turning point.
+
+> map voice_normalise ["","l","ll","lll"] == replicate 4 ""
+> voice_normalise "lllrlrl" == "rlrl"
+-}
 voice_normalise :: Voice -> Voice
 voice_normalise = dropWhile (== 'l')
 
@@ -271,10 +323,11 @@
 (~>) :: Bel a -> Bel a -> Bel a
 p ~> q = Seq p q
 
--- | 'foldl1' of 'Seq'.
---
--- > lseq [Node Rest] == Node Rest
--- > lseq [Node Rest,Node Continue] == Seq (Node Rest) (Node Continue)
+{- | 'foldl1' of 'Seq'.
+
+> lseq [Node Rest] == Node Rest
+> lseq [Node Rest,Node Continue] == Seq (Node Rest) (Node Continue)
+-}
 lseq :: [Bel a] -> Bel a
 lseq = foldl1 Seq
 
@@ -311,9 +364,10 @@
 bel_parse_pp_ident :: String -> Bool
 bel_parse_pp_ident s = bel_char_pp (bel_char_parse s) == s
 
--- | Run 'bel_char_parse', and print both 'bel_char_pp' and 'bel_ascii'.
---
--- > bel_ascii_pp "{i{ab,{c[d,oh]e,sr{p,qr}}},{jk,ghjkj}}"
+{- | Run 'bel_char_parse', and print both 'bel_char_pp' and 'bel_ascii'.
+
+> bel_ascii_pp "{i{ab,c[d,oh]e,sr{p,qr}},{jk,ghjkj}}"
+-}
 bel_ascii_pp :: String -> IO ()
 bel_ascii_pp s = do
   let p = bel_char_parse s
@@ -322,55 +376,52 @@
 
 -- * Parsing
 
--- | A 'Char' parser.
-type P a = P.GenParser Char () a
-
 -- | Parse 'Rest' 'Term'.
 --
 -- > P.parse p_rest "" "-"
-p_rest :: P (Term a)
-p_rest = liftM (const Rest) (P.char '-')
+p_rest :: T.P (Term a)
+p_rest = fmap (const Rest) (P.char '-')
 
 -- | Parse 'Rest' 'Term'.
 --
 -- > P.parse p_nrests "" "3"
-p_nrests :: P (Bel a)
-p_nrests = liftM nrests p_non_negative_integer
+p_nrests :: T.P (Bel a)
+p_nrests = fmap nrests p_non_negative_integer
 
 -- | Parse 'Continue' 'Term'.
 --
 -- > P.parse p_continue "" "_"
-p_continue :: P (Term a)
-p_continue = liftM (const Continue) (P.char '_')
+p_continue :: T.P (Term a)
+p_continue = fmap (const Continue) (P.char '_')
 
 -- | Parse 'Char' 'Value' 'Term'.
 --
 -- > P.parse p_char_value "" "a"
-p_char_value :: P (Term Char)
-p_char_value = liftM Value P.lower
+p_char_value :: T.P (Term Char)
+p_char_value = fmap Value P.lower
 
 -- | Parse 'Char' 'Term'.
 --
 -- > P.parse (P.many1 p_char_term) "" "-_a"
-p_char_term :: P (Term Char)
+p_char_term :: T.P (Term Char)
 p_char_term = P.choice [p_rest,p_continue,p_char_value]
 
 -- | Parse 'Char' 'Node'.
 --
 -- > P.parse (P.many1 p_char_node) "" "-_a"
-p_char_node :: P (Bel Char)
-p_char_node = liftM Node p_char_term
+p_char_node :: T.P (Bel Char)
+p_char_node = fmap Node p_char_term
 
 -- | Parse non-negative 'Integer'.
 --
 -- > P.parse p_non_negative_integer "" "3"
-p_non_negative_integer :: P Integer
-p_non_negative_integer = liftM read (P.many1 P.digit)
+p_non_negative_integer :: T.P Integer
+p_non_negative_integer = fmap read (P.many1 P.digit)
 
 -- | Parse non-negative 'Rational'.
 --
 -- > P.parse (p_non_negative_rational `P.sepBy` (P.char ',')) "" "3%5,2/3"
-p_non_negative_rational :: P Rational
+p_non_negative_rational :: T.P Rational
 p_non_negative_rational = do
   n <- p_non_negative_integer
   _ <- P.oneOf "%/"
@@ -381,7 +432,7 @@
 --
 -- > P.parse p_non_negative_double "" "3.5"
 -- > P.parse (p_non_negative_double `P.sepBy` (P.char ',')) "" "3.5,7.2,1.0"
-p_non_negative_double :: P Double
+p_non_negative_double :: T.P Double
 p_non_negative_double = do
   a <- P.many1 P.digit
   _ <- P.char '.'
@@ -391,16 +442,16 @@
 -- | Parse non-negative number as 'Rational'.
 --
 -- > P.parse (p_non_negative_number `P.sepBy` (P.char ',')) "" "7%2,3.5,3"
-p_non_negative_number :: P Rational
+p_non_negative_number :: T.P Rational
 p_non_negative_number =
     P.choice [P.try p_non_negative_rational
-             ,P.try (liftM toRational p_non_negative_double)
-             ,P.try (liftM toRational p_non_negative_integer)]
+             ,P.try (fmap toRational p_non_negative_double)
+             ,P.try (fmap toRational p_non_negative_integer)]
 
 -- | Parse 'Mul'.
 --
 -- > P.parse (P.many1 p_mul) "" "/3*3/2"
-p_mul :: P (Bel a)
+p_mul :: T.P (Bel a)
 p_mul = do
   op <- P.oneOf "*/"
   n <- p_non_negative_number
@@ -411,50 +462,43 @@
   return (Mul n')
 
 -- | Given parser for 'Bel' /a/, generate 'Iso' parser.
-p_iso :: P (Bel a) -> P (Bel a)
+p_iso :: T.P (Bel a) -> T.P (Bel a)
 p_iso f = do
   open <- P.oneOf "{(["
   iso <- P.many1 f
   close <- P.oneOf "})]"
-  if bel_brackets_match (open,close)
-    then return (Iso (lseq iso))
-    else error "p_iso: open/close mismatch"
+  when (not (bel_brackets_match (open,close))) (error "p_iso: open/close mismatch")
+  return (Iso (lseq iso))
 
 -- | 'p_iso' of 'p_char_bel'.
 --
 -- > P.parse p_char_iso "" "{abcde}"
-p_char_iso :: P (Bel Char)
+p_char_iso :: T.P (Bel Char)
 p_char_iso = p_iso p_char_bel
 
 -- | Given parser for 'Bel' /a/, generate 'Par' parser.
-p_par :: P (Bel a) -> P (Bel a)
+p_par :: T.P (Bel a) -> T.P (Bel a)
 p_par f = do
   tilde <- P.optionMaybe (P.char '~')
   open <- P.oneOf "{(["
-  lhs <- P.many1 f
-  _ <- P.char ','
-  rhs <- P.many1 f
+  items <- P.sepBy (P.many1 f) (P.char ',')
   close <- P.oneOf "})]"
-  let m = case (tilde,open,close) of
-            (Nothing,'{','}') -> Par_Max
-            (Just '~','{','}') -> Par_Min
-            (Nothing,'(',')') -> Par_Left
-            (Just '~','(',')') -> Par_Right
-            (Nothing,'[',']') -> Par_None
-            _ -> error "p_par: incoherent par"
-  return (Par m (lseq lhs) (lseq rhs))
+  let m = par_mode_kind (T.mcons tilde [open], [close])
+  return (par_of m (map lseq items))
 
--- | 'p_par' of 'p_char_bel'.
---
--- > P.parse p_char_par "" "{ab,{c,de}}"
--- > P.parse p_char_par "" "{ab,~(c,de)}"
-p_char_par :: P (Bel Char)
+{- | 'p_par' of 'p_char_bel'.
+
+> p = P.parse p_char_par ""
+> p "{ab,{c,de}}" == p "{ab,c,de}"
+> p "{ab,~(c,de)}"
+-}
+p_char_par :: T.P (Bel Char)
 p_char_par = p_par p_char_bel
 
 -- | Parse 'Bel' 'Char'.
 --
 -- > P.parse (P.many1 p_char_bel) "" "-_a*3"
-p_char_bel :: P (Bel Char)
+p_char_bel :: T.P (Bel Char)
 p_char_bel = P.choice [P.try p_char_par,p_char_iso,p_mul,p_nrests,p_char_node]
 
 -- | Run parser for 'Bel' of 'Char'.
diff --git a/Music/Theory/Time/Duration.hs b/Music/Theory/Time/Duration.hs
deleted file mode 100644
--- a/Music/Theory/Time/Duration.hs
+++ /dev/null
@@ -1,148 +0,0 @@
-module Music.Theory.Time.Duration where
-
-import qualified Data.List.Split as S {- split -}
-import Text.Printf {- base -}
-
--- | Duration stored as /hours/, /minutes/, /seconds/ and /milliseconds/.
-data Duration = Duration {hours :: Int
-                         ,minutes :: Int
-                         ,seconds :: Int
-                         ,milliseconds :: Int}
-                deriving (Eq)
-
--- | Convert fractional /seconds/ to integral /(seconds,milliseconds)/.
---
--- > s_sms 1.75 == (1,750)
-s_sms :: (RealFrac n,Integral i) => n -> (i,i)
-s_sms s =
-    let s' = floor s
-        ms = round ((s - fromIntegral s') * 1000)
-    in (s',ms)
-
--- | Inverse of 's_sms'.
---
--- > sms_s (1,750) == 1.75
-sms_s :: (Integral i) => (i,i) -> Double
-sms_s (s,ms) = fromIntegral s + fromIntegral ms / 1000
-
--- | 'Read' function for 'Duration' tuple.
-read_duration_tuple :: String -> (Int,Int,Int,Int)
-read_duration_tuple x =
-    let f :: (Int,Int,Double) -> (Int,Int,Int,Int)
-        f (h,m,s) = let (s',ms) = s_sms s in (h,m,s',ms)
-    in case S.splitOneOf ":" x of
-        [h,m,s] -> f (read h,read m,read s)
-        [m,s] -> f (0,read m,read s)
-        [s] -> f (0,0,read s)
-        _ -> error "read_duration_tuple"
-
--- | 'Read' function for 'Duration'.  Allows either @H:M:S.MS@ or
--- @M:S.MS@ or @S.MS@.
---
--- > read_duration "01:35:05.250" == Duration 1 35 5 250
--- > read_duration    "35:05.250" == Duration 0 35 5 250
--- > read_duration       "05.250" == Duration 0 0 5 250
-read_duration :: String -> Duration
-read_duration = tuple_to_duration id . read_duration_tuple
-
-instance Read Duration where
-    readsPrec _ x = [(read_duration x,"")]
-
--- | 'Show' function for 'Duration'.
---
--- > show_duration (Duration 1 35 5 250) == "01:35:05.250"
--- > show (Duration 1 15 0 000) == "01:15:00.000"
-show_duration :: Duration -> String
-show_duration (Duration h m s ms) =
-    let f :: Int -> String
-        f = printf "%02d"
-        g = f . fromIntegral
-        s' = sms_s (s,ms)
-    in concat [g h,":",g m,":",printf "%06.3f" s']
-
-instance Show Duration where
-    show = show_duration
-
-normalise_minutes :: Duration -> Duration
-normalise_minutes (Duration h m s ms) =
-    let (h',m') = m `divMod` 60
-    in Duration (h + h') m' s ms
-
-normalise_seconds :: Duration -> Duration
-normalise_seconds (Duration h m s ms) =
-    let (m',s') = s `divMod` 60
-    in Duration h (m + m') s' ms
-
-normalise_milliseconds :: Duration -> Duration
-normalise_milliseconds (Duration h m s ms) =
-    let (s',ms') = ms `divMod` 1000
-    in Duration h m (s + s') ms'
-
-normalise_duration :: Duration -> Duration
-normalise_duration =
-    normalise_minutes .
-    normalise_seconds .
-    normalise_milliseconds
-
--- | Extract 'Duration' tuple applying filter function at each element
---
--- > duration_tuple id (Duration 1 35 5 250) == (1,35,5,250)
-duration_to_tuple :: (Int -> a) -> Duration -> (a,a,a,a)
-duration_to_tuple f (Duration h m s ms) = (f h,f m,f s,f ms)
-
--- | Inverse of 'duration_to_tuple'.
-tuple_to_duration :: (a -> Int) -> (a,a,a,a) -> Duration
-tuple_to_duration f (h,m,s,ms) = Duration (f h) (f m) (f s) (f ms)
-
--- > duration_to_hours (read "01:35:05.250") == 1.5847916666666668
-duration_to_hours :: Fractional n => Duration -> n
-duration_to_hours d =
-    let (h,m,s,ms) = duration_to_tuple fromIntegral d
-    in h + (m / 60) + (s / (60 * 60)) + (ms / (60 * 60 * 1000))
-
--- > duration_to_minutes (read "01:35:05.250") == 95.0875
-duration_to_minutes :: Fractional n => Duration -> n
-duration_to_minutes = (* 60) . duration_to_hours
-
--- > duration_to_seconds (read "01:35:05.250") == 5705.25
-duration_to_seconds :: Fractional n => Duration -> n
-duration_to_seconds = (* 60) . duration_to_minutes
-
--- > hours_to_duration 1.5847916 == Duration 1 35 5 250
-hours_to_duration :: RealFrac a => a -> Duration
-hours_to_duration n =
-    let r = fromIntegral :: RealFrac a => Int -> a
-        h = (r . floor) n
-        m = (n - h) * 60
-        (s,ms) = s_sms ((m - (r . floor) m) * 60)
-    in Duration (floor h) (floor m) s ms
-
-minutes_to_duration :: RealFrac a => a -> Duration
-minutes_to_duration n = hours_to_duration (n / 60)
-
-seconds_to_duration :: RealFrac a => a -> Duration
-seconds_to_duration n = minutes_to_duration (n / 60)
-
-nil_duration :: Duration
-nil_duration = Duration 0 0 0 0
-
-negate_duration :: Duration -> Duration
-negate_duration (Duration h m s ms) =
-    let h' = if h > 0 then -h else h
-        m' = if h == 0 && m > 0 then -m else m
-        s' = if h == 0 && m == 0 && s > 0 then -s else s
-        ms' = if h == 0 && m == 0 && s == 0 then -ms else ms
-    in Duration h' m' s' ms'
-
--- > duration_diff (Duration 1 35 5 250) (Duration 0 25 1 125) == Duration 1 10 4 125
--- > duration_diff (Duration 0 25 1 125) (Duration 1 35 5 250) == Duration (-1) 10 4 125
--- > duration_diff (Duration 0 25 1 125) (Duration 0 25 1 250) == Duration 0 0 0 (-125)
-duration_diff :: Duration -> Duration -> Duration
-duration_diff p q =
-    let f = duration_to_hours :: Duration -> Double
-        (p',q') = (f p,f q)
-        g = normalise_duration . hours_to_duration
-    in case compare p' q' of
-         LT -> negate_duration (g (q' - p'))
-         EQ -> nil_duration
-         GT -> g (p' - q')
diff --git a/Music/Theory/Time/KeyKit.hs b/Music/Theory/Time/KeyKit.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Time/KeyKit.hs
@@ -0,0 +1,236 @@
+{- | A sequence structure, courtesy <https://github.com/nosuchtim/keykit>.
+
+A /note/ has a time, a duration and a value.
+A /phrase/ is a time-ascending sequence of notes and a /length/.
+The length of a phrase is independent of the contents.
+The sequence operator, /phrase_append/, sums phrase lengths.
+The parallel operator, /phrase_merge/, selects the longer length.
+
+Operations are ordinarily on phrases, notes are operated on indirectly.
+The phrase indexing operation, /phrase_at/ returns a phrase of degree one.
+-}
+module Music.Theory.Time.KeyKit where
+
+import Data.List {- base -}
+
+import qualified Data.List.Ordered as O {- data-ordlist -}
+
+import qualified Music.Theory.Time.Seq as Seq {- hmt -}
+
+-- * Time
+
+type Time = Rational
+type Duration = Time
+type Length = Time
+
+-- * Note
+
+data Note t =
+  Note { note_start_time :: Time, note_duration :: Duration, note_value :: t }
+  deriving (Eq, Ord, Show)
+
+note_end_time :: Note t -> Time
+note_end_time n = note_start_time n + note_duration n
+
+note_region :: Note t -> (Time, Time)
+note_region n = (note_start_time n, note_end_time n)
+
+note_shift_time :: Time -> Note t -> Note t
+note_shift_time k (Note t d e) = Note (t + k) d e
+
+note_scale_duration :: Time -> Note t -> Note t
+note_scale_duration m (Note t d e) = Note t (d * m) e
+
+note_scale_duration_and_time :: Time -> Note t -> Note t
+note_scale_duration_and_time m (Note t d e) = Note (t * m) (d * m) e
+
+note_is_start_in_region :: (Time, Time) -> Note t -> Bool
+note_is_start_in_region (t1, t2) (Note t _ _) = t >= t1 && t < t2
+
+note_is_entirely_in_region :: (Time, Time) -> Note t -> Bool
+note_is_entirely_in_region (t1, t2) (Note t d _) = t >= t1 && (t + d) < t2
+
+-- * Phrase
+
+-- | It is an un-checked invariant that the note list is in ascending order.
+data Phrase t =
+  Phrase { phrase_notes :: [Note t], phrase_length :: Length }
+  deriving (Eq, Ord, Show)
+
+phrase_values :: Phrase t -> [t]
+phrase_values = map note_value . phrase_notes
+
+phrase_set_length :: Phrase t -> Length -> Phrase t
+phrase_set_length (Phrase n _) l = Phrase n l
+
+phrase_degree :: Phrase t -> Int
+phrase_degree (Phrase n _) = length n
+
+phrase_start_time :: Phrase t -> Time
+phrase_start_time (Phrase n _) =
+  case n of
+    [] -> 0
+    n1 : _ -> note_start_time n1
+
+phrase_end_time :: Phrase t -> Time
+phrase_end_time (Phrase n _) =
+  case n of
+    [] -> 0
+    _ -> note_start_time (last n)
+
+phrase_duration :: Phrase t -> Duration
+phrase_duration p = phrase_end_time p - phrase_start_time p
+
+phrase_maximum :: Ord t => Phrase t -> Note t
+phrase_maximum (Phrase n _) = maximum n
+
+phrase_minimum :: Ord t => Phrase t -> Note t
+phrase_minimum (Phrase n _) = minimum n
+
+-- | Keykit sets the length to the duration, i.e. ('c,e,g'%2).length is 192.
+phrase_at :: Phrase t -> Int -> Phrase t
+phrase_at (Phrase n _) k =
+  let nt = n !! (k - 1)
+  in Phrase [nt] (note_start_time nt + note_duration nt)
+
+phrase_time_at :: Phrase t -> Int -> Time
+phrase_time_at (Phrase n _) k = note_start_time (n !! (k - 1))
+
+phrase_clear_at :: Phrase t -> Int -> Phrase t
+phrase_clear_at (Phrase n l) k =
+  let remove_ix ix list = let (p,q) = splitAt ix list in p ++ tail q
+  in Phrase (remove_ix (k - 1) n) l
+
+phrase_at_put :: Ord t => Phrase t -> Int -> Phrase t -> Phrase t
+phrase_at_put (Phrase n1 l1) k (Phrase n2 _) =
+  let nt = n1 !! (k - 1)
+      remove_ix ix list = let (p,q) = splitAt ix list in p ++ tail q
+  in Phrase (O.merge (remove_ix (k - 1) n1) (map (note_shift_time (note_start_time nt)) n2)) l1
+
+phrase_is_empty :: Phrase t -> Bool
+phrase_is_empty (Phrase n _) = null n
+
+-- | KeyKits p+q
+phrase_append :: Ord t => Phrase t -> Phrase t -> Phrase t
+phrase_append (Phrase n1 l1) (Phrase n2 l2) = Phrase (O.merge n1 (map (note_shift_time l1) n2)) (l1 + l2)
+
+phrase_append_list :: Ord t => [Phrase t] -> Phrase t
+phrase_append_list = foldl1' phrase_append
+
+-- | KeyKits p|q
+phrase_merge :: Ord t => Phrase t -> Phrase t -> Phrase t
+phrase_merge (Phrase n1 l1) (Phrase n2 l2) = Phrase (O.merge n1 n2) (max l1 l2)
+
+phrase_merge_list :: Ord t => [Phrase t] -> Phrase t
+phrase_merge_list p =
+  let l = maximum (map phrase_length p)
+      n = sort (concatMap phrase_notes p)
+  in Phrase n l
+
+phrase_select :: Phrase t -> (Note t -> Bool) -> Phrase t
+phrase_select (Phrase n l) f = Phrase (filter f n) l
+
+phrase_partition :: Phrase t -> (Note t -> Bool) -> (Phrase t, Phrase t)
+phrase_partition (Phrase n l) f =
+  let (n1, n2) = partition f n
+  in (Phrase n1 l, Phrase n2 l)
+
+phrase_select_region :: Phrase t -> (Time, Time) -> Phrase t
+phrase_select_region p r = phrase_select p (note_is_start_in_region r)
+
+phrase_clear_region :: Phrase t -> (Time, Time) -> Phrase t
+phrase_clear_region p r = phrase_select p (not . note_is_start_in_region r)
+
+phrase_select_indices :: Phrase t -> (Int, Int) -> Phrase t
+phrase_select_indices (Phrase n l) (i, j) = Phrase (take (j - i + 1) (drop (i - 1) n)) l
+
+phrase_clear_indices :: Phrase t -> (Int, Int) -> Phrase t
+phrase_clear_indices (Phrase n l) (i, j) = Phrase (take (i - 1) n ++ drop j n) l
+
+phrase_extract_region :: Phrase t -> (Time, Time) -> Phrase t
+phrase_extract_region p (t1, t2) =
+  let p' = phrase_select_region p (t1, t2)
+  in phrase_set_length (phrase_shift p' (0 - t1)) (t2 - t1)
+
+phrase_delete_region :: Ord t => Phrase t -> (Time, Time) -> Phrase t
+phrase_delete_region p (t1, t2) =
+  phrase_append
+  (phrase_extract_region p (0, t1))
+  (phrase_extract_region p (t2, phrase_length p))
+
+phrase_separate :: Phrase t -> Time -> (Phrase t, Phrase t)
+phrase_separate p t =
+  let (p1, p2) = phrase_partition p (note_is_start_in_region (0, t))
+      p1' = phrase_set_length p1 t
+      p2' = phrase_set_length (phrase_shift p2 (0 - t)) (phrase_length p - t)
+  in (p1', p2')
+
+phrase_reverse :: Phrase t -> Phrase t
+phrase_reverse (Phrase n l) =
+  let f (Note t d e) = Note (l - t - d) d e
+  in Phrase (reverse (map f n)) l
+
+phrase_reorder :: Phrase t -> [Int] -> Phrase t
+phrase_reorder (Phrase n l) p =
+  let f (Note t d _) i = Note t d (note_value (n !! (i - 1)))
+  in Phrase (zipWith f n p) l
+
+phrase_truncate :: Phrase t -> Phrase t
+phrase_truncate p = phrase_set_length p (phrase_end_time p)
+
+phrase_trim :: Phrase t -> Phrase t
+phrase_trim p =
+  let t = phrase_start_time p
+  in phrase_truncate (phrase_shift p (0 - t))
+
+-- * Functor
+
+note_map :: (t -> u) -> Note t -> Note u
+note_map f (Note t d e) = Note t d (f e)
+
+phrase_value_map :: (t -> u) -> Phrase t -> Phrase u
+phrase_value_map f (Phrase n l) = Phrase (map (note_map f) n) l
+
+phrase_note_map :: (Note t -> Note u) -> Phrase t -> Phrase u
+phrase_note_map f (Phrase n l) = Phrase (map f n) l
+
+phrase_phrase_map :: Ord u => (Phrase t -> Phrase u) -> Phrase t -> Phrase u
+phrase_phrase_map f (Phrase n l) =
+  let g (Note t d e) = f (Phrase [Note t d e] (t + d))
+  in Phrase (sort (concatMap phrase_notes (map g n))) l
+
+phrase_map :: Ord u => (Note t -> Phrase u) -> Phrase t -> Phrase u
+phrase_map f (Phrase n l) = Phrase (sort (concatMap phrase_notes (map f n))) l
+
+phrase_shift :: Phrase t -> Time -> Phrase t
+phrase_shift p t = phrase_note_map (note_shift_time t) p
+
+phrase_scale_duration :: Phrase t -> Time -> Phrase t
+phrase_scale_duration p m = phrase_note_map (note_scale_duration m) p
+
+phrase_scale_duration_and_time :: Phrase t -> Time -> Phrase t
+phrase_scale_duration_and_time p m = phrase_note_map (note_scale_duration_and_time m) p
+
+phrase_scale_to_duration :: Phrase t -> Duration -> Phrase t
+phrase_scale_to_duration p d = phrase_scale_duration_and_time p (d / phrase_length p)
+
+phrase_scale_to_region :: Phrase t -> (Time, Duration) -> Phrase t
+phrase_scale_to_region p (t1, t2) = phrase_shift (phrase_scale_to_duration p (t2 - t1)) t1
+
+-- * Seq
+
+phrase_to_wseq :: Phrase t -> Seq.Wseq Time t
+phrase_to_wseq (Phrase n _) =
+  let f (Note tm dur e) = ((tm, dur), e)
+  in map f n
+
+useq_to_phrase :: Seq.Useq Time t -> Phrase t
+useq_to_phrase = dseq_to_phrase . Seq.useq_to_dseq
+
+dseq_to_phrase :: Seq.Dseq Time t -> Phrase t
+dseq_to_phrase = wseq_to_phrase . Seq.dseq_to_wseq 0
+
+wseq_to_phrase :: Seq.Wseq Time t -> Phrase t
+wseq_to_phrase sq =
+  let f ((t, d), e) = Note t d e
+  in Phrase (map f sq) (Seq.wseq_dur sq)
diff --git a/Music/Theory/Time/KeyKit/Basic.hs b/Music/Theory/Time/KeyKit/Basic.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Time/KeyKit/Basic.hs
@@ -0,0 +1,52 @@
+-- | Translations of some functions from <https://github.com/nosuchtim/keykit/blob/master/lib/basic1.k>
+module Music.Theory.Time.KeyKit.Basic where
+
+import Data.List {- base -}
+
+import qualified Music.Theory.List as List {- hmt-base -}
+
+import Music.Theory.Time.KeyKit {- hmt -}
+
+{- | Returns an arpeggiated version of the phrase.
+One way of describing desc it is that all the notes have been separated and then put back together, back-to-back.
+
+> phrase_arpeggio (wseq_to_phrase (zip (repeat (0,1)) [60, 64, 67]))
+-}
+phrase_arpeggio :: Phrase t -> Phrase t
+phrase_arpeggio (Phrase n l) =
+  case n of
+    [] -> Phrase n l
+    n1 : _ ->
+      let t_seq = scanl (+) (note_start_time n1) (map note_duration n)
+          n' = zipWith (\t (Note _ d e) -> Note t d e) t_seq n
+          l' = note_end_time (last n)
+      in Phrase n' l'
+
+-- | Return phrase ph echoed num times, with rtime delay between each echo.
+phrase_echo :: Ord t => Phrase t -> Int -> Time -> Phrase t
+phrase_echo p n t = phrase_merge_list (map (\i -> phrase_shift p (fromIntegral i * t)) [0 .. n - 1])
+
+{- | Convert a phrase to be in step time, ie. all notes with the same spacing and duration.
+Overlapped notes (no matter how small the overlap) are played at the same time.
+
+> phrase_step (wseq_to_phrase [((0, 1), 60), ((5, 2), 64), ((23, 3), 67)]) 1
+-}
+phrase_step :: Phrase t -> Duration -> Phrase t
+phrase_step (Phrase n _) d =
+  let g = groupBy (\i j -> note_start_time i == note_start_time j) n
+      f l t = map (\(Note _ _ e) -> Note t d e) l
+      n' = concat (zipWith f g [0, d ..])
+  in Phrase n' (note_end_time (last n'))
+
+{- | This function takes a phrase, splits in in 2 halves (along time) and shuffles the result
+(ie. first a note from the first half, then a note from the second half, etc.).
+The timing of the original phrase is applied to the result.
+
+> phrase_to_wseq (phrase_shuffle (useq_to_phrase (1,[1..9])))
+-}
+phrase_shuffle :: Phrase t -> Phrase t
+phrase_shuffle (Phrase n l) =
+  let (lhs, rhs) = List.split_into_halves (map note_value n)
+      f (Note t d _) e = Note t d e
+      n' = zipWith f n (concat (transpose [lhs, rhs]))
+  in Phrase n' l
diff --git a/Music/Theory/Time/KeyKit/Parser.hs b/Music/Theory/Time/KeyKit/Parser.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Time/KeyKit/Parser.hs
@@ -0,0 +1,249 @@
+-- | KeyKit phrase literal (constant) parser and printer.
+module Music.Theory.Time.KeyKit.Parser where
+
+import Data.Maybe {- base -}
+import Text.Printf {- base -}
+
+import qualified Text.Parsec as P {- parsec -}
+import qualified Text.Parsec.String as String {- parsec -}
+
+-- * Parser setup
+
+-- | A 'Char' parser with no user state.
+type P a = String.GenParser Char () a
+
+-- | Run parser and return either an error string or an answer.
+kk_parse_either :: P t -> String -> Either String t
+kk_parse_either p = either (\m -> Left ("kk_parse: " ++ show m)) Right . P.parse p ""
+
+-- | Run parser and report any error.  Does not delete leading spaces.
+kk_parse :: P t -> String -> t
+kk_parse p = either (\e -> error e) id . kk_parse_either p
+
+-- | Run p then q, returning result of p.
+(>>~) :: Monad m => m t -> m u -> m t
+p >>~ q = p >>= \x -> q >> return x
+
+kk_lexeme :: P t -> P t
+kk_lexeme p = p >>~ P.many P.space
+
+kk_uint :: P Int
+kk_uint = do
+  digits <- P.many1 P.digit
+  return (read digits)
+
+kk_int :: P Int
+kk_int = do
+  sign <- P.optionMaybe (P.char '-')
+  unsigned <- kk_uint
+  return (maybe unsigned (const (negate unsigned)) sign)
+
+-- * Note elements parsers
+
+kk_note_name_p :: P Char
+kk_note_name_p = P.oneOf "abcdefg"
+
+kk_midi_note_p :: P Int
+kk_midi_note_p = P.char 'p' >> kk_uint
+
+kk_rest_p :: P Char
+kk_rest_p = P.char 'r'
+
+kk_accidental_p :: P Char
+kk_accidental_p = P.oneOf "+-"
+
+kk_char_to_note_number :: Char -> Int
+kk_char_to_note_number c = fromMaybe (error "kk_char_to_note_number?") (lookup c (zip "cdefgab" [0, 2, 4, 5, 7, 9, 11]))
+
+kk_char_to_alteration :: Char -> Int
+kk_char_to_alteration c = fromMaybe (error "kk_char_to_alteration?") (lookup c (zip "+-" [1, -1]))
+
+-- > map kk_note_number_to_name [0 .. 11]
+kk_note_number_to_name :: Int -> String
+kk_note_number_to_name k = fromMaybe (error "kk_note_number_to_name?") (lookup k (zip [0..] (words "c c+ d e- e f f+ g a- a b- b")))
+
+kk_named_note_number_p :: P Int
+kk_named_note_number_p = do
+  nm <- kk_note_name_p
+  ac <- P.optionMaybe kk_accidental_p
+  return (kk_char_to_note_number nm + maybe 0 kk_char_to_alteration ac)
+
+kk_note_number_p :: P Int
+kk_note_number_p = kk_named_note_number_p P.<|> kk_midi_note_p
+
+-- | The octave key can be elided, ordinarily directly after the note name, ie. c2.
+kk_modifier_p :: P (Char, Int)
+kk_modifier_p = do
+  c <- P.optionMaybe (P.oneOf "ovdct")
+  n <- kk_int
+  return (fromMaybe 'o' c, n)
+
+kk_modifiers_p :: P [(Char, Int)]
+kk_modifiers_p = P.many kk_modifier_p
+
+-- * Contextual note
+
+{- | A note where all fields are optional.
+If the note number is absent it indicates a rest.
+All other fields infer values from the phrase context.
+-}
+data Kk_Contextual_Note =
+  Kk_Contextual_Note
+  {kk_contextual_note_number :: Maybe Int
+  ,kk_contextual_note_octave :: Maybe Int
+  ,kk_contextual_note_volume :: Maybe Int
+  ,kk_contextual_note_duration :: Maybe Int
+  ,kk_contextual_note_channel :: Maybe Int
+  ,kk_contextual_note_time :: Maybe Int}
+  deriving (Eq, Ord, Show)
+
+kk_empty_contextual_note :: Kk_Contextual_Note
+kk_empty_contextual_note = Kk_Contextual_Note Nothing Nothing Nothing Nothing Nothing Nothing
+
+kk_empty_contextual_rest :: Int -> Kk_Contextual_Note
+kk_empty_contextual_rest n = kk_empty_contextual_note {kk_contextual_note_duration = Just n}
+
+{- | If t is set and is at the end time of the previous note print a preceding comma, else print t annotation.
+
+> c = kk_empty_contextual_note {kk_contextual_note_number = Just 0, kk_contextual_time = Just 96}
+> map (\t -> kk_contextual_note_pp (t, c)) [0, 96] == ["ct96",", c"]
+-}
+kk_contextual_note_pp :: (Int, Kk_Contextual_Note) -> String
+kk_contextual_note_pp (t', Kk_Contextual_Note n o v d c t) =
+  let f i j = maybe "" ((if i == 'o' then id else (i :)) . show) j
+      (pre, t'') = if t == Just t' then (", ","") else ("", f 't' t)
+  in case n of
+          Nothing -> concat [pre, "r", f 'd' d, t'']
+          Just k -> concat [pre, kk_note_number_to_name k, f 'o' o, f 'v' v, f 'd' d, f 'c' c, t'']
+
+{- | If the note number is given as p60, then derive octave of and set it, ignoring any modifier.
+Note that in KeyKit c3 is p60 or middle c.
+-}
+kk_contextual_note_p :: P Kk_Contextual_Note
+kk_contextual_note_p = do
+  n <- fmap Just kk_note_number_p P.<|> (kk_rest_p >> return Nothing)
+  m <- kk_modifiers_p
+  _ <- P.many P.space
+  let get c = lookup c m
+      (n', o) =
+        case n of
+          Just n'' ->
+            if n'' > 11
+            then
+              let (o', n''') = n'' `divMod` 12
+              in (Just n''', Just (o' - 2))
+            else (n, get 'o')
+          Nothing -> (Nothing, Nothing)
+  return (Kk_Contextual_Note n' o (get 'v') (get 'd') (get 'c') (get 't'))
+
+kk_contextual_note_is_rest :: Kk_Contextual_Note -> Bool
+kk_contextual_note_is_rest = isNothing . kk_contextual_note_number
+
+kk_comma_p :: P Char
+kk_comma_p = kk_lexeme (P.char ',')
+
+-- | A contextual note and an is_parallel? indicator.
+kk_contextual_phrase_element_p :: P (Kk_Contextual_Note, Bool)
+kk_contextual_phrase_element_p = do
+  n <- kk_contextual_note_p
+  c <- P.optionMaybe kk_comma_p
+  return (n, isNothing c)
+
+kk_contextual_phrase_p :: P [(Kk_Contextual_Note, Bool)]
+kk_contextual_phrase_p = P.many kk_contextual_phrase_element_p
+
+-- * Note
+
+-- | A note with all fields required.
+data Kk_Note =
+  Kk_Note
+  {kk_note_number :: Int
+  ,kk_note_octave :: Int
+  ,kk_note_volume :: Int
+  ,kk_note_duration :: Int
+  ,kk_note_channel :: Int
+  ,kk_note_time :: Int}
+  deriving (Eq, Ord, Show)
+
+kk_default_note :: Kk_Note
+kk_default_note = Kk_Note 60 3 63 96 1 0
+
+kk_note_to_initial_contextual_note :: Kk_Note -> Kk_Contextual_Note
+kk_note_to_initial_contextual_note (Kk_Note n o v d c t) =
+  let f i j = if i == j then Nothing else Just i
+  in Kk_Contextual_Note (Just n) (f o 3) (f v 63) (f d 96) (f c 1) (f t 0)
+
+kk_note_to_contextual_note :: Kk_Note -> Kk_Note -> (Int, Kk_Contextual_Note)
+kk_note_to_contextual_note (Kk_Note _ o' v' d' c' t') (Kk_Note n o v d c t) =
+  let f i j = if i == j then Nothing else Just i
+  in (t' + d', Kk_Contextual_Note (Just n) (f o o') (f v v') (f d d') (f c c') (f t t'))
+
+-- | Elide octave modifier character.
+kk_note_pp :: Kk_Note -> String
+kk_note_pp (Kk_Note n o v d c t) = printf "%s%dv%dd%dc%dt%d" (kk_note_number_to_name n) o v d c t
+
+kk_decontextualise_note :: Kk_Note -> Bool -> Kk_Contextual_Note -> Either Kk_Note Int
+kk_decontextualise_note (Kk_Note _ o v d c t) is_par (Kk_Contextual_Note k' o' v' d' c' t') =
+  let t'' = fromMaybe (if is_par then t else t + d) t'
+  in case k' of
+    Just k'' -> Left (Kk_Note k'' (fromMaybe o o') (fromMaybe v v') (fromMaybe d d') (fromMaybe c c') t'')
+    Nothing -> Right t''
+
+data Kk_Phrase = Kk_Phrase { kk_phrase_notes :: [Kk_Note], kk_phrase_length :: Int } deriving (Eq, Show)
+
+-- | This should, but does not, append a trailing rest as required.
+kk_phrase_pp :: Kk_Phrase -> String
+kk_phrase_pp (Kk_Phrase n _) = unwords (map kk_note_pp n)
+
+-- | Rests are elided, their duration is accounted for in the time of the following notetaken into account.
+kk_decontextualise_phrase :: [(Kk_Contextual_Note, Bool)] -> Kk_Phrase
+kk_decontextualise_phrase =
+  let f r c p l =
+        case l of
+          [] -> Kk_Phrase (reverse r) (kk_note_time c + kk_note_duration c)
+          (n,p'):l' ->
+            case kk_decontextualise_note c p n of
+              Left c' -> f (c' : r) c' p' l'
+              Right t' -> f r (c {kk_note_time = t'}) p' l'
+  in f [] kk_default_note True
+
+-- | In addition to contextual note give end time of previous note, to allow for sequence (comma) notation.
+kk_recontextualise_phrase :: Kk_Phrase -> [(Int, Kk_Contextual_Note)]
+kk_recontextualise_phrase p =
+  let f n0 n =
+        case n of
+          [] -> []
+          n1 : n' -> kk_note_to_contextual_note n0 n1 : f n1 n'
+  in case p of
+    Kk_Phrase [] l -> [(0, kk_empty_contextual_rest l)]
+    Kk_Phrase (n1 : n') _ ->
+      let c1 = kk_note_to_initial_contextual_note n1
+      in (0, c1) : f n1 n'
+
+{- | Read KeyKit phrase constant.
+
+> let rw = (\p -> (kk_phrase_pp p, kk_phrase_length p)) . kk_phrase_read
+> rw "c" == ("c3v63d96c1t0",96)
+> rw "c, r" == ("c3v63d96c1t0",192)
+> rw "c, r, c3, r, p60" == ("c3v63d96c1t0 c3v63d96c1t192 c3v63d96c1t384",480)
+> rw "c, e, g" == ("c3v63d96c1t0 e3v63d96c1t96 g3v63d96c1t192",288)
+> rw "c2" == rw "co2"
+-}
+kk_phrase_read :: String -> Kk_Phrase
+kk_phrase_read = kk_decontextualise_phrase . kk_parse kk_contextual_phrase_p
+
+{- | Re-contextualise and print phrase.
+
+> rw = kk_phrase_print . kk_phrase_read
+> rw_id i = rw i == i
+> rw_id "c"
+> rw_id "c e g"
+> rw_id "c , e , g"
+> rw_id "c e g , c f a , c e g , c e- g"
+> rw_id "c , e , g c4t384"
+> rw "c, r, c3, r, p60" == "c ct192 ct384"
+> rw "c , e , g c4t288" == "c , e , g , c4"
+> rw "c r" == "c" -- ?
+-}
+kk_phrase_print :: Kk_Phrase -> String
+kk_phrase_print = unwords . map kk_contextual_note_pp . kk_recontextualise_phrase
diff --git a/Music/Theory/Time/Notation.hs b/Music/Theory/Time/Notation.hs
deleted file mode 100644
--- a/Music/Theory/Time/Notation.hs
+++ /dev/null
@@ -1,127 +0,0 @@
-module Music.Theory.Time.Notation where
-
-import Data.List.Split {- split -}
-import Text.Printf {- base -}
-
--- | Fractional seconds.
-type FSEC = Double
-
--- | Minutes, seconds as @(min,sec)@
-type MinSec n = (n,n)
-
--- | Type specialised.
-type MINSEC = (Int,Int)
-
--- | Minutes, seconds, centi-seconds as @(min,sec,csec)@
-type MinCsec n = (n,n,n)
-
--- | Type specialised.
-type MINCSEC = (Int,Int,Int)
-
--- | 'divMod' by @60@.
---
--- > sec_to_minsec 123 == (2,3)
-sec_to_minsec :: Integral n => n -> MinSec n
-sec_to_minsec = flip divMod 60
-
--- | Inverse of 'sec_minsec'.
---
--- > minsec_to_sec (2,3) == 123
-minsec_to_sec :: Num n => MinSec n -> n
-minsec_to_sec (m,s) = m * 60 + s
-
-minsec_binop :: Integral t => (t -> t -> t) -> MinSec t -> MinSec t -> MinSec t
-minsec_binop f p q = sec_to_minsec (f (minsec_to_sec p) (minsec_to_sec q))
-
--- | 'minsec_binop' '-', assumes /q/ precedes /p/.
---
--- > minsec_sub (2,35) (1,59) == (0,36)
-minsec_sub :: Integral n => MinSec n -> MinSec n -> MinSec n
-minsec_sub = minsec_binop (-)
-
--- | 'minsec_binop' 'subtract', assumes /p/ precedes /q/.
---
--- > minsec_diff (1,59) (2,35) == (0,36)
-minsec_diff :: Integral n => MinSec n -> MinSec n -> MinSec n
-minsec_diff = minsec_binop subtract
-
--- | 'minsec_binop' '+'.
---
--- > minsec_add (1,59) (2,35) == (4,34)
-minsec_add :: Integral n => MinSec n -> MinSec n -> MinSec n
-minsec_add = minsec_binop (+)
-
--- | 'foldl' of 'minsec_add'
---
--- > minsec_sum [(1,59),(2,35),(4,34)] == (9,08)
-minsec_sum :: Integral n => [MinSec n] -> MinSec n
-minsec_sum = foldl minsec_add (0,0)
-
--- | Fractional seconds to @(min,sec)@.
---
--- > map fsec_to_minsec [59.49,60,60.51] == [(0,59),(1,0),(1,1)]
-fsec_to_minsec :: FSEC -> MINSEC
-fsec_to_minsec = sec_to_minsec . round
-
--- | 'MINSEC' pretty printer.
---
--- > map (minsec_pp . fsec_to_minsec) [59,61] == ["00:59","01:01"]
-minsec_pp :: MINSEC -> String
-minsec_pp (m,s) = printf "%02d:%02d" m s
-
--- * 'MinSec' parser.
-minsec_parse :: (Num n,Read n) => String -> MinSec n
-minsec_parse x =
-    case splitOn ":" x of
-      [m,s] -> (read m,read s)
-      _ -> error "parse_minsec"
-
--- | Fractional seconds to @(min,sec,csec)@, csec value is 'round'ed.
---
--- > map fsec_to_mincsec [1,1.5,4/3] == [(0,1,0),(0,1,50),(0,1,33)]
-fsec_to_mincsec :: FSEC -> MINCSEC
-fsec_to_mincsec tm =
-    let tm' = floor tm
-        (m,s) = sec_to_minsec tm'
-        cs = round ((tm - fromIntegral tm') * 100)
-    in (m,s,cs)
-
--- | Inverse of 'fsec_mincsec'.
-mincsec_to_fsec :: Real n => MinCsec n -> FSEC
-mincsec_to_fsec (m,s,cs) = realToFrac m * 60 + realToFrac s + (realToFrac cs / 100)
-
--- > map (mincsec_to_csec . fsec_to_mincsec) [1,6+2/3,123.45] == [100,667,12345]
-mincsec_to_csec :: Num n => MinCsec n -> n
-mincsec_to_csec (m,s,cs) = m * 60 * 100 + s * 100 + cs
-
--- | Centi-seconds to 'MinCsec'.
---
--- > map csec_to_mincsec [123,12345] == [(0,1,23),(2,3,45)]
-csec_to_mincsec :: Integral n => n -> MinCsec n
-csec_to_mincsec csec =
-    let (m,cs) = csec `divMod` 6000
-        (s,cs') = cs `divMod` 100
-    in (m,s,cs')
-
--- | 'MINCSEC' pretty printer, concise mode omits centiseconds when zero.
---
--- > map (mincsec_pp_opt True . fsec_to_mincsec) [1,60.5] == ["00:01","01:00.50"]
-mincsec_pp_opt :: Bool -> MINCSEC -> String
-mincsec_pp_opt concise (m,s,cs) =
-  if concise && cs == 0
-  then printf "%02d:%02d" m s
-  else printf "%02d:%02d.%02d" m s cs
-
--- | 'MINCSEC' pretty printer.
---
--- > let r = ["00:01.00","00:06.67","02:03.45"]
--- > map (mincsec_pp . fsec_to_mincsec) [1,6+2/3,123.45] == r
-mincsec_pp :: MINCSEC -> String
-mincsec_pp = mincsec_pp_opt False
-
-mincsec_binop :: Integral t => (t -> t -> t) -> MinCsec t -> MinCsec t -> MinCsec t
-mincsec_binop f p q = csec_to_mincsec (f (mincsec_to_csec p) (mincsec_to_csec q))
-
--- | Given printer, pretty print time span.
-span_pp :: (t -> String) -> (t,t) -> String
-span_pp f (t1,t2) = concat [f t1," - ",f t2]
diff --git a/Music/Theory/Time/Seq.hs b/Music/Theory/Time/Seq.hs
--- a/Music/Theory/Time/Seq.hs
+++ b/Music/Theory/Time/Seq.hs
@@ -1,60 +1,74 @@
 -- | Basic temporal sequence functions.
 module Music.Theory.Time.Seq where
 
+import Data.Bifunctor {- base -}
 import Data.Function {- base -}
 import Data.List {- base -}
-import qualified Data.List.Ordered as O {- data-ordlist -}
-import qualified Data.Map as M {- containers -}
 import Data.Maybe {- base -}
 import Data.Ratio {- base -}
 import Safe {- safe -}
 
-import Music.Theory.Function {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Math as T {- hmt -}
-import qualified Music.Theory.Ord as T {- hmt -}
-import qualified Music.Theory.Tuple as T {- hmt -}
+import qualified Data.List.Ordered as O {- data-ordlist -}
+import qualified Data.Map as Map {- containers -}
 
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Math as T {- hmt-base -}
+import qualified Music.Theory.Ord as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
+
 -- * Types
 
 -- | Sequence of elements with uniform duration.
 type Useq t a = (t,[a])
 
--- | Duration sequence.  The duration is the /forward/ duration of the
--- value, if it has other durations they must be encoded at /a/.
+-- | Duration sequence.
+-- /t/ indicates the /forward/ duration of the value, ie. the interval to the next value.
+-- If there are other durations they must be encoded at /a/.
+-- If the sequence does not begin at time zero there must be an /empty/ value for /a/.
 type Dseq t a = [(t,a)]
 
--- | Inter-offset sequence.  The duration is the interval /before/ the
--- value.  To indicate the duration of the final value /a/ must have
--- a /nil/ (end of sequence) value.
+-- | Inter-offset sequence.
+-- /t/ is the interval /before/ the value.
+-- Duration can be encoded at /a/, or if implicit /a/ must include an end of sequence value.
 type Iseq t a = [(t,a)]
 
--- | Pattern sequence.  The duration is a triple of /logical/,
--- /sounding/ and /forward/ durations.
+-- | Pattern sequence.
+-- The duration is a triple of /logical/, /sounding/ and /forward/ durations.
+-- These indicate the time the value conceptually takes, the time it actually takes, and the time to the next event.
+-- If the sequence does not begin at time zero there must be an /empty/ value for /a/.
 type Pseq t a = [((t,t,t),a)]
 
--- | Time-point sequence.  To express holes /a/ must have an /empty/
--- value.  To indicate the duration of the final value /a/ must have
--- a /nil/ (end of sequence) value.
+-- | Time-point sequence.
+-- /t/ is the start time of the value.
+-- To express holes /a/ must have an /empty/ value.
+-- Duration can be encoded at /a/, or if implicit /a/ must include an end of sequence value.
 type Tseq t a = [(t,a)]
 
--- | Window sequence.  The temporal field is (/time/,/duration/).
--- Holes exist where @t(n) + d(n)@ '<' @t(n+1)@.  Overlaps exist where
--- the same relation is '>'.
+-- | Window sequence.
+-- /t/ is a duple of /start-time/ and /duration/.
+-- Holes exist where /start-time(n) + duration(n) < start-time(n + 1)/.
+-- Overlaps exist where the same relation is '>'.
 type Wseq t a = [((t,t),a)]
 
+-- | Event sequence.
+-- /t/ is a triple of /start-time/, /duration/ and /length/.
+-- /length/ isn't necessarily the time to the next event, though ordinarily it should not be greater than that interval.
+type Eseq t a = [((t,t,t),a)]
+
 -- * Zip
 
+-- | Construct 'Pseq'.
 pseq_zip :: [t] -> [t] -> [t] -> [a] -> Pseq t a
-pseq_zip l o f a = (zip (zip3 l o f) a)
+pseq_zip l o f = zip (zip3 l o f)
 
+-- | Construct 'Wseq'.
 wseq_zip :: [t] -> [t] -> [a] -> Wseq t a
-wseq_zip t d a = (zip (zip t d) a)
+wseq_zip t d = zip (zip t d)
 
 -- * Time span
 
--- | Given functions for deriving start and end times calculate time
--- span of sequence.
+-- | Given functions for deriving start and end times calculate time span of sequence.
+--   Requires sequence be finite.
 --
 -- > seq_tspan id id [] == (0,0)
 -- > seq_tspan id id (zip [0..9] ['a'..]) == (0,9)
@@ -63,9 +77,11 @@
     (maybe 0 (st . fst) (headMay sq)
     ,maybe 0 (et . fst) (lastMay sq))
 
+-- | 'seq_tspan' for 'Tseq'.
 tseq_tspan :: Num t => Tseq t a -> (t,t)
 tseq_tspan = seq_tspan id id
 
+-- | 'seq_tspan' for 'Wseq'.
 wseq_tspan :: Num t => Wseq t a -> (t,t)
 wseq_tspan = seq_tspan fst (uncurry (+))
 
@@ -85,22 +101,25 @@
 
 -- * Duration
 
+-- | Sum durations at 'Dseq', result is the end time of the last element.
 dseq_dur :: Num t => Dseq t a -> t
 dseq_dur = sum . map fst
 
+-- | Sum durations at 'Iseq', result is the start time of the last element.
 iseq_dur :: Num t => Iseq t a -> t
 iseq_dur = sum . map fst
 
+-- | Sum durations at 'Pseq', result is the end time of the last element.
 pseq_dur :: Num t => Pseq t a -> t
 pseq_dur = sum . map (T.t3_third . fst)
 
--- | The interval of 'tseq_tspan'.
+-- | The interval of 'tseq_tspan', ie. from the start of the first element to the start of the last.
 --
 -- > tseq_dur (zip [0..] "abcde|") == 5
 tseq_dur :: Num t => Tseq t a -> t
 tseq_dur = uncurry subtract . tseq_tspan
 
--- | The interval of 'wseq_tspan'.
+-- | The interval of 'wseq_tspan', ie. from the start of the first element to the end of the last.
 --
 -- > wseq_dur (zip (zip [0..] (repeat 2)) "abcde") == 6
 wseq_dur :: Num t => Wseq t a -> t
@@ -108,8 +127,7 @@
 
 -- * Window
 
--- | Prefix of sequence where the start time precedes or is at the
--- indicate time.
+-- | Prefix of sequence where the start time precedes or is at the indicated time.
 wseq_until :: Ord t => t -> Wseq t a -> Wseq t a
 wseq_until tm = takeWhile (\((t0,_),_) -> t0 <= tm)
 
@@ -118,7 +136,7 @@
 -- edges, ie. [t0,t1].  Halts processing at end of window.
 --
 -- > let r = [((5,1),'e'),((6,1),'f'),((7,1),'g'),((8,1),'h')]
--- > in wseq_twindow (5,9) (zip (zip [1..] (repeat 1)) ['a'..]) == r
+-- > wseq_twindow (5,9) (zip (zip [1..] (repeat 1)) ['a'..]) == r
 --
 -- > wseq_twindow (1,2) [((1,1),'a'),((1,2),'b')] == [((1,1),'a')]
 wseq_twindow :: (Num t, Ord t) => (t,t) -> Wseq t a -> Wseq t a
@@ -131,7 +149,7 @@
 -- of window.
 --
 -- > let sq = [((1,1),'a'),((1,2),'b')]
--- > in map (wseq_at sq) [1,2] == [sq,[((1,2),'b')]]
+-- > map (wseq_at sq) [1,2] == [sq,[((1,2),'b')]]
 --
 -- > wseq_at (zip (zip [1..] (repeat 1)) ['a'..]) 3 == [((3,1),'c')]
 wseq_at :: (Num t,Ord t) => Wseq t a -> t -> Wseq t a
@@ -145,7 +163,7 @@
 -- of window.
 --
 -- > let sq = [((0,2),'a'),((0,4),'b'),((2,4),'c')]
--- > in wseq_at_window sq (1,3) == sq
+-- > wseq_at_window sq (1,3) == sq
 --
 -- > wseq_at_window (zip (zip [1..] (repeat 1)) ['a'..]) (3,4) == [((3,1),'c'),((4,1),'d')]
 wseq_at_window :: (Num t, Ord t) => Wseq t a -> (t,t) -> Wseq t a
@@ -156,12 +174,15 @@
 
 -- * Append
 
+-- | Type specialised '++'
 dseq_append :: Dseq t a -> Dseq t a -> Dseq t a
 dseq_append = (++)
 
+-- | Type specialised '++'
 iseq_append :: Iseq t a -> Iseq t a -> Iseq t a
 iseq_append = (++)
 
+-- | Type specialised '++'
 pseq_append :: Pseq t a -> Pseq t a -> Pseq t a
 pseq_append = (++)
 
@@ -206,6 +227,10 @@
 wseq_merge_set :: Ord t => [Wseq t a] -> Wseq t a
 wseq_merge_set = T.merge_set_by w_compare
 
+-- | Merge considering only start times.
+eseq_merge :: Ord t => Eseq t a -> Eseq t a -> Eseq t a
+eseq_merge = O.mergeBy (compare `on` (T.t3_fst . fst))
+
 -- * Lookup
 
 -- | Locate nodes to the left and right of indicated time.
@@ -237,13 +262,17 @@
 
 -- * Lseq
 
-data Interpolation_T = None | Linear
-                     deriving (Eq,Enum,Show)
+-- | Iterpolation type enumeration.
+data Interpolation_T =
+  None | Linear
+  deriving (Eq,Enum,Show)
 
 -- | Variant of 'Tseq' where nodes have an 'Intepolation_T' value.
 type Lseq t a = Tseq (t,Interpolation_T) a
 
--- | Linear interpolation.
+{- | Linear interpolation.
+     The Real constraint on t is to allow conversion from t to e (realToFrac).
+-}
 lerp :: (Fractional t,Real t,Fractional e) => (t,e) -> (t,e) -> t -> e
 lerp (t0,e0) (t1,e1) t =
     let n = t1 - t0
@@ -272,41 +301,45 @@
 
 -- * Map, Filter, Find
 
-seq_tmap :: (t -> t') -> [(t,a)] -> [(t',a)]
-seq_tmap f = map (\(p,q) -> (f p,q))
+-- | 'map' over time (/t/) data.
+seq_tmap :: (t1 -> t2) -> [(t1,a)] -> [(t2,a)]
+seq_tmap f = map (first f)
 
-seq_map :: (b -> c) -> [(a,b)] -> [(a,c)]
-seq_map f = map (\(p,q) -> (p,f q))
+-- | 'map' over element (/e/) data.
+seq_map :: (e1 -> e2) -> [(t,e1)] -> [(t,e2)]
+seq_map f = map (second f)
 
--- | Map /t/ and /e/ simultaneously.
-seq_bimap :: (t -> t') -> (e -> e') -> [(t,e)] -> [(t',e')]
-seq_bimap f g = map (\(p,q) -> (f p,g q))
+-- | 'map' /t/ and /e/ simultaneously.
+--
+-- > seq_bimap negate succ (zip [1..5] [0..4]) == [(-1,1),(-2,2),(-3,3),(-4,4),(-5,5)]
+seq_bimap :: (t1 -> t2) -> (e1 -> e2) -> [(t1,e1)] -> [(t2,e2)]
+seq_bimap f = map . bimap f
 
+-- | 'filter' over time (/t/) data.
 seq_tfilter :: (t -> Bool) -> [(t,a)] -> [(t,a)]
 seq_tfilter f = filter (f . fst)
 
+-- | 'filter' over element (/e/) data.
 seq_filter :: (b -> Bool) -> [(a,b)] -> [(a,b)]
 seq_filter f = filter (f . snd)
 
-seq_find :: (a -> Bool) -> [(t,a)] -> Maybe (t,a)
-seq_find f = let f' (_,a) = f a in find f'
+-- | 'find' over element (/e/) data.
+seq_find :: (e -> Bool) -> [(t,e)] -> Maybe (t,e)
+seq_find f = find (f . snd)
 
 -- * Maybe
 
 -- | 'mapMaybe' variant.
 seq_map_maybe :: (p -> Maybe q) -> [(t,p)] -> [(t,q)]
 seq_map_maybe f =
-    let g (t,e) = maybe Nothing (\e' -> Just (t,e')) (f e)
+    let g (t,e) = fmap (\e' -> (t,e')) (f e)
     in mapMaybe g
 
 -- | Variant of 'catMaybes'.
 seq_cat_maybes :: [(t,Maybe q)] -> [(t,q)]
 seq_cat_maybes = seq_map_maybe id
 
--- | If value is unchanged, according to /f/, replace with 'Nothing'.
---
--- > let r = [(1,'s'),(2,'t'),(4,'r'),(6,'i'),(7,'n'),(9,'g')]
--- > in seq_cat_maybes (seq_changed_by (==) (zip [1..] "sttrrinng")) == r
+-- | If value is unchanged at subsequent entry, according to /f/, replace with 'Nothing'.
 seq_changed_by :: (a -> a -> Bool) -> [(t,a)] -> [(t,Maybe a)]
 seq_changed_by f l =
     let recur z sq =
@@ -320,6 +353,9 @@
          (t,e) : l' -> (t,Just e) : recur e l'
 
 -- | 'seq_changed_by' '=='.
+--
+-- > let r = [(1,'s'),(2,'t'),(4,'r'),(6,'i'),(7,'n'),(9,'g')]
+-- > seq_cat_maybes (seq_changed (zip [1..] "sttrrinng")) == r
 seq_changed :: Eq a => [(t,a)] -> [(t,Maybe a)]
 seq_changed = seq_changed_by (==)
 
@@ -327,11 +363,11 @@
 
 -- | Apply /f/ at time points of 'Wseq'.
 wseq_tmap_st :: (t -> t) -> Wseq t a -> Wseq t a
-wseq_tmap_st f = let g (t,d) = (f t,d) in seq_tmap g
+wseq_tmap_st f = seq_tmap (first f)
 
 -- | Apply /f/ at durations of elements of 'Wseq'.
 wseq_tmap_dur :: (t -> t) -> Wseq t a -> Wseq t a
-wseq_tmap_dur f = let g (t,d) = (t,f d) in seq_tmap g
+wseq_tmap_dur f = seq_tmap (second f)
 
 -- * Partition
 
@@ -339,21 +375,22 @@
 -- a sequence into voices.
 seq_partition :: Ord v => (a -> v) -> [(t,a)] -> [(v,[(t,a)])]
 seq_partition voice sq =
-    let assign m (t,a) = M.insertWith (++) (voice a) [(t,a)] m
+    let assign m (t,a) = Map.insertWith (++) (voice a) [(t,a)] m
         from_map = sortOn fst .
-                   map (\(v,l) -> (v,reverse l)) .
-                   M.toList
-    in from_map (foldl assign M.empty sq)
+                   map (second reverse) .
+                   Map.toList
+    in from_map (foldl assign Map.empty sq)
 
 -- | Type specialised 'seq_partition'.
 --
--- > let {p = zip [0,1,3,5] (zip (repeat 0) "abcd")
--- >     ;q = zip [2,4,6,7] (zip (repeat 1) "ABCD")
--- >     ;sq = tseq_merge p q}
--- > in tseq_partition fst sq == [(0,p),(1,q)]
+-- > let p = zip [0,1,3,5] (zip (repeat 0) "abcd")
+-- > let q = zip [2,4,6,7] (zip (repeat 1) "ABCD")
+-- > let sq = tseq_merge p q
+-- > tseq_partition fst sq == [(0,p),(1,q)]
 tseq_partition :: Ord v => (a -> v) -> Tseq t a -> [(v,Tseq t a)]
 tseq_partition = seq_partition
 
+-- | Type specialised 'seq_partition'.
 wseq_partition :: Ord v => (a -> v) -> Wseq t a -> [(v,Wseq t a)]
 wseq_partition = seq_partition
 
@@ -381,16 +418,17 @@
 coalesce_m :: Monoid t => (t -> t -> Bool) -> [t] -> [t]
 coalesce_m dec_f = coalesce_f dec_f mappend
 
--- | Form of 'coalesce_f' where the decision predicate is on the
--- /element/, and a join function sums the /times/.
---
--- > let r = [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
--- > in seq_coalesce (==) const (useq_to_dseq (1,"abbcccdde")) == r
+-- | Form of 'coalesce_t' where the join predicate is on the /element/ only, the /times/ are summed.
+coalesce_t :: Num t => ((t,a) -> (t,a) -> Bool) -> (a -> a -> a) -> [(t,a)] -> [(t,a)]
+coalesce_t dec_f jn_f = coalesce_f dec_f (\(t1,a1) (t2,a2) -> (t1 + t2,jn_f a1 a2))
+
+{- | Form of 'coalesce_f' where both the decision and join predicates are on the/element/, the /times/ are summed.
+
+> let r = [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
+> seq_coalesce (==) const (useq_to_dseq (1,"abbcccdde")) == r
+-}
 seq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> [(t,a)] -> [(t,a)]
-seq_coalesce dec_f jn_f =
-    let dec_f' = dec_f `on` snd
-        jn_f' (t1,a1) (t2,a2) = (t1 + t2,jn_f a1 a2)
-    in coalesce_f dec_f' jn_f'
+seq_coalesce dec_f jn_f = coalesce_t (dec_f `on` snd) jn_f
 
 dseq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> Dseq t a -> Dseq t a
 dseq_coalesce = seq_coalesce
@@ -400,12 +438,12 @@
 -- 'dseq_coalesce' where the /join/ function is 'const'.  The
 -- implementation is simpler and non-recursive.
 --
--- > let {d = useq_to_dseq (1,"abbcccdde")
--- >     ;r = dseq_coalesce (==) const d}
--- > in dseq_coalesce' (==) d == r
+-- > let d = useq_to_dseq (1,"abbcccdde")
+-- > let r = dseq_coalesce (==) const d
+-- > dseq_coalesce' (==) d == r
 dseq_coalesce' :: Num t => (a -> a -> Bool) -> Dseq t a -> Dseq t a
 dseq_coalesce' eq =
-    let f l = let (t,e:_) = unzip l in (sum t,e)
+    let f l = let (t,e) = unzip l in (sum t,head e)
     in map f . groupBy (eq `on` snd)
 
 iseq_coalesce :: Num t => (a -> a -> Bool) -> (a -> a -> a) -> Iseq t a -> Iseq t a
@@ -422,6 +460,7 @@
 tseq_tcoalesce :: Eq t => (a -> a -> a) -> Tseq t a -> Tseq t a
 tseq_tcoalesce = seq_tcoalesce (==)
 
+-- | Type specialised 'seq_tcoalesce'.
 wseq_tcoalesce :: ((t,t) -> (t,t) -> Bool) -> (a -> a -> a) -> Wseq t a -> Wseq t a
 wseq_tcoalesce = seq_tcoalesce
 
@@ -430,7 +469,7 @@
 -- | Post-process 'groupBy' of /cmp/ 'on' 'fst'.
 --
 -- > let r = [(0,"a"),(1,"bc"),(2,"de"),(3,"f")]
--- > in group_f (==) (zip [0,1,1,2,2,3] ['a'..]) == r
+-- > group_f (==) (zip [0,1,1,2,2,3] ['a'..]) == r
 group_f :: (Eq t,Num t) => (t -> t -> Bool) -> [(t,a)] -> [(t,[a])]
 group_f cmp =
     let f l = let (t,a) = unzip l
@@ -442,7 +481,7 @@
 -- | Group values at equal time points.
 --
 -- > let r = [(0,"a"),(1,"bc"),(2,"de"),(3,"f")]
--- > in tseq_group (zip [0,1,1,2,2,3] ['a'..]) == r
+-- > tseq_group (zip [0,1,1,2,2,3] ['a'..]) == r
 --
 -- > tseq_group [(1,'a'),(1,'b')] == [(1,"ab")]
 -- > tseq_group [(1,'a'),(2,'b'),(2,'c')] == [(1,"a"),(2,"bc")]
@@ -452,16 +491,17 @@
 -- | Group values where the inter-offset time is @0@ to the left.
 --
 -- > let r = [(0,"a"),(1,"bcd"),(1,"ef")]
--- > in iseq_group (zip [0,1,0,0,1,0] ['a'..]) == r
+-- > iseq_group (zip [0,1,0,0,1,0] ['a'..]) == r
 iseq_group :: (Eq t,Num t) => Iseq t a -> Iseq t [a]
 iseq_group = group_f (\_ d -> d == 0)
 
 -- * Fill
 
 -- | Set durations so that there are no gaps or overlaps.
+--   For entries with the same start time this leads to zero durations.
 --
--- > let r = wseq_zip [0,3,5] [3,2,1] "abc"
--- > in wseq_fill_dur (wseq_zip [0,3,5] [2,1,1] "abc") == r
+-- > let r = wseq_zip [0,3,3,5] [3,0,2,1] "abcd"
+-- > wseq_fill_dur (wseq_zip [0,3,3,5] [2,1,2,1] "abcd") == r
 wseq_fill_dur :: Num t => Wseq t a -> Wseq t a
 wseq_fill_dur l =
     let f (((t1,_),e),((t2,_),_)) = ((t1,t2-t1),e)
@@ -479,6 +519,10 @@
         t_f n = T.rational_whole_err (n * fromIntegral m)
     in map (dseq_tmap t_f) sq
 
+-- | End-time of sequence (ie. sum of durations).
+dseq_end :: Num t => Dseq t a -> t
+dseq_end = sum . map fst
+
 -- * Tseq
 
 -- | Given a a default value, a 'Tseq' /sq/ and a list of time-points
@@ -497,6 +541,14 @@
                                    EQ -> (sq_t,sq_e) : tseq_latch sq_e sq' t'
                                    GT -> (t0,def) : tseq_latch def sq t'
 
+-- | End-time of sequence (ie. time of last event).
+tseq_end :: Tseq t a -> t
+tseq_end = fst . last
+
+-- | Append the value /nil/ at /n/ seconds after the end of the sequence.
+tseq_add_nil_after :: Num t => a -> t -> Tseq t a -> Tseq t a
+tseq_add_nil_after nil n sq = sq ++ [(tseq_end sq + n,nil)]
+
 -- * Wseq
 
 -- | Sort 'Wseq' by start time, 'Wseq' ought never to be out of
@@ -506,56 +558,91 @@
 wseq_sort :: Ord t => Wseq t a -> Wseq t a
 wseq_sort = sortBy (compare `on` (fst . fst))
 
--- | Transform 'Wseq' to 'Tseq' by discaring durations.
+-- | Transform 'Wseq' to 'Tseq' by discarding durations.
 wseq_discard_dur :: Wseq t a -> Tseq t a
 wseq_discard_dur = let f ((t,_),e) = (t,e) in map f
 
-wseq_overlap_f :: (Eq e,Ord t,Num t) =>
-                  (e -> e -> Bool) -> (t -> t) -> ((t,t),e) -> Wseq t e -> Maybe (Wseq t e)
-wseq_overlap_f eq_fn dur_fn ((t,d),a) sq =
-  case find (eq_fn a . snd) sq of
-    Nothing -> Nothing
-    Just ((t',d'),a') ->
-      if t == t'
-      then if d <= d'
-           then Just sq -- delete LHS
-           else Just (((t,d),a) : delete ((t',d'),a') sq) -- delete RHS
-      else if t' < t + d
-           then Just (((t,dur_fn (t' - t)),a) : sq) -- truncate LHS
-           else Nothing
+-- | Are /e/ equal and do nodes overlap?
+--   Nodes are ascending, and so overlap if:
+--   1. they begin at the same time and the first has non-zero duration, or
+--   2. the second begins before the first ends.
+wseq_nodes_overlap :: (Ord t,Num t) => (e -> e -> Bool) -> ((t,t),e) -> ((t,t),e) -> Bool
+wseq_nodes_overlap eq_f ((t1,d1),a1) ((t2,_d2),a2) =
+  eq_f a1 a2 && ((t1 == t2 && d1 > 0) || (t2 < (t1 + d1)))
 
--- | Determine if sequence has overlapping equal nodes.
-wseq_has_overlaps :: (Ord t, Num t, Eq e) => (e -> e -> Bool) -> Wseq t e -> Bool
+-- | Find first node at /sq/ that overlaps with /e0/, if there is one.
+--   Note: this could, but does not, halt early, ie. when t2 > (t1 + d1).
+wseq_find_overlap_1 :: (Ord t,Num t) => (e -> e -> Bool) -> ((t,t),e) -> Wseq t e -> Bool
+wseq_find_overlap_1 eq_f e0 = isJust . find (wseq_nodes_overlap eq_f e0)
+
+-- | Determine if sequence has any overlapping equal nodes, stops after finding first instance.
+--
+-- > wseq_has_overlaps (==) [] == False
+-- > wseq_has_overlaps (==) [((0,1),'x')]
+wseq_has_overlaps :: (Ord t, Num t) => (e -> e -> Bool) -> Wseq t e -> Bool
 wseq_has_overlaps eq_fn =
   let recur sq =
         case sq of
           [] -> False
-          h:sq' ->
-            case wseq_overlap_f eq_fn id h sq' of
-              Nothing -> recur sq'
-              Just _ -> True
-    in recur
+          e0:sq' -> wseq_find_overlap_1 eq_fn e0 sq' || recur sq'
+  in recur
 
+{- | Remove overlaps by deleting any overlapping nodes.
 
-{- | Edit durations to ensure that nodes don't overlap.  If equal nodes
-     begin simultaneously delete the shorter node.  If a node
-     extends into a later node shorten the initial duration (apply /dur_fn/ to iot).
+> let sq = [((0,1),'a'),((0,5),'a'),((1,5),'a'),((3,1),'a')]
+> wseq_has_overlaps (==) sq == True
+> let sq_rw = wseq_remove_overlaps_rm (==) sq
+> sq_rw == [((0,1),'a'),((1,5),'a')]
+> wseq_has_overlaps (==) sq_rw
+-}
+wseq_remove_overlaps_rm :: (Ord t,Num t) => (e -> e -> Bool) -> Wseq t e -> Wseq t e
+wseq_remove_overlaps_rm eq_f =
+  let recur sq =
+        case sq of
+          [] -> []
+          e0:sq' -> e0 : recur (filter (not . wseq_nodes_overlap eq_f e0) sq')
+  in recur
 
+{- | Find first instance of overlap of /e/ at /sq/ and re-write durations so nodes don't overlap.
+     If equal nodes begin simultaneously delete the shorter node (eithe LHS or RHS).
+     If a node extends into a later node shorten the initial (LHS) duration (apply /dur_fn/ to iot).
+-}
+wseq_remove_overlap_rw_1 :: (Ord t,Num t) =>
+                            (e -> e -> Bool) -> (t -> t) -> ((t,t),e) -> Wseq t e -> Maybe (Wseq t e)
+wseq_remove_overlap_rw_1 eq_f dur_fn ((t,d),a) sq =
+  let n_eq ((t1,d1),e1) ((t2,d2),e2) = t1 == t2 && d1 == d2 && eq_f e1 e2
+  in case find (eq_f a . snd) sq of
+       Nothing -> Nothing
+       Just ((t',d'),a') ->
+         if t == t'
+         then if d <= d'
+         then Just sq -- delete LHS
+              else Just (((t,d),a) : deleteBy n_eq ((t',d'),a') sq) -- delete RHS
+         else if t' < t + d
+              then Just (((t,dur_fn (t' - t)),a) : sq) -- truncate LHS
+              else Nothing
+
+{- | Run 'wseq_remove_overlap_rw_1' until sequence has no overlaps.
+
 > let sq = [((0,1),'a'),((0,5),'a'),((1,5),'a'),((3,1),'a')]
-> let r = [((0,1),'a'),((1,2),'a'),((3,1),'a')]
 > wseq_has_overlaps (==) sq == True
-> wseq_remove_overlaps (==) id sq == r
-> wseq_has_overlaps (==) (wseq_remove_overlaps (==) id sq) == False
+> let sq_rw = wseq_remove_overlaps_rw (==) id sq
+> sq_rw == [((0,1),'a'),((1,2),'a'),((3,1),'a')]
+> wseq_has_overlaps (==) sq_rw == False
 
+> import qualified Music.Theory.Array.Csv.Midi.Mnd as T {- hmt -}
+> let csv_fn = "/home/rohan/uc/the-center-is-between-us/visitants/csv/midi/air.B.1.csv"
+> sq <- T.csv_midi_read_wseq csv_fn :: IO (Wseq Double (T.Event Double))
+> length sq == 186
+> length (wseq_remove_overlaps_rw (==) id sq) == 183
 -}
-wseq_remove_overlaps :: (Eq e,Ord t,Num t) =>
-                        (e -> e -> Bool) -> (t -> t) -> Wseq t e -> Wseq t e
-wseq_remove_overlaps eq_fn dur_fn =
+wseq_remove_overlaps_rw :: (Ord t,Num t) => (e -> e -> Bool) -> (t -> t) -> Wseq t e -> Wseq t e
+wseq_remove_overlaps_rw eq_f dur_fn =
   let recur sq =
         case sq of
           [] -> []
           h:sq' ->
-            case wseq_overlap_f eq_fn dur_fn h sq' of
+            case wseq_remove_overlap_rw_1 eq_f dur_fn h sq' of
               Nothing -> h : recur sq'
               Just sq'' -> recur sq''
     in recur
@@ -564,7 +651,7 @@
 seq_unjoin :: [(t,[e])] -> [(t,e)]
 seq_unjoin = let f (t,e) = zip (repeat t) e in concatMap f
 
--- | Type specialised.
+-- | Type specialised 'seq_unjoin'.
 wseq_unjoin :: Wseq t [e] -> Wseq t e
 wseq_unjoin = seq_unjoin
 
@@ -586,6 +673,10 @@
 wseq_concat :: Num t => [Wseq t a] -> Wseq t a
 wseq_concat = foldl1 wseq_append
 
+-- | Transform sequence to start at time zero.
+wseq_zero :: Num t => Wseq t a -> Wseq t a
+wseq_zero sq = let t0 = wseq_start sq in wseq_tmap (\(st,du) -> (st - t0,du)) sq
+
 -- * Begin/End
 
 -- | Container to mark the /begin/ and /end/ of a value.
@@ -598,6 +689,8 @@
       Begin a -> Begin (f a)
       End a -> End (f a)
 
+instance Functor Begin_End where fmap = begin_end_map
+
 -- | Structural comparison at 'Begin_End', 'Begin' compares less than 'End'.
 cmp_begin_end :: Begin_End a -> Begin_End b -> Ordering
 cmp_begin_end p q =
@@ -607,6 +700,8 @@
       (End _,End _) -> EQ
       (End _,Begin _) -> GT
 
+--instance Eq t => Ord (Begin_End t) where compare = cmp_begin_end
+
 -- | Translate container types.
 either_to_begin_end :: Either a a -> Begin_End a
 either_to_begin_end p =
@@ -621,6 +716,7 @@
       Begin a -> Left a
       End a -> Right a
 
+-- | Equivalent to 'partitionEithers'.
 begin_end_partition :: [Begin_End a] -> ([a],[a])
 begin_end_partition =
   let f e (p,q) = case e of
@@ -628,32 +724,35 @@
                     End x -> (p,x:q)
   in foldr f ([],[])
 
--- | Add or delete element from accumulated state.
-begin_end_track :: Eq a => [a] -> Begin_End a -> [a]
-begin_end_track st e =
+-- | Add or delete element from accumulated state given equality function.
+begin_end_track_by :: (a -> a -> Bool) -> [a] -> Begin_End a -> [a]
+begin_end_track_by eq_f st e =
   case e of
     Begin x -> x : st
-    End x -> delete x st
+    End x -> deleteBy eq_f x st
 
--- | Convert 'Wseq' to 'Tseq' transforming elements to 'Begin_End'.
---   When merging, /end/ elements precede /begin/ elements at equal times.
---
--- > let {sq = [((0,5),'a'),((2,2),'b')]
--- >     ;r = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]}
--- > in wseq_begin_end sq == r
---
--- > let {sq = [((0,1),'a'),((1,1),'b'),((2,1),'c')]
--- >     ;r = [(0,Begin 'a'),(1,End 'a')
--- >          ,(1,Begin 'b'),(2,End 'b')
--- >          ,(2,Begin 'c'),(3,End 'c')]}
--- > in wseq_begin_end sq == r
+-- | 'begin_end_track_by' of '=='.
+begin_end_track :: Eq a => [a] -> Begin_End a -> [a]
+begin_end_track = begin_end_track_by (==)
+
+{- | Convert 'Wseq' to 'Tseq' transforming elements to 'Begin_End'.
+     When merging, /end/ elements precede /begin/ elements at equal times.
+
+> let sq = [((0,5),'a'),((2,2),'b')]
+> let r = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]
+> wseq_begin_end sq == r
+
+> let sq = [((0,1),'a'),((1,1),'b'),((2,1),'c')]
+> let r = [(0,Begin 'a'),(1,End 'a'),(1,Begin 'b'),(2,End 'b'),(2,Begin 'c'),(3,End 'c')]
+> wseq_begin_end sq == r
+-}
 wseq_begin_end :: (Num t, Ord t) => Wseq t a -> Tseq t (Begin_End a)
 wseq_begin_end sq =
     let f ((t,d),a) = [(t,Begin a),(t + d,End a)]
         g l =
             case l of
               [] -> []
-              e:l' -> tseq_merge_by (T.ord_invert .: cmp_begin_end) e (g l')
+              e:l' -> tseq_merge_by (\x -> T.ord_invert . cmp_begin_end x) e (g l')
     in g (map f sq)
 
 -- | 'begin_end_to_either' of 'wseq_begin_end'.
@@ -662,13 +761,13 @@
 
 -- | Variant that applies /begin/ and /end/ functions to nodes.
 --
--- > let {sq = [((0,5),'a'),((2,2),'b')]
--- >     ;r = [(0,'A'),(2,'B'),(4,'b'),(5,'a')]}
--- > in wseq_begin_end_f Data.Char.toUpper id sq == r
+-- > let sq = [((0,5),'a'),((2,2),'b')]
+-- > let r = [(0,'A'),(2,'B'),(4,'b'),(5,'a')]
+-- > wseq_begin_end_f Data.Char.toUpper id sq == r
 wseq_begin_end_f :: (Ord t,Num t) => (a -> b) -> (a -> b) -> Wseq t a -> Tseq t b
 wseq_begin_end_f f g = tseq_map (either f g) . wseq_begin_end_either
 
--- | Result for each time-point the triple (begin-list,end-list,hold-list).
+-- | Generate for each time-point the triple (begin-list,end-list,hold-list).
 --   The elements of the end-list have been deleted from the hold list.
 tseq_begin_end_accum :: Eq a => Tseq t [Begin_End a] -> Tseq t ([a],[a],[a])
 tseq_begin_end_accum =
@@ -678,6 +777,15 @@
             in (st',(t,(b,e,st \\ e)))
     in snd . mapAccumL f []
 
+-- | Variant that initially transforms 'Wseq' into non-overlapping begin-end sequence.
+--   If the sequence was edited for overlaps this is indicated.
+wseq_begin_end_accum :: (Eq e, Ord t, Num t) => Wseq t e -> (Bool, Tseq t ([e],[e],[e]))
+wseq_begin_end_accum sq =
+  let ol = wseq_has_overlaps (==) sq
+      sq_edit = if ol then wseq_remove_overlaps_rw (==) id sq else sq
+      a_sq = tseq_begin_end_accum (tseq_group (wseq_begin_end sq_edit))
+  in (ol,a_sq)
+
 tseq_accumulate :: Eq a => Tseq t [Begin_End a] -> Tseq t [a]
 tseq_accumulate =
   let f st (t,e) =
@@ -695,9 +803,9 @@
 -- | Inverse of 'wseq_begin_end' given a predicate function for locating
 -- the /end/ node of a /begin/ node.
 --
--- > let {sq = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]
--- >     ;r = [((0,5),'a'),((2,2),'b')]}
--- > in tseq_begin_end_to_wseq (==) sq == r
+-- > let sq = [(0,Begin 'a'),(2,Begin 'b'),(4,End 'b'),(5,End 'a')]
+-- > let r = [((0,5),'a'),((2,2),'b')]
+-- > tseq_begin_end_to_wseq (==) sq == r
 tseq_begin_end_to_wseq :: Num t => (a -> a -> Bool) -> Tseq t (Begin_End a) -> Wseq t a
 tseq_begin_end_to_wseq cmp =
     let cmp' x e =
@@ -725,31 +833,41 @@
 -- /eof/ marker. Productive given indefinite input sequence.
 --
 -- > let r = zip [0,1,3,6,8,9] "abcde|"
--- > in dseq_to_tseq 0 '|' (zip [1,2,3,2,1] "abcde") == r
+-- > dseq_to_tseq 0 '|' (zip [1,2,3,2,1] "abcde") == r
 --
--- > let {d = zip [1,2,3,2,1] "abcde"
--- >     ;r = zip [0,1,3,6,8,9,10] "abcdeab"}
--- > in take 7 (dseq_to_tseq 0 undefined (cycle d)) == r
+-- > let d = zip [1,2,3,2,1] "abcde"
+-- > let r = zip [0,1,3,6,8,9,10] "abcdeab"
+-- > take 7 (dseq_to_tseq 0 undefined (cycle d)) == r
 dseq_to_tseq :: Num t => t -> a -> Dseq t a -> Tseq t a
-dseq_to_tseq t0 nil sq =
-    let (d,a) = unzip sq
-        t = T.dx_d t0 d
-        a' = a ++ [nil]
-    in zip t a'
+dseq_to_tseq t0 nil = T.rezip (T.dx_d t0) (T.snoc nil)
 
 -- | Variant where the /nil/ value is taken from the last element of
 -- the sequence.
 --
 -- > let r = zip [0,1,3,6,8,9] "abcdee"
--- > in dseq_to_tseq_last 0 (zip [1,2,3,2,1] "abcde") == r
+-- > dseq_to_tseq_last 0 (zip [1,2,3,2,1] "abcde") == r
 dseq_to_tseq_last :: Num t => t -> Dseq t a -> Tseq t a
 dseq_to_tseq_last t0 sq = dseq_to_tseq t0 (snd (last sq)) sq
 
+{- | Variant where the final duration is discarded.
+
+> dseq_to_tseq_discard 0 (zip [1,2,3,2,1] "abcde") == zip [0,1,3,6,8] "abcde"
+-}
+dseq_to_tseq_discard :: Num t => t -> Dseq t a -> Tseq t a
+dseq_to_tseq_discard t0 = T.drop_last . dseq_to_tseq t0 undefined
+
+-- | 'Iseq' to 'Tseq', requires t0.
+--
+-- > let r = zip [1,3,6,8,9] "abcde"
+-- > iseq_to_tseq 0 (zip [1,2,3,2,1] "abcde") == r
+iseq_to_tseq :: Num t => t -> Iseq t a -> Tseq t a
+iseq_to_tseq t0 = T.rezip (tail . T.dx_d t0) id
+
 -- | The conversion requires a start time and does not consult the
 -- /logical/ duration.
 --
 -- > let p = pseq_zip (repeat undefined) (cycle [1,2]) (cycle [1,1,2]) "abcdef"
--- > in pseq_to_wseq 0 p == wseq_zip [0,1,2,4,5,6] (cycle [1,2]) "abcdef"
+-- > pseq_to_wseq 0 p == wseq_zip [0,1,2,4,5,6] (cycle [1,2]) "abcdef"
 pseq_to_wseq :: Num t => t -> Pseq t a -> Wseq t a
 pseq_to_wseq t0 sq =
     let (p,a) = unzip sq
@@ -762,10 +880,10 @@
 -- value is required in case the 'Tseq' does not begin at @0@.
 --
 -- > let r = zip [1,2,3,2,1] "abcde"
--- > in tseq_to_dseq undefined (zip [0,1,3,6,8,9] "abcde|") == r
+-- > tseq_to_dseq undefined (zip [0,1,3,6,8,9] "abcde|") == r
 --
 -- > let r = zip [1,2,3,2,1] "-abcd"
--- > in tseq_to_dseq '-' (zip [1,3,6,8,9] "abcd|") == r
+-- > tseq_to_dseq '-' (zip [1,3,6,8,9] "abcd|") == r
 tseq_to_dseq :: (Ord t,Num t) => a -> Tseq t a -> Dseq t a
 tseq_to_dseq empty sq =
     let (t,a) = unzip sq
@@ -774,16 +892,37 @@
          [] -> []
          t0:_ -> if t0 > 0 then (t0,empty) : zip d a else zip d a
 
+{- | Variant that requires a final duration be provided, and that the Tseq have no end marker.
+
+> let r = zip [1,2,3,2,9] "abcde"
+> tseq_to_dseq_final_dur undefined 9 (zip [0,1,3,6,8] "abcde") == r
+-}
+tseq_to_dseq_final_dur :: (Ord t,Num t) => a -> t -> Tseq t a -> Dseq t a
+tseq_to_dseq_final_dur empty dur sq =
+  let (t,a) = unzip sq
+      d = T.d_dx t ++ [dur]
+  in case t of
+       [] -> []
+       t0:_ -> if t0 > 0 then (t0,empty) : zip d a else zip d a
+
+{- | Variant that requires a total duration be provided, and that the Tseq have no end marker.
+
+> let r = zip [1,2,3,2,7] "abcde"
+> tseq_to_dseq_total_dur undefined 15 (zip [0,1,3,6,8] "abcde")
+-}
+tseq_to_dseq_total_dur :: (Ord t,Num t) => a -> t -> Tseq t a -> Dseq t a
+tseq_to_dseq_total_dur empty dur sq = tseq_to_dseq_final_dur empty (dur - tseq_end sq) sq
+
 -- | The last element of 'Tseq' is required to be an /eof/ marker that
 -- has no duration and is not represented in the 'Wseq'.  The duration
--- of each value is either derived from the value, if an /dur/
+-- of each value is either derived from the value, if a /dur/
 -- function is given, or else the inter-offset time.
 --
 -- > let r = wseq_zip [0,1,3,6,8] [1,2,3,2,1] "abcde"
--- > in tseq_to_wseq Nothing (zip [0,1,3,6,8,9] "abcde|") == r
+-- > tseq_to_wseq Nothing (zip [0,1,3,6,8,9] "abcde|") == r
 --
 -- > let r = wseq_zip [0,1,3,6,8] (map fromEnum "abcde") "abcde"
--- > in tseq_to_wseq (Just fromEnum) (zip [0,1,3,6,8,9] "abcde|") == r
+-- > tseq_to_wseq (Just fromEnum) (zip [0,1,3,6,8,9] "abcde|") == r
 tseq_to_wseq :: Num t => Maybe (a -> t) -> Tseq t a -> Wseq t a
 tseq_to_wseq dur_f sq =
     let (t,a) = unzip sq
@@ -792,7 +931,21 @@
               Nothing -> T.d_dx t
     in wseq_zip t d a
 
-tseq_to_iseq :: Num t => Tseq t a -> Dseq t a
+{- | Translate Tseq to Wseq using inter-offset times, up to indicated total duration, as element durations.
+
+> let r = [((0,1),'a'),((1,2),'b'),((3,3),'c'),((6,2),'d'),((8,3),'e')]
+> tseq_to_wseq_iot 11 (zip [0,1,3,6,8] "abcde") == r
+-}
+tseq_to_wseq_iot :: Num t => t -> Tseq t a -> Wseq t a
+tseq_to_wseq_iot total_dur sq =
+  let (t, e) = unzip sq
+      d = zipWith (-) (tail t ++ [total_dur]) t
+  in zip (zip t d) e
+
+-- | Tseq to Iseq.
+--
+-- > tseq_to_iseq (zip [0,1,3,6,8,9] "abcde|") == zip [0,1,2,3,2,1] "abcde|"
+tseq_to_iseq :: Num t => Tseq t a -> Iseq t a
 tseq_to_iseq =
     let recur n p =
             case p of
@@ -803,7 +956,7 @@
 -- | Requires start time.
 --
 -- > let r = zip (zip [0,1,3,6,8,9] [1,2,3,2,1]) "abcde"
--- > in dseq_to_wseq 0 (zip [1,2,3,2,1] "abcde") == r
+-- > dseq_to_wseq 0 (zip [1,2,3,2,1] "abcde") == r
 dseq_to_wseq :: Num t => t -> Dseq t a -> Wseq t a
 dseq_to_wseq t0 sq =
     let (d,a) = unzip sq
@@ -815,16 +968,16 @@
 -- truncated.
 --
 -- > let w = wseq_zip [0,1,3,6,8,9] [1,2,3,2,1] "abcde"
--- > in wseq_to_dseq '-' w == zip [1,2,3,2,1] "abcde"
+-- > wseq_to_dseq '-' w == zip [1,2,3,2,1] "abcde"
 --
 -- > let w = wseq_zip [3,10] [6,2] "ab"
--- > in wseq_to_dseq '-' w == zip [3,6,1,2] "-a-b"
+-- > wseq_to_dseq '-' w == zip [3,6,1,2] "-a-b"
 --
 -- > let w = wseq_zip [0,1] [2,2] "ab"
--- > in wseq_to_dseq '-' w == zip [1,2] "ab"
+-- > wseq_to_dseq '-' w == zip [1,2] "ab"
 --
 -- > let w = wseq_zip [0,0,0] [2,2,2] "abc"
--- > in wseq_to_dseq '-' w == zip [0,0,2] "abc"
+-- > wseq_to_dseq '-' w == zip [0,0,2] "abc"
 wseq_to_dseq :: (Num t,Ord t) => a -> Wseq t a -> Dseq t a
 wseq_to_dseq empty sq =
     let f (((st0,d),e),((st1,_),_)) =
@@ -839,13 +992,16 @@
          ((st,_),_):_ -> if st > 0 then (st,empty) : r else r
          [] -> error "wseq_to_dseq"
 
+eseq_to_wseq :: Eseq t a -> Wseq t a
+eseq_to_wseq = let f ((t, d, _), e) = ((t, d), e) in map f
+
 -- * Measures
 
 -- | Given a list of 'Dseq' (measures) convert to a list of 'Tseq' and
 -- the end time of the overall sequence.
 --
 -- > let r = [[(0,'a'),(1,'b'),(3,'c')],[(4,'d'),(7,'e'),(9,'f')]]
--- > in dseql_to_tseql 0 [zip [1,2,1] "abc",zip [3,2,1] "def"] == (10,r)
+-- > dseql_to_tseql 0 [zip [1,2,1] "abc",zip [3,2,1] "def"] == (10,r)
 dseql_to_tseql :: Num t => t -> [Dseq t a] -> (t,[Tseq t a])
 dseql_to_tseql =
     let f z dv =
@@ -856,29 +1012,30 @@
 
 -- * Cycle
 
-wseq_cycle' :: Num t => Wseq t a -> [Wseq t a]
-wseq_cycle' sq =
+-- | List of cycles of 'Wseq'.
+wseq_cycle_ls :: Num t => Wseq t a -> [Wseq t a]
+wseq_cycle_ls sq =
     let (_,et) = wseq_tspan sq
         t_sq = iterate (+ et) 0
-    in map (\x -> wseq_tmap (\(t,d) -> (x + t,d)) sq) t_sq
+    in map (\x -> wseq_tmap (first (+ x)) sq) t_sq
 
 -- | Only finite 'Wseq' can be cycled, the resulting Wseq is infinite.
 --
 -- > take 5 (wseq_cycle [((0,1),'a'),((3,3),'b')])
 wseq_cycle :: Num t => Wseq t a -> Wseq t a
-wseq_cycle = concat . wseq_cycle'
+wseq_cycle = concat . wseq_cycle_ls
 
 -- | Variant cycling only /n/ times.
 --
 -- > wseq_cycle_n 3 [((0,1),'a'),((3,3),'b')]
 wseq_cycle_n :: Num t => Int -> Wseq t a -> Wseq t a
-wseq_cycle_n n = concat . take n . wseq_cycle'
+wseq_cycle_n n = concat . take n . wseq_cycle_ls
 
 -- | 'wseq_until' of 'wseq_cycle'.
 wseq_cycle_until :: (Num t,Ord t) => t -> Wseq t a -> Wseq t a
 wseq_cycle_until et = wseq_until et . wseq_cycle
 
--- * Type specialised map
+-- * Type specialised maps
 
 dseq_tmap :: (t -> t') -> Dseq t a -> Dseq t' a
 dseq_tmap = seq_tmap
@@ -946,3 +1103,12 @@
 
 wseq_cat_maybes :: Wseq t (Maybe a) -> Wseq t a
 wseq_cat_maybes = seq_cat_maybes
+
+-- * Maps
+
+{- | Requires but does not check that there are no duplicate time points in Tseq.
+
+> tseq_to_map [(0, 'a'), (0, 'b')] == tseq_to_map [(0, 'b')]
+-}
+tseq_to_map :: Ord t => Tseq t e -> Map.Map t e
+tseq_to_map = Map.fromList
diff --git a/Music/Theory/Time_Signature.hs b/Music/Theory/Time_Signature.hs
--- a/Music/Theory/Time_Signature.hs
+++ b/Music/Theory/Time_Signature.hs
@@ -6,7 +6,7 @@
 
 import Music.Theory.Duration
 import Music.Theory.Duration.Name
-import Music.Theory.Duration.RQ
+import Music.Theory.Duration.Rq
 import Music.Theory.Math
 
 -- | A Time Signature is a /(numerator,denominator)/ pair.
@@ -49,26 +49,26 @@
       (6,2) -> [dotted_breve]
       _ -> error ("ts_whole_note: " ++ show t)
 
--- | Duration of measure in 'RQ'.
+-- | Duration of measure in 'Rq'.
 --
 -- > map ts_whole_note_rq [(3,8),(2,2)] == [3/2,4]
-ts_whole_note_rq :: Time_Signature -> RQ
+ts_whole_note_rq :: Time_Signature -> Rq
 ts_whole_note_rq = sum . map duration_to_rq . ts_whole_note
 
--- | Duration, in 'RQ', of a measure of indicated 'Time_Signature'.
+-- | Duration, in 'Rq', of a measure of indicated 'Time_Signature'.
 --
 -- > map ts_rq [(3,4),(5,8)] == [3,5/2]
-ts_rq :: Time_Signature -> RQ
+ts_rq :: Time_Signature -> Rq
 ts_rq (n,d) = (4 * n) % d
 
 -- | 'compare' 'on' 'ts_rq'.
 ts_compare :: Time_Signature -> Time_Signature -> Ordering
 ts_compare = compare `on` ts_rq
 
--- | 'Time_Signature' derived from whole note duration in 'RQ' form.
+-- | 'Time_Signature' derived from whole note duration in 'Rq' form.
 --
 -- > map rq_to_ts [4,3/2,7/4,6] == [(4,4),(3,8),(7,16),(6,4)]
-rq_to_ts :: RQ -> Time_Signature
+rq_to_ts :: Rq -> Time_Signature
 rq_to_ts rq =
     let n = numerator rq
         d = denominator rq * 4
@@ -81,7 +81,7 @@
 -- > ts_divisions (2,2) == [2,2]
 -- > ts_divisions (1,1) == [4]
 -- > ts_divisions (7,4) == [1,1,1,1,1,1,1]
-ts_divisions :: Time_Signature -> [RQ]
+ts_divisions :: Time_Signature -> [Rq]
 ts_divisions (i,j) =
     let k = fromIntegral i
     in replicate k (recip (j % 4))
@@ -123,23 +123,23 @@
 -- | A composite time signature is a sequence of 'Time_Signature's.
 type Composite_Time_Signature = [Time_Signature]
 
--- | The 'RQ' is the 'sum' of 'ts_rq' of the elements.
+-- | The 'Rq' is the 'sum' of 'ts_rq' of the elements.
 --
 -- > cts_rq [(3,4),(1,8)] == 3 + 1/2
-cts_rq :: Composite_Time_Signature -> RQ
+cts_rq :: Composite_Time_Signature -> Rq
 cts_rq = sum . map ts_rq
 
 -- | The divisions are the 'concat' of the 'ts_divisions' of the
 -- elements.
 --
 -- > cts_divisions [(3,4),(1,8)] == [1,1,1,1/2]
-cts_divisions :: Composite_Time_Signature -> [RQ]
+cts_divisions :: Composite_Time_Signature -> [Rq]
 cts_divisions = concatMap ts_divisions
 
--- | Pulses are 1-indexed, RQ locations are 0-indexed.
+-- | Pulses are 1-indexed, Rq locations are 0-indexed.
 --
 -- > map (cts_pulse_to_rq [(2,4),(1,8),(1,4)]) [1 .. 4] == [0,1,2,2 + 1/2]
-cts_pulse_to_rq :: Composite_Time_Signature -> Int -> RQ
+cts_pulse_to_rq :: Composite_Time_Signature -> Int -> Rq
 cts_pulse_to_rq cts p =
     let dv = cts_divisions cts
     in sum (take (p - 1) dv)
@@ -149,7 +149,7 @@
 --
 -- > let r = [(0,1),(1,1),(2,1/2),(2 + 1/2,1)]
 -- > in map (cts_pulse_to_rqw [(2,4),(1,8),(1,4)]) [1 .. 4] == r
-cts_pulse_to_rqw :: Composite_Time_Signature -> Int -> (RQ,RQ)
+cts_pulse_to_rqw :: Composite_Time_Signature -> Int -> (Rq,Rq)
 cts_pulse_to_rqw cts p = (cts_pulse_to_rq cts p,cts_divisions cts !! (p - 1))
 
 -- * Rational Time Signatures
@@ -158,11 +158,11 @@
 -- the parts are 'Rational'.
 type Rational_Time_Signature = [(Rational,Rational)]
 
--- | The 'sum' of the RQ of the elements.
+-- | The 'sum' of the Rq of the elements.
 --
 -- > rts_rq [(3,4),(1,8)] == 3 + 1/2
 -- > rts_rq [(3/2,4),(1/2,8)] == 3/2 + 1/4
-rts_rq :: Rational_Time_Signature -> RQ
+rts_rq :: Rational_Time_Signature -> Rq
 rts_rq =
     let f (n,d) = (4 * n) / d
     in sum . map f
@@ -171,7 +171,7 @@
 --
 -- > rts_divisions [(3,4),(1,8)] == [1,1,1,1/2]
 -- > rts_divisions [(3/2,4),(1/2,8)] == [1,1/2,1/4]
-rts_divisions :: Rational_Time_Signature -> [[RQ]]
+rts_divisions :: Rational_Time_Signature -> [[Rq]]
 rts_divisions =
     let f (n,d) = let (ni,nf) = integral_and_fractional_parts n
                       rq = recip (d / 4)
@@ -181,14 +181,14 @@
 
 -- > rts_derive [1,1,1,1/2]
 -- > rts_derive [1,1/2,1/4]
-rts_derive :: [RQ] -> Rational_Time_Signature
+rts_derive :: [Rq] -> Rational_Time_Signature
 rts_derive = let f rq = (rq,4) in map f
 
--- | Pulses are 1-indexed, RQ locations are 0-indexed.
+-- | Pulses are 1-indexed, Rq locations are 0-indexed.
 --
 -- > map (rts_pulse_to_rq [(2,4),(1,8),(1,4)]) [1 .. 4] == [0,1,2,2 + 1/2]
 -- > map (rts_pulse_to_rq [(3/2,4),(1/2,8),(1/4,4)]) [1 .. 4] == [0,1,3/2,7/4]
-rts_pulse_to_rq :: Rational_Time_Signature -> Int -> RQ
+rts_pulse_to_rq :: Rational_Time_Signature -> Int -> Rq
 rts_pulse_to_rq rts p =
     let dv = concat (rts_divisions rts)
     in sum (take (p - 1) dv)
@@ -198,5 +198,5 @@
 --
 -- > let r = [(0,1),(1,1),(2,1/2),(2 + 1/2,1)]
 -- > in map (rts_pulse_to_rqw [(2,4),(1,8),(1,4)]) [1 .. 4] == r
-rts_pulse_to_rqw :: Rational_Time_Signature -> Int -> (RQ,RQ)
+rts_pulse_to_rqw :: Rational_Time_Signature -> Int -> (Rq,Rq)
 rts_pulse_to_rqw ts p = (rts_pulse_to_rq ts p,concat (rts_divisions ts) !! (p - 1))
diff --git a/Music/Theory/Tuning.hs b/Music/Theory/Tuning.hs
--- a/Music/Theory/Tuning.hs
+++ b/Music/Theory/Tuning.hs
@@ -1,176 +1,173 @@
 -- | Tuning theory
 module Music.Theory.Tuning where
 
-import Data.Fixed (mod') {- base -}
-import Data.List {- base -}
-import qualified Data.Map as M {- containers -}
-import Data.Maybe {- base -}
+import qualified Data.Fixed as Fixed {- base -}
 import Data.Ratio {- base -}
-import Safe {- safe -}
 
-import qualified Music.Theory.Either as T {- hmt -}
+import qualified Music.Theory.Function as T {- hmt -}
 import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Map as T {- hmt -}
-import qualified Music.Theory.Pitch as T {- hmt -}
-import qualified Music.Theory.Set.List as T {- hmt -}
-import qualified Music.Theory.Tuple as T {- hmt -}
-
--- * Types
-
--- | An approximation of a ratio.
-type Approximate_Ratio = Double
+import qualified Music.Theory.Math as T {- hmt -}
+import qualified Music.Theory.Ord as T {- hmt -}
 
--- | A real valued division of a semi-tone into one hundred parts, and
--- hence of the octave into @1200@ parts.
-type Cents = Double
+-- * Math/Floating
 
--- | A tuning specified 'Either' as a sequence of exact ratios, or as
--- a sequence of possibly inexact 'Cents'.
+-- | Fractional /midi/ note number to cycles per second, given (k0,f0) pair.
 --
--- In both cases, the values are given in relation to the first degree
--- of the scale, which for ratios is 1 and for cents 0.
-data Tuning = Tuning {tn_ratios_or_cents :: Either [Rational] [Cents]
-                     ,tn_octave_ratio :: Rational}
-              deriving (Eq,Show)
+-- > fmidi_to_cps_k0 (60,256) 69 == 430.5389646099018
+fmidi_to_cps_k0 :: Floating a => (a,a) -> a -> a
+fmidi_to_cps_k0 (k0,f0) i = f0 * (2 ** ((i - k0) * (1 / 12)))
 
--- | Divisions of octave.
+-- | 'fmidi_to_cps_k0' with k0 of 69.
 --
--- > tn_divisions (equal_temperament 12) == 12
-tn_divisions :: Tuning -> Int
-tn_divisions = either length length . tn_ratios_or_cents
-
--- | 'Maybe' exact ratios of 'Tuning'.
-tn_ratios :: Tuning -> Maybe [Rational]
-tn_ratios = T.fromLeft . tn_ratios_or_cents
-
--- | 'error'ing variant.
-tn_ratios_err :: Tuning -> [Rational]
-tn_ratios_err = fromMaybe (error "ratios") . tn_ratios
+-- > fmidi_to_cps_f0 440 60 == 261.6255653005986
+fmidi_to_cps_f0 :: Floating a => a -> a -> a
+fmidi_to_cps_f0 f0 = fmidi_to_cps_k0 (69,f0)
 
--- | Possibly inexact 'Cents' of tuning.
-tn_cents :: Tuning -> [Cents]
-tn_cents = either (map ratio_to_cents) id . tn_ratios_or_cents
+-- | 'fmidi_to_cps_k0' (69,440)
+--
+-- > map fmidi_to_cps [69,69.1] == [440.0,442.5488940698553]
+fmidi_to_cps :: Floating a => a -> a
+fmidi_to_cps = fmidi_to_cps_k0 (69,440)
 
--- | 'map' 'round' '.' 'cents'.
-tn_cents_i :: Integral i => Tuning -> [i]
-tn_cents_i = map round . tn_cents
+-- | /Midi/ note number to cycles per second, given frequency of ISO A4.
+midi_to_cps_k0 :: (Integral i,Floating f) => (f,f) -> i -> f
+midi_to_cps_k0 o = fmidi_to_cps_k0 o . fromIntegral
 
--- | Variant of 'cents' that includes octave at right.
-tn_cents_octave :: Tuning -> [Cents]
-tn_cents_octave t = tn_cents t ++ [ratio_to_cents (tn_octave_ratio t)]
+-- | 'midi_to_cps_k0' (69,440).
+--
+-- > map (round . midi_to_cps) [59,60,69] == [247,262,440]
+midi_to_cps :: (Integral i,Floating f) => i -> f
+midi_to_cps = midi_to_cps_k0 (69,440)
 
 -- | Convert from interval in cents to frequency ratio.
 --
--- > map cents_to_ratio [0,701.9550008653874,1200] == [1,3/2,2]
-cents_to_ratio :: Floating a => a -> a
-cents_to_ratio n = 2 ** (n / 1200)
+-- > map cents_to_fratio [0,701.9550008653874,1200] == [1,3/2,2]
+-- > map cents_to_fratio [-1800,1800] -- three octaves about zero
+cents_to_fratio :: Floating a => a -> a
+cents_to_fratio n = 2 ** (n / 1200)
 
--- | Possibly inexact 'Approximate_Ratio's of tuning.
-tn_approximate_ratios :: Tuning -> [Approximate_Ratio]
-tn_approximate_ratios =
-    either (map approximate_ratio) (map cents_to_ratio) .
-    tn_ratios_or_cents
+-- | Convert from a 'Floating' ratio to /cents/.
+--
+-- > let r = [0,498,702,1200]
+-- > map (round . fratio_to_cents) [1,4/3,3/2,2] == r
+fratio_to_cents :: (Real r,Floating n) => r -> n
+fratio_to_cents = (1200 *) . logBase 2 . realToFrac
 
--- | Cyclic form, taking into consideration 'octave_ratio'.
-tn_approximate_ratios_cyclic :: Tuning -> [Approximate_Ratio]
-tn_approximate_ratios_cyclic t =
-    let r = tn_approximate_ratios t
-        m = realToFrac (tn_octave_ratio t)
-        g = iterate (* m) 1
-        f n = map (* n) r
-    in concatMap f g
+-- | Frequency /n/ cents from /f/.
+--
+-- > import Music.Theory.Pitch {- hmt -}
+-- > map (cps_shift_cents 440) [-100,100] == map octpc_to_cps [(4,8),(4,10)]
+cps_shift_cents :: Floating a => a -> a -> a
+cps_shift_cents f = (* f) . cents_to_fratio
 
--- | Iterate the function /f/ /n/ times, the inital value is /x/.
+-- | Interval in /cents/ from /p/ to /q/, ie. 'ratio_to_cents' of /p/ '/' /q/.
 --
--- > recur_n 5 (* 2) 1 == 32
--- > take (5 + 1) (iterate (* 2) 1) == [1,2,4,8,16,32]
-recur_n :: Integral n => n -> (t -> t) -> t -> t
-recur_n n f x = if n < 1 then x else recur_n (n - 1) f (f x)
+-- > map (round . cps_difference_cents 440) [412,415,octpc_to_cps (5,2)] == [-114,-101,500]
+--
+-- > let abs_dif i j = abs (i - j)
+-- > cps_difference_cents 440 (fmidi_to_cps 69.1) `abs_dif` 10 < 1e9
+cps_difference_cents :: (Real r,Fractional r,Floating n) => r -> r -> n
+cps_difference_cents p q = fratio_to_cents (q / p)
 
+-- * Math/Ratio
+
 -- | Convert a (signed) number of octaves difference of given ratio to a ratio.
 --
 -- > map (oct_diff_to_ratio 2) [-3 .. 3] == [1/8,1/4,1/2,1,2,4,8]
 -- > map (oct_diff_to_ratio (9/8)) [-3 .. 3] == [512/729,64/81,8/9,1/1,9/8,81/64,729/512]
 oct_diff_to_ratio :: Integral a => Ratio a -> Int -> Ratio a
-oct_diff_to_ratio r n = if n >= 0 then recur_n n (* r) 1 else recur_n (negate n) (/ r) 1
+oct_diff_to_ratio r n = if n >= 0 then T.recur_n n (* r) 1 else T.recur_n (negate n) (/ r) 1
 
--- | Lookup function that allows both negative & multiple octave indices.
+-- | 'ratio_to_cents' rounded to nearest multiple of 100, modulo 12.
 --
--- > let map_zip f l = zip l (map f l)
--- > map_zip (tn_ratios_lookup werckmeister_vi) [-24 .. 24]
-tn_ratios_lookup :: Tuning -> Int -> Maybe Rational
-tn_ratios_lookup t n =
-    let (o,pc) = n `divMod` tn_divisions t
-        o_ratio = oct_diff_to_ratio (tn_octave_ratio t) o
-    in fmap (\r -> o_ratio * (r !! pc)) (tn_ratios t)
+-- > map (ratio_to_pc 0) [1,4/3,3/2,2] == [0,5,7,0]
+ratio_to_pc :: Int -> Rational -> Int
+ratio_to_pc n = T.mod12 . (+ n) . round . (/ 100) . ratio_to_cents
 
--- | Lookup function that allows both negative & multiple octave indices.
+-- | Fold ratio to lie within an octave, ie. @1@ '<' /n/ '<=' @2@.
+--   It is an error for /n/ to be more than one octave outside of this range.
 --
--- > map_zip (tn_approximate_ratios_lookup werckmeister_v) [-24 .. 24]
-tn_approximate_ratios_lookup :: Tuning -> Int -> Approximate_Ratio
-tn_approximate_ratios_lookup t n =
-    let (o,pc) = n `divMod` tn_divisions t
-        o_ratio = fromRational (oct_diff_to_ratio (tn_octave_ratio t) o)
-    in o_ratio * ((tn_approximate_ratios t) !! pc)
+-- > map fold_ratio_to_octave_nonrec [2/3,3/4,4/5,4/7] == [4/3,3/2,8/5,8/7]
+fold_ratio_to_octave_nonrec :: (Ord n,Fractional n) => n -> n
+fold_ratio_to_octave_nonrec n =
+  if n >= 1 && n < 2
+  then n
+  else if n >= 2 && n < 4
+       then n / 2
+       else if n < 1 && n >= (1/2)
+            then n * 2
+            else error "fold_ratio_to_octave_nonrec"
 
--- | 'Maybe' exact ratios reconstructed from possibly inexact 'Cents'
--- of 'Tuning'.
+-- | Fold ratio until within an octave, ie. @1@ '<' /n/ '<=' @2@.
+--   It is an error if /n/ is less than or equal to zero.
 --
--- > :l Music.Theory.Tuning.Werckmeister
--- > let r = [1,17/16,9/8,13/11,5/4,4/3,7/5,3/2,11/7,5/3,16/9,15/8]
--- > tn_reconstructed_ratios 1e-2 werckmeister_iii == Just r
-tn_reconstructed_ratios :: Double -> Tuning -> Maybe [Rational]
-tn_reconstructed_ratios epsilon =
-    fmap (map (reconstructed_ratio epsilon)) .
-    T.fromRight .
-    tn_ratios_or_cents
+-- > map fold_ratio_to_octave_err [2/2,2/3,3/4,4/5,4/7] == [1/1,4/3,3/2,8/5,8/7]
+fold_ratio_to_octave_err :: (Ord n,Fractional n) => n -> n
+fold_ratio_to_octave_err =
+  let f n =
+        if n <= 0
+        then error "fold_ratio_to_octave_err?"
+        else if n >= 2 then f (n / 2) else if n < 1 then f (n * 2) else n
+  in f
 
--- | Convert from a 'Floating' ratio to /cents/.
+-- | In /n/ is greater than zero, 'fold_ratio_to_octave_err', else 'Nothing'.
 --
--- > let r = [0,498,702,1200]
--- > in map (round . fratio_to_cents) [1,4/3,3/2,2] == r
-fratio_to_cents :: (Real r,Floating n) => r -> n
-fratio_to_cents = (1200 *) . logBase 2 . realToFrac
+-- > map fold_ratio_to_octave [0,1] == [Nothing,Just 1]
+fold_ratio_to_octave :: (Ord n,Fractional n) => n -> Maybe n
+fold_ratio_to_octave n = if n <= 0 then Nothing else Just (fold_ratio_to_octave_err n)
 
--- | Type specialised 'fratio_to_cents'.
-approximate_ratio_to_cents :: Approximate_Ratio -> Cents
-approximate_ratio_to_cents = fratio_to_cents
+-- | The interval between two pitches /p/ and /q/ given as ratio
+-- multipliers of a fundamental is /q/ '/' /p/.  The classes over such
+-- intervals consider the 'fold_ratio_to_octave' of both /p/ to /q/
+-- and /q/ to /p/ and select the minima at the /cmp_f/.
+--
+-- > map (ratio_interval_class_by id) [3/2,5/4] == [4/3,5/4]
+ratio_interval_class_by :: (Ord t, Integral i) => (Ratio i -> t) -> Ratio i -> Ratio i
+ratio_interval_class_by cmp_f i =
+    let f = fold_ratio_to_octave_err
+    in T.min_by cmp_f (f i) (f (recip i))
 
+-- | 'ratio_interval_class_by' 'ratio_nd_sum'
+--
+-- > map ratio_interval_class [2/3,3/2,3/4,4/3] == [3/2,3/2,3/2,3/2]
+-- > map ratio_interval_class [7/6,12/7] == [7/6,7/6]
+ratio_interval_class :: Integral i => Ratio i -> Ratio i
+ratio_interval_class = ratio_interval_class_by T.ratio_nd_sum
+
+-- * Types
+
+-- | An approximation of a ratio.
+type Approximate_Ratio = Double
+
 -- | Type specialised 'fromRational'.
 approximate_ratio :: Rational -> Approximate_Ratio
 approximate_ratio = fromRational
 
+-- | A real valued division of a semi-tone into one hundred parts, and
+-- hence of the octave into @1200@ parts.
+type Cents = Double
+
+-- | Integral cents value.
+type Cents_I = Int
+
+-- | Type specialised 'fratio_to_cents'.
+approximate_ratio_to_cents :: Approximate_Ratio -> Cents
+approximate_ratio_to_cents = fratio_to_cents
+
 -- | 'approximate_ratio_to_cents' '.' 'approximate_ratio'.
 --
+-- > import Data.Ratio {- base -}
 -- > map (\n -> (n,round (ratio_to_cents (fold_ratio_to_octave_err (n % 1))))) [1..21]
 ratio_to_cents :: Integral i => Ratio i -> Cents
 ratio_to_cents = approximate_ratio_to_cents . realToFrac
 
--- | Construct an exact 'Rational' that approximates 'Cents' to within
--- /epsilon/.
+-- | Construct an exact 'Rational' that approximates 'Cents' to within /epsilon/.
 --
--- > map (reconstructed_ratio 1e-5) [0,700,1200] == [1,442/295,2]
+-- > map (reconstructed_ratio 1e-5) [0,700,1200,1800] == [1,442/295,2,577/204]
 --
 -- > ratio_to_cents (442/295) == 699.9976981706735
 reconstructed_ratio :: Double -> Cents -> Rational
-reconstructed_ratio epsilon c = approxRational (cents_to_ratio c) epsilon
-
--- | Frequency /n/ cents from /f/.
---
--- > import Music.Theory.Pitch
--- > map (cps_shift_cents 440) [-100,100] == map octpc_to_cps [(4,8),(4,10)]
-cps_shift_cents :: Floating a => a -> a -> a
-cps_shift_cents f = (* f) . cents_to_ratio
-
--- | Interval in /cents/ from /p/ to /q/, ie. 'ratio_to_cents' of /p/
--- '/' /q/.
---
--- > cps_difference_cents 440 (octpc_to_cps (5,2)) == 500
---
--- > let abs_dif i j = abs (i - j)
--- > in cps_difference_cents 440 (fmidi_to_cps 69.1) `abs_dif` 10 < 1e9
-cps_difference_cents :: (Real r,Fractional r,Floating n) => r -> r -> n
-cps_difference_cents p q = fratio_to_cents (q / p)
+reconstructed_ratio epsilon c = approxRational (cents_to_fratio c) epsilon
 
 -- * Commas
 
@@ -192,174 +189,18 @@
 mercators_comma :: Rational
 mercators_comma = 19383245667680019896796723 / 19342813113834066795298816
 
--- | Calculate /n/th root of /x/.
---
--- > 12 `nth_root` 2 == twelve_tone_equal_temperament_comma
-nth_root :: (Floating a,Eq a) => a -> a -> a
-nth_root n x =
-    let f (_,x0) = (x0, ((n-1)*x0+x/x0**(n-1))/n)
-        e = uncurry (==)
-    in fst (until e f (x, x/n))
-
 -- | 12-tone equal temperament comma (ie. 12th root of 2).
 --
 -- > twelve_tone_equal_temperament_comma == 1.0594630943592953
 twelve_tone_equal_temperament_comma :: (Floating a,Eq a) => a
-twelve_tone_equal_temperament_comma = 12 `nth_root` 2
-
--- * Equal temperaments
-
--- | Make /n/ division equal temperament.
-equal_temperament :: Integral n => n -> Tuning
-equal_temperament n =
-    let c = genericTake n [0,1200 / fromIntegral n ..]
-    in Tuning (Right c) 2
-
--- | 12-tone equal temperament.
---
--- > cents equal_temperament_12 == [0,100..1100]
-equal_temperament_12 :: Tuning
-equal_temperament_12 = equal_temperament (12::Int)
-
--- | 19-tone equal temperament.
-equal_temperament_19 :: Tuning
-equal_temperament_19 = equal_temperament (19::Int)
-
--- | 31-tone equal temperament.
-equal_temperament_31 :: Tuning
-equal_temperament_31 = equal_temperament (31::Int)
-
--- | 53-tone equal temperament.
-equal_temperament_53 :: Tuning
-equal_temperament_53 = equal_temperament (53::Int)
-
--- | 72-tone equal temperament.
---
--- > let r = [0,17,33,50,67,83,100]
--- > in take 7 (map round (cents equal_temperament_72)) == r
-equal_temperament_72 :: Tuning
-equal_temperament_72 = equal_temperament (72::Int)
-
--- | 96-tone equal temperament.
-equal_temperament_96 :: Tuning
-equal_temperament_96 = equal_temperament (96::Int)
-
--- * Harmonic series
-
--- | Harmonic series to /n/th partial, with indicated octave.
---
--- > harmonic_series 17 2
-harmonic_series :: Integer -> Rational -> Tuning
-harmonic_series n o = Tuning (Left [1 .. n%1]) o
-
--- | Harmonic series on /n/.
-harmonic_series_cps :: (Num t, Enum t) => t -> [t]
-harmonic_series_cps n = [n,n * 2 ..]
-
--- | /n/ elements of 'harmonic_series_cps'.
---
--- > let r = [55,110,165,220,275,330,385,440,495,550,605,660,715,770,825,880,935]
--- > in harmonic_series_cps_n 17 55 == r
-harmonic_series_cps_n :: (Num a, Enum a) => Int -> a -> [a]
-harmonic_series_cps_n n = take n . harmonic_series_cps
-
--- | Sub-harmonic series on /n/.
-subharmonic_series_cps :: (Fractional t,Enum t) => t -> [t]
-subharmonic_series_cps n = map (* n) (map recip [1..])
-
--- | /n/ elements of 'harmonic_series_cps'.
---
--- > let r = [1760,880,587,440,352,293,251,220,196,176,160,147,135,126,117,110,104]
--- > in map round (subharmonic_series_cps_n 17 1760) == r
-subharmonic_series_cps_n :: (Fractional t,Enum t) => Int -> t -> [t]
-subharmonic_series_cps_n n = take n . subharmonic_series_cps
-
--- | /n/th partial of /f1/, ie. one indexed.
---
--- > map (partial 55) [1,5,3] == [55,275,165]
-partial :: (Num a, Enum a) => a -> Int -> a
-partial f1 k = harmonic_series_cps f1 `at` (k - 1)
-
-fold_ratio_to_octave' :: Integral i => Ratio i -> Ratio i
-fold_ratio_to_octave' =
-    let rec_f n = if n >= 2 then rec_f (n / 2) else if n < 1 then rec_f (n * 2) else n
-    in rec_f
-
--- | Error if input is less than or equal to zero.
---
--- > map fold_ratio_to_octave_err [2/3,3/4] == [4/3,3/2]
-fold_ratio_to_octave_err :: Integral i => Ratio i -> Ratio i
-fold_ratio_to_octave_err n =
-    if n <= 0
-    then error "fold_ratio_to_octave"
-    else fold_ratio_to_octave' n
-
--- | Fold ratio until within an octave, ie. @1@ '<' /n/ '<=' @2@.
---
--- > map fold_ratio_to_octave [0,1] == [Nothing,Just 1]
-fold_ratio_to_octave :: Integral i => Ratio i -> Maybe (Ratio i)
-fold_ratio_to_octave n = if n <= 0 then Nothing else Just (fold_ratio_to_octave' n)
-
--- | Sun of numerator & denominator.
-ratio_nd_sum :: Num a => Ratio a -> a
-ratio_nd_sum r = numerator r + denominator r
-
-min_by :: Ord a => (t -> a) -> t -> t -> t
-min_by f p q = if f p <= f q then p else q
-
--- | The interval between two pitches /p/ and /q/ given as ratio
--- multipliers of a fundamental is /q/ '/' /p/.  The classes over such
--- intervals consider the 'fold_ratio_to_octave' of both /p/ to /q/
--- and /q/ to /p/.
---
--- > map ratio_interval_class [2/3,3/2,3/4,4/3] == [3/2,3/2,3/2,3/2]
--- > map ratio_interval_class [7/6,12/7] == [7/6,7/6]
-ratio_interval_class :: Integral i => Ratio i -> Ratio i
-ratio_interval_class i =
-    let f = fold_ratio_to_octave_err
-    in min_by ratio_nd_sum (f i) (f (recip i))
-
--- | Derivative harmonic series, based on /k/th partial of /f1/.
---
--- > import Music.Theory.Pitch
---
--- > let {r = [52,103,155,206,258,309,361,412,464,515,567,618,670,721,773]
--- >     ;d = harmonic_series_cps_derived 5 (octpc_to_cps (1,4))}
--- > in map round (take 15 d) == r
-harmonic_series_cps_derived :: (Ord a, Fractional a, Enum a) => Int -> a -> [a]
-harmonic_series_cps_derived k f1 =
-    let f0 = T.cps_in_octave_above f1 (partial f1 k)
-    in harmonic_series_cps f0
-
--- | Harmonic series to /n/th harmonic (folded, duplicated removed).
---
--- > harmonic_series_folded_r 17 == [1,17/16,9/8,5/4,11/8,3/2,13/8,7/4,15/8]
---
--- > let r = [0,105,204,386,551,702,841,969,1088]
--- > in map (round . ratio_to_cents) (harmonic_series_folded_r 17) == r
-harmonic_series_folded_r :: Integer -> [Rational]
-harmonic_series_folded_r n = nub (sort (map fold_ratio_to_octave_err [1 .. n%1]))
-
--- | 'ratio_to_cents' variant of 'harmonic_series_folded'.
-harmonic_series_folded_c :: Integer -> [Cents]
-harmonic_series_folded_c = map ratio_to_cents . harmonic_series_folded_r
-
-harmonic_series_folded :: Integer -> Rational -> Tuning
-harmonic_series_folded n o = Tuning (Left (harmonic_series_folded_r n)) o
-
--- | @12@-tone tuning of first @21@ elements of the harmonic series.
---
--- > cents_i harmonic_series_folded_21 == [0,105,204,298,386,471,551,702,841,969,1088]
--- > divisions harmonic_series_folded_21 == 11
-harmonic_series_folded_21 :: Tuning
-harmonic_series_folded_21 = harmonic_series_folded 21 2
+twelve_tone_equal_temperament_comma = 12 `T.nth_root` 2
 
 -- * Cents
 
 -- | Give cents difference from nearest 12ET tone.
 --
 -- > let r = [50,-49,-2,0,2,49,50]
--- > in map cents_et12_diff [650,651,698,700,702,749,750] == r
+-- > map cents_et12_diff [650,651,698,700,702,749,750] == r
 cents_et12_diff :: Integral n => n -> n
 cents_et12_diff n =
     let m = n `mod` 100
@@ -368,7 +209,7 @@
 -- | Fractional form of 'cents_et12_diff'.
 fcents_et12_diff :: Real n => n -> n
 fcents_et12_diff n =
-    let m = n `mod'` 100
+    let m = n `Fixed.mod'` 100
     in if m > 50 then m - 100 else m
 
 -- | The class of cents intervals has range @(0,600)@.
@@ -376,7 +217,7 @@
 -- > map cents_interval_class [50,1150,1250] == [50,50,50]
 --
 -- > let r = concat [[0,50 .. 550],[600],[550,500 .. 0]]
--- > in map cents_interval_class [1200,1250 .. 2400] == r
+-- > map cents_interval_class [1200,1250 .. 2400] == r
 cents_interval_class :: Integral a => a -> a
 cents_interval_class n =
     let n' = n `mod` 1200
@@ -385,7 +226,7 @@
 -- | Fractional form of 'cents_interval_class'.
 fcents_interval_class :: Real a => a -> a
 fcents_interval_class n =
-    let n' = n `mod'` 1200
+    let n' = n `Fixed.mod'` 1200
     in if n' > 600 then 1200 - n' else n'
 
 -- | Always include the sign, elide @0@.
@@ -416,203 +257,34 @@
 cents_diff_html :: (Num a, Ord a, Show a) => a -> String
 cents_diff_html = cents_diff_br ("<SUP>","</SUP>")
 
--- * Midi
-
--- | (/n/ -> /dt/).  Function from midi note number /n/ to
--- 'Midi_Detune' /dt/.  The incoming note number is the key pressed,
--- which may be distant from the note sounded.
-type Midi_Tuning_F = Int -> T.Midi_Detune
-
--- | Variant for tunings that are incomplete.
-type Sparse_Midi_Tuning_F = Int -> Maybe T.Midi_Detune
-
--- | Variant for sparse tunings that require state.
-type Sparse_Midi_Tuning_ST_F st = st -> Int -> (st,Maybe T.Midi_Detune)
-
--- | Lift 'Midi_Tuning_F' to 'Sparse_Midi_Tuning_F'.
-lift_tuning_f :: Midi_Tuning_F -> Sparse_Midi_Tuning_F
-lift_tuning_f tn_f = Just . tn_f
-
--- | Lift 'Sparse_Midi_Tuning_F' to 'Sparse_Midi_Tuning_ST_F'.
-lift_sparse_tuning_f :: Sparse_Midi_Tuning_F -> Sparse_Midi_Tuning_ST_F st
-lift_sparse_tuning_f tn_f st k = (st,tn_f k)
-
--- | (t,c,k) where t=tuning (must have 12 divisions of octave),
--- c=cents deviation (ie. constant detune offset), k=midi offset
--- (ie. value to be added to incoming midi note number).
-type D12_Midi_Tuning = (Tuning,Cents,Int)
-
--- | 'Midi_Tuning_F' for 'D12_Midi_Tuning'.
---
--- > let f = d12_midi_tuning_f (equal_temperament 12,0,0)
--- > map f [0..127] == zip [0..127] (repeat 0)
-d12_midi_tuning_f :: D12_Midi_Tuning -> Midi_Tuning_F
-d12_midi_tuning_f (t,c_diff,k) n =
-    let (_,pc) = T.midi_to_octpc (n + k)
-        dt = zipWith (-) (tn_cents t) [0,100 .. 1200]
-    in if tn_divisions t /= 12
-       then error "d12_midi_tuning_f: not d12"
-       else case dt `atMay` pc of
-              Nothing -> error "d12_midi_tuning_f: pc?"
-              Just c -> (n,c + c_diff)
-
--- | (t,f0,k,g) where t=tuning, f0=fundamental frequency, k=midi note
--- number for f0, g=gamut
-type CPS_Midi_Tuning = (Tuning,Double,Int,Int)
-
--- | 'Midi_Tuning_F' for 'CPS_Midi_Tuning'.  The function is sparse, it is only
--- valid for /g/ values from /k/.
---
--- > let f = cps_midi_tuning_f (equal_temperament 72,T.midi_to_cps 59,59,72 * 4)
--- > map f [59 .. 59 + 72]
-cps_midi_tuning_f :: CPS_Midi_Tuning -> Sparse_Midi_Tuning_F
-cps_midi_tuning_f (t,f0,k,g) n =
-    let r = tn_approximate_ratios_cyclic t
-        m = take g (map (T.cps_to_midi_detune . (* f0)) r)
-    in m `atMay` (n - k)
-
--- * Midi tuning tables.
+-- * Savart
 
--- | Midi-note-number -> CPS table, possibly sparse.
-type MNN_CPS_Table = [(Int,Double)]
+-- | Felix Savart (1791-1841), the ratio of 10:1 is assigned a value of 1000 savarts.
+type Savarts = Double
 
--- | Generates 'MNN_CPS_Table' given 'Midi_Tuning_F' with keys for all valid @MNN@.
+-- | Ratio to savarts.
 --
--- > import Sound.SC3.Plot
--- > plot_p2_ln [map (fmap round) (gen_cps_tuning_tbl f)]
-gen_cps_tuning_tbl :: Sparse_Midi_Tuning_F -> MNN_CPS_Table
-gen_cps_tuning_tbl tn_f =
-    let f n = case tn_f n of
-                Just r -> Just (n,T.midi_detune_to_cps r)
-                Nothing -> Nothing
-    in mapMaybe f [0 .. 127]
-
--- * Derived (secondary) tuning table (DTT) lookup.
-
--- | Given an 'MNN_CPS_Table' /tbl/, a list of @CPS@ /c/, and a @MNN@ /m/
--- find the @CPS@ in /c/ that is nearest to the @CPS@ in /t/ for /m/.
-dtt_lookup :: (Eq k, Num v, Ord v) => [(k,v)] -> [v] -> k -> (Maybe v,Maybe v)
-dtt_lookup tbl cps n =
-    let f = lookup n tbl
-    in (f,fmap (T.find_nearest_err cps) f)
-
--- | Require table be non-sparse.
-dtt_lookup_err :: (Eq k, Num v, Ord v) => [(k,v)] -> [v] -> k -> (k,v,v)
-dtt_lookup_err tbl cps n =
-    case dtt_lookup tbl cps n of
-      (Just f,Just g) -> (n,f,g)
-      _ -> error "dtt_lookup"
-
--- | Given two tuning tables generate the @dtt@ table.
-gen_dtt_lookup_tbl :: MNN_CPS_Table -> MNN_CPS_Table -> MNN_CPS_Table
-gen_dtt_lookup_tbl t0 t1 =
-    let ix = [0..127]
-        cps = sort (map (T.p3_third . dtt_lookup_err t0 (map snd t1)) ix)
-    in zip ix cps
-
-gen_dtt_lookup_f :: MNN_CPS_Table -> MNN_CPS_Table -> Midi_Tuning_F
-gen_dtt_lookup_f t0 t1 =
-    let m = M.fromList (gen_dtt_lookup_tbl t0 t1)
-    in T.cps_to_midi_detune . T.map_ix_err m
-
--- * Euler-Fokker genus <http://www.huygens-fokker.org/microtonality/efg.html>
-
--- | Normal form, value with occurences count (ie. exponent in notation above).
-type EFG i = [(i,Int)]
+-- > fratio_to_savarts 10 == 1000
+-- > fratio_to_savarts 2 == 301.02999566398114
+fratio_to_savarts :: Floating a => a -> a
+fratio_to_savarts r = 1000 * logBase 10 r
 
--- | Degree of EFG, ie. sum of exponents.
+-- | Savarts to ratio.
 --
--- > efg_degree [(3,3),(7,2)] == 3 + 2
-efg_degree :: EFG i -> Int
-efg_degree = sum . map snd
+-- > savarts_to_fratio 1000 == 10
+-- > savarts_to_fratio 301.02999566398118 == 2
+savarts_to_fratio :: Floating a => a -> a
+savarts_to_fratio s = 10 ** (s / 1000)
 
--- | Number of tones of EFG, ie. product of increment of exponents.
+-- | Savarts to cents.
 --
--- > efg_tones [(3,3),(7,2)] == (3 + 1) * (2 + 1)
-efg_tones :: EFG i -> Int
-efg_tones = product . map ((+ 1) . snd)
+-- > savarts_to_cents 1 == 3.9863137138648352
+savarts_to_cents :: Floating a => a -> a
+savarts_to_cents s = s * (6 / (5 * logBase 10 2))
 
--- | Collate a genus given as a multiset into standard form, ie. histogram.
+-- | Cents to savarts.
 --
--- > efg_collate [3,3,3,7,7] == [(3,3),(7,2)]
-efg_collate :: Ord i => [i] -> EFG i
-efg_collate = T.histogram . sort
-
-{- | Factors of EFG given with co-ordinate of grid location.
-
-> efg_factors [(3,3)]
-
-> let r = [([0,0],[]),([0,1],[7]),([0,2],[7,7])
->         ,([1,0],[3]),([1,1],[3,7]),([1,2],[3,7,7])
->         ,([2,0],[3,3]),([2,1],[3,3,7]),([2,2],[3,3,7,7])
->         ,([3,0],[3,3,3]),([3,1],[3,3,3,7]),([3,2],[3,3,3,7,7])]
-> in efg_factors [(3,3),(7,2)] == r
-
--}
-efg_factors :: EFG i -> [([Int],[i])]
-efg_factors efg =
-    let k = map (\(_,n) -> [0 .. n]) efg
-        k' = if length efg == 1
-             then concatMap (map return) k
-             else T.nfold_cartesian_product k
-        z = map fst efg
-        f ix = (ix,concat (zipWith (\n m -> replicate n (z !! m)) ix [0..]))
-    in map f k'
-
-{- | Ratios of EFG, taking /n/ as the 1:1 ratio, with indices, folded into one octave.
-
-> let r = sort $ map snd $ efg_ratios 7 [(3,3),(7,2)]
-> r == [1/1,9/8,8/7,9/7,21/16,189/128,3/2,27/16,12/7,7/4,27/14,63/32]
-> map (round . ratio_to_cents) r == [0,204,231,435,471,675,702,906,933,969,1137,1173]
-
-      0:         1/1          C          0.000 cents
-      1:         9/8          D        203.910 cents
-      2:         8/7          D+       231.174 cents
-      3:         9/7          E+       435.084 cents
-      4:        21/16         F-       470.781 cents
-      5:       189/128        G-       674.691 cents
-      6:         3/2          G        701.955 cents
-      7:        27/16         A        905.865 cents
-      8:        12/7          A+       933.129 cents
-      9:         7/4          Bb-      968.826 cents
-     10:        27/14         B+      1137.039 cents
-     11:        63/32         C-      1172.736 cents
-     12:         2/1          C       1200.000 cents
-
-> let r' = sort $ map snd $ efg_ratios 5 [(5,2),(7,3)]
-> r' == [1/1,343/320,35/32,49/40,5/4,343/256,7/5,49/32,8/5,1715/1024,7/4,245/128]
-> map (round . ratio_to_cents) r' == [0,120,155,351,386,506,583,738,814,893,969,1124]
-
-> let r'' = sort $ map snd $ efg_ratios 3 [(3,1),(5,1),(7,1)]
-> r'' == [1/1,35/32,7/6,5/4,4/3,35/24,5/3,7/4]
-> map (round . ratio_to_cents) r'' == [0,155,267,386,498,653,884,969]
-
-> let c0 = [0,204,231,435,471,675,702,906,933,969,1137,1173,1200]
-> let c1 = [0,120,155,351,386,506,583,738,814,893,969,1124,1200]
-> let c2 = [0,155,267,386,498,653,884,969,1200]
-> let f (c',y) = map (\x -> (x,y,x,y + 10)) c'
-> map f (zip [c0,c1,c2] [0,20,40])
-
--}
-efg_ratios :: Real r => Rational -> EFG r -> [([Int],Rational)]
-efg_ratios n =
-    let to_r = fold_ratio_to_octave_err . (/ n) . toRational . product
-        f (ix,i) = (ix,to_r i)
-    in map f . efg_factors
-
-{- | Generate a line drawing, as a set of (x0,y0,x1,y1) 4-tuples.
-     h=row height, m=distance of vertical mark from row edge, k=distance between rows
-
-> let e = [[3,3,3],[3,3,5],[3,5,5],[3,5,7],[3,7,7],[5,5,5],[5,5,7],[3,3,7],[5,7,7],[7,7,7]]
-> let e = [[3,3,3],[5,5,5],[7,7,7],[3,3,5],[3,5,5],[5,5,7],[5,7,7],[3,7,7],[3,3,7],[3,5,7]]
-> let e' = map efg_collate e
-> efg_diagram_set (round,25,4,75) e'
-
--}
-efg_diagram_set :: (Enum n,Real n) => (Cents -> n,n,n,n) -> [EFG n] -> [(n,n,n,n)]
-efg_diagram_set (to_f,h,m,k) e =
-    let f = (++ [1200]) . sort . map (to_f . ratio_to_cents . snd) . efg_ratios 1
-        g (c,y) = let y' = y + h
-                      b = [(0,y,1200,y),(0,y',1200,y')]
-                  in b ++ map (\x -> (x,y + m,x,y' - m)) c
-    in concatMap g (zip (map f e) [0,k ..])
+-- > cents_to_savarts 3.9863137138648352 == 1
+-- > cents_to_savarts 1200 == ratio_to_savarts 2
+cents_to_savarts :: Floating a => a -> a
+cents_to_savarts c = c / (6 / (5 * logBase 10 2))
diff --git a/Music/Theory/Tuning/Alves_1997.hs b/Music/Theory/Tuning/Alves_1997.hs
--- a/Music/Theory/Tuning/Alves_1997.hs
+++ b/Music/Theory/Tuning/Alves_1997.hs
@@ -3,54 +3,58 @@
 -- 1997.  <http://www2.hmc.edu/~alves/pleng.html>
 module Music.Theory.Tuning.Alves_1997 where
 
-import Music.Theory.Tuning
+import Music.Theory.Tuning.Type {- hmt -}
 
+-- > import Music.Theory.Tuning {- hmt -}
 -- > let c = [0,231,498,765,996]
--- > in map (round.to_cents_r) alves_slendro_r == c
+-- > map (round . ratio_to_cents) alves_slendro_r == c
 alves_slendro_r :: [Rational]
 alves_slendro_r = [1,8/7,4/3,14/9,16/9]
 
--- | HMC /slendro/ tuning.
---
--- > cents_i alves_slendro == [0,231,498,765,996]
---
--- > scl <- scl_load "slendro_alves"
--- > cents_i (scale_tuning 0.01 scl) == cents_i alves_slendro
+{- | HMC /slendro/ tuning.
+
+> cents_i alves_slendro == [0,231,498,765,996]
+
+> import Music.Theory.Tuning.Scala {- hmt -}
+> scl <- scl_load "alves_slendro"
+> tn_cents_i (scale_to_tuning 0.01 scl) == tn_cents_i alves_slendro
+-}
 alves_slendro :: Tuning
-alves_slendro = Tuning (Left alves_slendro_r) 2
+alves_slendro = Tuning (Left alves_slendro_r) Nothing
 
 -- > let c = [0,231,316,702,814]
--- > in map (round.to_cents_r) alves_pelog_bem_r == c
+-- > map (round . ratio_to_cents) alves_pelog_bem_r == c
 alves_pelog_bem_r :: [Rational]
 alves_pelog_bem_r = [1,8/7,6/5,3/2,8/5]
 
--- | HMC /pelog bem/ tuning.
---
--- > cents_i alves_pelog_bem == [0,231,316,702,814]
---
--- > scl <- scl_load "pelog_alves"
--- > cents_i (scale_tuning 0.01 scl) == [0,231,316,471,702,814,969]
+{- | HMC /pelog bem/ tuning.
+
+> tn_cents_i alves_pelog_bem == [0,231,316,702,814]
+
+> scl <- scl_load "alves_pelog"
+> tn_cents_i (scale_to_tuning 0.01 scl) == [0,231,316,471,702,814,969]
+-}
 alves_pelog_bem :: Tuning
-alves_pelog_bem = Tuning (Left alves_pelog_bem_r) 2
+alves_pelog_bem = Tuning (Left alves_pelog_bem_r) Nothing
 
 -- > let c = [0,386,471,857,969]
--- > in map (round.to_cents_r) alves_pelog_barang_r == c
+-- > map (round . ratio_to_cents) alves_pelog_barang_r == c
 alves_pelog_barang_r :: [Rational]
 alves_pelog_barang_r = [1,5/4,21/16,105/64,7/4]
 
 -- | HMC /pelog barang/ tuning.
 --
--- > cents_i alves_pelog_barang == [0,386,471,857,969]
+-- > tn_cents_i alves_pelog_barang == [0,386,471,857,969]
 alves_pelog_barang :: Tuning
-alves_pelog_barang = Tuning (Left alves_pelog_barang_r) 2
+alves_pelog_barang = Tuning (Left alves_pelog_barang_r) Nothing
 
 -- > let c = [0,386,471,702,969]
--- > in map (round.to_cents_r) alves_pelog_23467 == c
+-- > map (round . ratio_to_cents) alves_pelog_23467_r == c
 alves_pelog_23467_r :: [Rational]
 alves_pelog_23467_r = [1,5/4,21/16,3/2,7/4]
 
 -- | HMC /pelog 2,3,4,6,7/ tuning.
 --
--- > cents_i alves_pelog_23467 == [0,386,471,702,969]
+-- > tn_cents_i alves_pelog_23467 == [0,386,471,702,969]
 alves_pelog_23467 :: Tuning
-alves_pelog_23467 = Tuning (Left alves_pelog_23467_r) 2
+alves_pelog_23467 = Tuning (Left alves_pelog_23467_r) Nothing
diff --git a/Music/Theory/Tuning/Anamark.hs b/Music/Theory/Tuning/Anamark.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Anamark.hs
@@ -0,0 +1,106 @@
+-- | Anamark tuning (TUN) files
+--
+-- <https://www.mark-henning.de/files/am/Tuning_File_V2_Doc.pdf>
+module Music.Theory.Tuning.Anamark where
+
+import Text.Printf {- base -}
+
+import qualified Music.Theory.List as T
+
+-- | Format section string
+tun_sec :: String -> String
+tun_sec = printf "[%s]"
+
+-- | Format 'String' (text) attribute
+tun_attr_txt :: (String,String) -> String
+tun_attr_txt (k,v) = printf "%s = \"%s\"" k v
+
+-- | Format 'Int' attribute
+tun_attr_int :: (String,Int) -> String
+tun_attr_int (k,v) = printf "%s = %d" k v
+
+-- | Format 'Double' attribute
+tun_attr_real :: (String,Double) -> String
+tun_attr_real (k,v) = printf "%s = %f" k v
+
+-- | TUN V.200 /Scale Begin/ (header) section.
+tun_begin :: [String]
+tun_begin =
+  [tun_sec "Scale Begin"
+  ,tun_attr_txt ("Format","AnaMark-TUN")
+  ,tun_attr_int ("FormatVersion",200)
+  ,tun_attr_txt ("FormatSpecs","http://www.mark-henning.de/eternity/tuningspecs.html")]
+
+-- | Format /Info/ section given Name and ID (the only required fields).
+--
+-- > tun_info ("name","id")
+tun_info :: (String,String) -> [String]
+tun_info (nm,k) =
+  [tun_sec "Info"
+  ,tun_attr_txt ("Name",nm)
+  ,tun_attr_txt ("ID",k)]
+
+-- | Format /Tuning/ section given sequence of 128 integral cents values.
+--
+-- > tun_tuning [0,100.. 12700]
+tun_tuning :: [Int] -> [String]
+tun_tuning =
+  let f k c = printf "note %d = %d" k c
+  in (:) (tun_sec "Tuning") . zipWith f [0::Int .. 127]
+
+-- | The default base frequency for /Exact Tuning/ (A4=440)
+tun_f0_default :: Double
+tun_f0_default = 8.1757989156437073336
+
+-- | Format /Exact Tuning/ section given base frequency and sequence of 128 real cents values.
+--
+-- > tun_exact_tuning tun_f0_default [0,100.. 12700]
+tun_exact_tuning :: Double -> [Double] -> [String]
+tun_exact_tuning f0 =
+  let f k c = printf "note %d = %f" k c
+      hdr = [tun_sec "Exact Tuning"
+            ,tun_attr_real ("BaseFreq",f0)]
+  in (++) hdr  . zipWith f [0::Int .. 127]
+
+{- | Format /Functional Tuning/ section given base frequency and sequence of 128 real cents values.
+
+This simply sets note zero to /f0/ and increments each note by the difference from the previous note.
+
+> tun_functional_tuning tun_f0_default [0,100.. 12700]
+-}
+tun_functional_tuning :: Double -> [Double] -> [String]
+tun_functional_tuning f0 =
+  let f k c = printf "note %d = \"#x=%d %% %f\"" k (k - 1) c
+      hdr = [tun_sec "Functional Tuning"
+            ,printf "note 0 = \"# %f\"" f0]
+  in (++) hdr  . zipWith f [1::Int .. 127] . T.d_dx
+
+-- | Format /Scale End/ section header.
+tun_end :: [String]
+tun_end =
+  [tun_sec "Scale End"]
+
+-- | Synonym for a list of strings.
+type TUN = [String]
+
+-- | Version 1 has just the /Tuning/ and /Exact Tuning/.
+tun_from_cents_version_one :: (Double, [Double]) -> TUN
+tun_from_cents_version_one (f0,c) =
+  concat [tun_tuning (map round c)
+         ,tun_exact_tuning f0 c]
+
+-- | Version 2 files have, in addition, /Begin/, /Info/, /Functional Tuning/ and /End/ sections.
+tun_from_cents_version_two :: (String,String) -> (Double, [Double]) -> TUN
+tun_from_cents_version_two (nm,k) (f0,c) =
+  concat [tun_begin
+         ,tun_info (nm,k)
+         ,tun_tuning (map round c)
+         ,tun_exact_tuning f0 c
+         ,tun_functional_tuning f0 c
+         ,tun_end]
+
+-- > t = tun_from_cents_version_one (tun_f0_default,[0,100 .. 12700])
+-- > t = tun_from_cents_version_two ("equal-temperament-12","et12") (tun_f0_default,[0,100 .. 12700])
+-- > tun_store "/home/rohan/et12.tun" t
+tun_store :: FilePath -> TUN -> IO ()
+tun_store fn = writeFile fn . unlines
diff --git a/Music/Theory/Tuning/DB.hs b/Music/Theory/Tuning/DB.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/DB.hs
+++ /dev/null
@@ -1,62 +0,0 @@
--- | DB of locally defined tunings, but for ordinary use see "Music.Theory.Tuning.Scala".
-module Music.Theory.Tuning.DB where
-
-import Data.List {- base -}
-
-import Music.Theory.Tuning
-
-import Music.Theory.Tuning.Alves_1997
-import Music.Theory.Tuning.Gann_1993
-import Music.Theory.Tuning.Polansky_1978
-import Music.Theory.Tuning.Polansky_1985c
-
-import Music.Theory.Tuning.DB.Alves
-import Music.Theory.Tuning.DB.Gann
-import Music.Theory.Tuning.DB.Microtonal_Synthesis
-import Music.Theory.Tuning.DB.Riley
-import Music.Theory.Tuning.DB.Werckmeister
-
--- | (last-name,first-name,title,year,hmt/tuning,scala/name)
-type Named_Tuning = (String,String,String,String,Tuning,String)
-
-named_tuning_t :: Named_Tuning -> Tuning
-named_tuning_t (_,_,_,_,t,_) = t
-
-tuning_db :: [Named_Tuning]
-tuning_db =
-    [("Aaron","Pietro","","1523",pietro_aaron_1523,"meanquar")
-    ,("Alves","Bill","Slendro","",alves_slendro,"slendro_alves")
-    ,("Alves","Bill","Pelog/Bem","",alves_pelog_bem,"")
-    ,("Alves","Bill","Pelog/Barang","",alves_pelog_barang,"")
-    ,("Gann","Kyle","Superparticular","1992",gann_superparticular,"gann_super")
-    ,("Harrison","Lou","Ditone","",harrison_ditone,"")
-    ,("Harrison","Lou","16-tone","",lou_harrison_16,"harrison_16")
-    ,("Johnston","Ben","MTP","1977",ben_johnston_mtp_1977,"")
-    ,("Johnston","Ben","25-tone","",ben_johnston_25,"johnston_25")
-    ,("Kirnberger","Johann Philipp","III","",kirnberger_iii,"kirnberger")
-    ,("Malcolm","Alexander","Monochord","1721",five_limit_tuning,"malcolm")
-    ,("Partch","Harry","43-tone","",partch_43,"partch_43")
-    ,("Polansky","Larry","Piano Study #5","1985",ps5_jpr,"polansky_ps")
-    ,("Polansky","Larry","Psaltery","1978",psaltery_o,"")
-    ,("Riley","Terry","Harp of New Albion","",riley_albion,"riley_albion")
-    ,("Tsuda","Mayumi","13-limit","",mayumi_tsuda,"tsuda13")
-    ,("Vallotti","","","1754",vallotti,"vallotti")
-    ,("Werckmeister","Andreas","Werckmeister III","",werckmeister_iii,"werck3")
-    ,("Werckmeister","Andreas","Werckmeister IV","",werckmeister_iv,"werck4")
-    ,("Werckmeister","Andreas","Werckmeister V","",werckmeister_v,"werck5")
-    ,("Werckmeister","Andreas","Werckmeister VI","",werckmeister_vi,"werck6")
-    ,("Young","La Monte","The Well-Tuned Piano","",lmy_wtp,"young-lm_piano")
-    ,("Young","Thomas","","1799",thomas_young_1799,"young2")
-    ,("Zarlino","Gioseffo","","1588",zarlino_1588,"zarlino2")
-    ,("","","JI/12 7-limit","",septimal_tritone_just_intonation,"ji_12")
-    ,("","","ET/12","",equal_temperament_12,"")
-    ,("","","ET/19","",equal_temperament_19,"")
-    ,("","","ET/31","",equal_temperament_31,"")
-    ,("","","ET/53","",equal_temperament_53,"")
-    ,("","","ET/72","",equal_temperament_72,"")
-    ,("","","ET/96","",equal_temperament_96,"")
-    ,("","","Pythagorean/12","",pythagorean_12,"pyth_12")
-    ]
-
-tuning_db_lookup_scl :: String -> Maybe Tuning
-tuning_db_lookup_scl nm = fmap named_tuning_t (find (\(_,_,_,_,_,scl) -> scl == nm) tuning_db)
diff --git a/Music/Theory/Tuning/DB/Alves.hs b/Music/Theory/Tuning/DB/Alves.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/DB/Alves.hs
+++ /dev/null
@@ -1,26 +0,0 @@
--- | Bill Alves.
-module Music.Theory.Tuning.DB.Alves where
-
-import Music.Theory.Tuning {- hmt -}
-
--- | Ratios for 'harrison_ditone'.
---
--- > let c = [0,114,204,294,408,498,612,702,816,906,996,1110]
--- > in map (round . ratio_to_cents) harrison_ditone_r == c
-harrison_ditone_r :: [Rational]
-harrison_ditone_r =
-    [1,2187/2048 {- 256/243 -}
-    ,9/8,32/27
-    ,81/64
-    ,4/3,729/512
-    ,3/2,6561/4096 {- 128/81 -}
-    ,27/16,16/9
-    ,243/128]
-
--- | Ditone/pythagorean tuning,
--- see <http://www.billalves.com/porgitaro/ditonesettuning.html>
---
--- > tn_divisions harrison_ditone == 12
--- > tn_cents_i harrison_ditone == [0,114,204,294,408,498,612,702,816,906,996,1110]
-harrison_ditone :: Tuning
-harrison_ditone = Tuning (Left harrison_ditone_r) 2
diff --git a/Music/Theory/Tuning/DB/Gann.hs b/Music/Theory/Tuning/DB/Gann.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/DB/Gann.hs
+++ /dev/null
@@ -1,130 +0,0 @@
--- | Kyle Gann.
-module Music.Theory.Tuning.DB.Gann where
-
-import Music.Theory.Tuning {- hmt -}
-
--- * Historical
-
--- | Cents for 'pietro_aaron_1523'.
---
--- > let c = [0,76,193,310,386,503,580,697,773,890,1007,1083]
--- > in map round pietro_aaron_1523_c == c
---
--- > map ((+ 60) . (/ 100)) pietro_aaron_1523_c
-pietro_aaron_1523_c :: [Cents]
-pietro_aaron_1523_c =
-    [0,76.0
-    ,193.2,310.3
-    ,386.3
-    ,503.4,579.5
-    ,696.8,772.6
-    ,889.7,1006.8
-    ,1082.9]
-
--- | Pietro Aaron (1523) meantone temperament, see
--- <http://www.kylegann.com/histune.html>
---
--- > cents_i pietro_aaron_1523 == [0,76,193,310,386,503,580,697,773,890,1007,1083]
---
--- > import Music.Theory.Tuning.Scala
--- > scl <- scl_load "meanquar"
--- > cents_i (scale_tuning 0.01 scl) == [0,76,193,310,386,503,579,697,773,890,1007,1083]
-pietro_aaron_1523 :: Tuning
-pietro_aaron_1523 = Tuning (Right pietro_aaron_1523_c) 2
-
--- | Cents for 'thomas_young_1799'.
---
--- > let c = [0,94,196,298,392,500,592,698,796,894,1000,1092]
--- > in map round thomas_young_1799_c == c
-thomas_young_1799_c :: [Cents]
-thomas_young_1799_c =
-    [0,93.9
-    ,195.8,297.8
-    ,391.7
-    ,499.9,591.9
-    ,697.9,795.8
-    ,893.8,999.8
-    ,1091.8]
-
--- | Thomas Young (1799), Well Temperament, <http://www.kylegann.com/histune.html>.
---
--- > cents_i thomas_young_1799 == [0,94,196,298,392,500,592,698,796,894,1000,1092]
---
--- > scl <- scl_load "young2"
--- > cents_i (scale_tuning 0.01 scl) == cents_i thomas_young_1799
-thomas_young_1799 :: Tuning
-thomas_young_1799 = Tuning (Right thomas_young_1799_c) 2
-
--- | Ratios for 'zarlino'.
---
--- > length zarlino_1588_r == 16
-zarlino_1588_r :: [Rational]
-zarlino_1588_r = [1/1,25/24,10/9,9/8,32/27,6/5,5/4,4/3,25/18,45/32,3/2,25/16,5/3,16/9,9/5,15/8]
-
--- | Gioseffo Zarlino, 1588, see <http://www.kylegann.com/tuning.html>.
---
--- > divisions zarlino_1588 == 16
--- > cents_i zarlino_1588 == [0,71,182,204,294,316,386,498,569,590,702,773,884,996,1018,1088]
---
--- > scl <- scl_load "zarlino2"
--- > cents_i (scale_tuning 0.01 scl) == cents_i zarlino_1588
-zarlino_1588 :: Tuning
-zarlino_1588 = Tuning (Left zarlino_1588_r) 2
-
--- * 20th Century
-
--- | Ratios for 'ben_johnston_mtp_1977'.
---
--- > let c = [0,105,204,298,386,471,551,702,841,906,969,1088]
--- > in map (round . ratio_to_cents) ben_johnston_mtp_1977_r == c
-ben_johnston_mtp_1977_r :: [Rational]
-ben_johnston_mtp_1977_r =
-    [1,17/16
-    ,9/8,19/16
-    ,5/4
-    ,21/16,11/8
-    ,3/2,13/8
-    ,27/16,7/4
-    ,15/8]
-
--- | Ben Johnston's \"Suite for Microtonal Piano\" (1977), see
--- <http://www.kylegann.com/tuning.html>
---
--- > cents_i ben_johnston_mtp_1977 == [0,105,204,298,386,471,551,702,841,906,969,1088]
-ben_johnston_mtp_1977 :: Tuning
-ben_johnston_mtp_1977 = Tuning (Left ben_johnston_mtp_1977_r) 2
-
--- * Gann
-
--- | Ratios for 'gann_arcana_xvi'.
-gann_arcana_xvi_r :: [Rational]
-gann_arcana_xvi_r =
-    [1/1,21/20,16/15,9/8,7/6,6/5,11/9,5/4,21/16,4/3,27/20,7/5
-    ,22/15,3/2,55/36,8/5,44/27,5/3,42/25,7/4,9/5,11/6,15/8,88/45]
-
--- | Kyle Gann, _Arcana XVI_, see <http://www.kylegann.com/Arcana.html>.
---
--- > let r = [0,84,112,204,267,316,347,386,471,498,520,583,663,702,734,814,845,884,898,969,1018,1049,1088,1161]
--- > in cents_i gann_arcana_xvi == r
-gann_arcana_xvi :: Tuning
-gann_arcana_xvi = Tuning (Left gann_arcana_xvi_r) 2
-
--- | Ratios for 'gann_superparticular'.
-gann_superparticular_r :: [Rational]
-gann_superparticular_r =
-    [1/1,11/10,10/9,9/8,8/7,7/6,6/5,5/4,9/7,4/3
-    ,11/8,7/5,10/7,3/2
-    ,11/7,14/9,8/5,5/3,12/7,7/4,16/9,9/5]
-
--- | Kyle Gann, _Superparticular_, see <http://www.kylegann.com/Super.html>.
---
--- > divisions gann_superparticular == 22
---
--- > let r = [0,165,182,204,231,267,316,386,435,498,551,583,617,702
--- >         ,782,765,814,884,933,969,996,1018]
--- > in cents_i gann_superparticular == r
---
--- > scl <- scl_load "gann_super"
--- > cents_i (scale_tuning 0.01 scl) == cents_i gann_superparticular
-gann_superparticular :: Tuning
-gann_superparticular = Tuning (Left gann_superparticular_r) 2
diff --git a/Music/Theory/Tuning/DB/Microtonal_Synthesis.hs b/Music/Theory/Tuning/DB/Microtonal_Synthesis.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/DB/Microtonal_Synthesis.hs
+++ /dev/null
@@ -1,230 +0,0 @@
--- | <http://www.microtonal-synthesis.com/scales.html>
-module Music.Theory.Tuning.DB.Microtonal_Synthesis where
-
-import Music.Theory.Tuning {- hmt -}
-
--- | Ratios for 'pythagorean'.
-pythagorean_12_r :: [Rational]
-pythagorean_12_r =
-    [1,2187/2048 {- 256/243 -}
-    ,9/8,32/27
-    ,81/64
-    ,4/3,729/512
-    ,3/2,6561/4096 {- 128/81 -}
-    ,27/16,16/9
-    ,243/128]
-
--- | Pythagorean tuning, <http://www.microtonal-synthesis.com/scale_pythagorean.html>.
---
--- > cents_i pythagorean_12 == [0,114,204,294,408,498,612,702,816,906,996,1110]
---
--- > scl <- scl_load "pyth_12"
--- > cents_i (scale_tuning 0.1 scl) == cents_i pythagorean_12
-pythagorean_12 :: Tuning
-pythagorean_12 = Tuning (Left pythagorean_12_r) 2
-
--- | Ratios for 'five_limit_tuning'.
---
--- > let c = [0,112,204,316,386,498,590,702,814,884,996,1088]
--- > in map (round . ratio_to_cents) five_limit_tuning_r == c
-five_limit_tuning_r :: [Rational]
-five_limit_tuning_r =
-    [1,16/15
-    ,9/8,6/5
-    ,5/4
-    ,4/3,45/32 {- 64/45 -}
-    ,3/2,8/5
-    ,5/3,16/9 {- 9/5 -}
-    ,15/8]
-
--- | Five-limit tuning (five limit just intonation), Alexander Malcolm's Monochord (1721).
---
--- > cents_i five_limit_tuning == [0,112,204,316,386,498,590,702,814,884,996,1088]
---
--- > scl <- scl_load "malcolm"
--- > cents_i (scale_tuning 0.1 scl) == cents_i five_limit_tuning
-five_limit_tuning :: Tuning
-five_limit_tuning = Tuning (Left five_limit_tuning_r) 2
-
--- | Ratios for 'septimal_tritone_just_intonation'.
---
--- > let c = [0,112,204,316,386,498,583,702,814,884,1018,1088]
--- > in map (round . ratio_to_cents) septimal_tritone_just_intonation == c
-septimal_tritone_just_intonation_r :: [Rational]
-septimal_tritone_just_intonation_r =
-    [1,16/15
-    ,9/8,6/5
-    ,5/4
-    ,4/3,7/5
-    ,3/2,8/5
-    ,5/3,9/5
-    ,15/8]
-
--- | Septimal tritone Just Intonation, see
--- <http://www.microtonal-synthesis.com/scale_just_intonation.html>
---
--- > let c = [0,112,204,316,386,498,583,702,814,884,1018,1088]
--- > in cents_i septimal_tritone_just_intonation == c
---
--- > scl <- scl_load "ji_12"
--- > cents_i (scale_tuning 0.1 scl) == cents_i septimal_tritone_just_intonation
-septimal_tritone_just_intonation :: Tuning
-septimal_tritone_just_intonation = Tuning (Left septimal_tritone_just_intonation_r) 2
-
--- | Ratios for 'seven_limit_just_intonation'.
---
--- > let c = [0,112,204,316,386,498,583,702,814,884,969,1088]
--- > in map (round . ratio_to_cents) seven_limit_just_intonation == c
-seven_limit_just_intonation_r :: [Rational]
-seven_limit_just_intonation_r =
-    [1,16/15
-    ,9/8,6/5
-    ,5/4
-    ,4/3,7/5
-    ,3/2,8/5
-    ,5/3,7/4
-    ,15/8]
-
--- | Seven limit Just Intonation.
---
--- > cents_i seven_limit_just_intonation == [0,112,204,316,386,498,583,702,814,884,969,1088]
-seven_limit_just_intonation :: Tuning
-seven_limit_just_intonation = Tuning (Left seven_limit_just_intonation_r) 2
-
--- | Approximate ratios for 'kirnberger_iii'.
---
--- > let c = [0,90,193,294,386,498,590,697,792,890,996,1088]
--- > in map (round.to_cents) kirnberger_iii_ar == c
-kirnberger_iii_ar :: [Approximate_Ratio]
-kirnberger_iii_ar =
-    [1,256/243
-    ,sqrt 5 / 2,32/27
-    ,5/4
-    ,4/3,45/32
-    ,5 ** 0.25,128/81
-    ,(5 ** 0.75)/2,16/9
-    ,15/8]
-
--- | <http://www.microtonal-synthesis.com/scale_kirnberger.html>.
---
--- > cents_i kirnberger_iii == [0,90,193,294,386,498,590,697,792,890,996,1088]
---
--- > scl <- scl_load "kirnberger"
--- > cents_i (scale_tuning 0.1 scl) == cents_i kirnberger_iii
-kirnberger_iii :: Tuning
-kirnberger_iii = Tuning (Right (map approximate_ratio_to_cents kirnberger_iii_ar)) 2
-
--- > let c = [0,94,196,298,392,502,592,698,796,894,1000,1090]
--- > in map round vallotti_c == c
-vallotti_c :: [Cents]
-vallotti_c =
-    [0.0,94.135
-    ,196.09,298.045
-    ,392.18
-    ,501.955,592.18
-    ,698.045,796.09
-    ,894.135,1000.0
-    ,1090.225]
-
--- | Vallotti & Young scale (Vallotti version), see
--- <http://www.microtonal-synthesis.com/scale_vallotti_young.html>.
---
--- > cents_i vallotti == [0,94,196,298,392,502,592,698,796,894,1000,1090]
---
--- > scl <- scl_load "vallotti"
--- > cents_i (scale_tuning 0.1 scl) == cents_i vallotti
-vallotti :: Tuning
-vallotti = Tuning (Right vallotti_c) 2
-
--- > let c = [0,128,139,359,454,563,637,746,841,911,1072,1183]
--- > in map (round . ratio_to_cents) mayumi_tsuda == c
-mayumi_tsuda_r :: [Rational]
-mayumi_tsuda_r =
-    [1,14/13
-    ,13/12,16/13
-    ,13/10
-    ,18/13,13/9
-    ,20/13,13/8
-    ,22/13,13/7
-    ,208/105]
-
--- | Mayumi Tsuda 13-limit Just Intonation scale,
--- <http://www.microtonal-synthesis.com/scale_reinhard.html>.
---
--- > cents_i mayumi_tsuda == [0,128,139,359,454,563,637,746,841,911,1072,1183]
---
--- > scl <- scl_load "tsuda13"
--- > cents_i (scale_tuning 0.1 scl) == cents_i mayumi_tsuda
-mayumi_tsuda :: Tuning
-mayumi_tsuda = Tuning (Left mayumi_tsuda_r) 2
-
--- | Ratios for 'lou_harrison_16'.
---
--- > length lou_harrison_16_r == 16
---
--- > let c = [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
--- > in map (round . ratio_to_cents) lou_harrison_16_r == c
-lou_harrison_16_r :: [Rational]
-lou_harrison_16_r =
-    [1,16/15
-    ,10/9,8/7
-    ,7/6,6/5,5/4
-    ,4/3
-    ,17/12
-    ,3/2
-    ,8/5,5/3,12/7
-    ,7/4,9/5,15/8]
-
--- | Lou Harrison 16 tone Just Intonation scale, see
--- <http://www.microtonal-synthesis.com/scale_harrison_16.html>
---
--- > let r = [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
--- > in cents_i lou_harrison_16 == r
---
--- > import Music.Theory.Tuning.Scala
--- > scl <- scl_load "harrison_16"
--- > cents_i (scale_tuning 0.1 scl) == cents_i lou_harrison_16
-lou_harrison_16 :: Tuning
-lou_harrison_16 = Tuning (Left lou_harrison_16_r) 2
-
--- | Ratios for 'partch_43'.
-partch_43_r :: [Rational]
-partch_43_r =
-    [1,81/80,33/32,21/20,16/15,12/11,11/10,10/9,9/8,8/7
-    ,7/6,32/27,6/5,11/9,5/4,14/11,9/7
-    ,21/16,4/3,27/20
-    ,11/8,7/5,10/7,16/11
-    ,40/27,3/2,32/21,14/9,11/7,8/5,18/11,5/3,27/16,12/7
-    ,7/4,16/9,9/5,20/11,11/6,15/8,40/21,64/33,160/81]
-
--- | Harry Partch 43 tone scale, see
--- <http://www.microtonal-synthesis.com/scale_partch.html>
---
--- > cents_i partch_43 == [0,22,53,84,112,151,165
--- >                      ,182,204,231,267,294,316
--- >                      ,347,386,418,435
--- >                      ,471,498,520,551,583,617,649
--- >                      ,680,702,729,765,782,814,853,884,906,933
--- >                      ,969,996,1018,1035,1049,1088,1116,1147,1178]
---
--- > scl <- scl_load "partch_43"
--- > cents_i (scale_tuning 0.1 scl) == cents_i partch_43
-partch_43 :: Tuning
-partch_43 = Tuning (Left partch_43_r) 2
-
--- | Ratios for 'ben_johnston_25'.
-ben_johnston_25_r :: [Rational]
-ben_johnston_25_r =
-    [1/1,25/24,135/128,16/15,10/9
-    ,9/8,75/64,6/5,5/4,81/64
-    ,32/25,4/3,27/20,45/32,36/25
-    ,3/2,25/16,8/5,5/3,27/16
-    ,225/128,16/9,9/5,15/8,48/25]
-
--- | Ben Johnston 25 note just enharmonic scale, see
--- <http://www.microtonal-synthesis.com/scale_johnston_25.html>
---
--- > scl <- scl_load "johnston_25"
--- > cents_i (scale_tuning 0.1 scl) == cents_i ben_johnston_25
-ben_johnston_25 :: Tuning
-ben_johnston_25 = Tuning (Left ben_johnston_25_r) 2
diff --git a/Music/Theory/Tuning/DB/Riley.hs b/Music/Theory/Tuning/DB/Riley.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/DB/Riley.hs
+++ /dev/null
@@ -1,22 +0,0 @@
--- | Terry Riley.
-module Music.Theory.Tuning.DB.Riley where
-
-import Music.Theory.Tuning {- hmt -}
-
--- | Ratios for 'riley_albion'.
---
--- > let r = [0,112,204,316,386,498,610,702,814,884,996,1088]
--- > in map (round . ratio_to_cents) riley_albion_r == r
-riley_albion_r :: [Rational]
-riley_albion_r = [1/1,16/15,9/8,6/5,5/4,4/3,64/45,3/2,8/5,5/3,16/9,15/8]
-
--- | Riley's five-limit tuning as used in _The Harp of New Albion_,
--- see <http://www.ex-tempore.org/Volx1/hudson/hudson.htm>.
---
--- > cents_i riley_albion == [0,112,204,316,386,498,610,702,814,884,996,1088]
---
--- > import Music.Theory.Tuning.Scala
--- > scl <- scl_load "riley_albion"
--- > cents_i (scale_tuning 0.01 scl) == cents_i riley_albion
-riley_albion :: Tuning
-riley_albion = Tuning (Left riley_albion_r) 2
diff --git a/Music/Theory/Tuning/DB/Werckmeister.hs b/Music/Theory/Tuning/DB/Werckmeister.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/DB/Werckmeister.hs
+++ /dev/null
@@ -1,117 +0,0 @@
--- | Andreas Werckmeister (1645-1706).
-module Music.Theory.Tuning.DB.Werckmeister where
-
-import Music.Theory.Tuning {- hmt -}
-
--- | Approximate ratios for 'werckmeister_iii'.
---
--- > let c = [0,90,192,294,390,498,588,696,792,888,996,1092]
--- > in map (round . ratio_to_cents) werckmeister_iii_ar == c
-werckmeister_iii_ar :: [Approximate_Ratio]
-werckmeister_iii_ar =
-    let c0 = 2 ** (1/2)
-        c1 = 2 ** (1/4)
-        c2 = 8 ** (1/4)
-    in [1,256/243
-       ,64/81 * c0,32/27
-       ,256/243 * c1
-       ,4/3,1024/729
-       ,8/9 * c2,128/81
-       ,1024/729 * c1,16/9
-       ,128/81 * c1]
-
--- | Cents for 'werckmeister_iii'.
-werckmeister_iii_ar_c :: [Cents]
-werckmeister_iii_ar_c = map approximate_ratio_to_cents werckmeister_iii_ar
-
--- | Werckmeister III, Andreas Werckmeister (1645-1706)
---
--- > cents_i werckmeister_iii == [0,90,192,294,390,498,588,696,792,888,996,1092]
---
--- > import Music.Theory.Tuning.Scala
--- > scl <- scl_load "werck3"
--- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_iii
-werckmeister_iii :: Tuning
-werckmeister_iii = Tuning (Right werckmeister_iii_ar_c) 2
-
--- | Approximate ratios for 'werckmeister_iv'.
---
--- > let c = [0,82,196,294,392,498,588,694,784,890,1004,1086]
--- > in map (round . ratio_to_cents) werckmeister_iv_ar == c
-werckmeister_iv_ar :: [Approximate_Ratio]
-werckmeister_iv_ar =
-    let c0 = 2 ** (1/3)
-        c1 = 4 ** (1/3)
-    in [1,16384/19683 * c0
-       ,8/9 * c0,32/27
-       ,64/81 * c1
-       ,4/3,1024/729
-       ,32/27 * c0,8192/6561 * c0
-       ,256/243 * c1,9/(4*c0)
-       ,4096/2187]
-
--- | Cents for 'werckmeister_iv'.
-werckmeister_iv_c :: [Cents]
-werckmeister_iv_c = map approximate_ratio_to_cents werckmeister_iv_ar
-
--- | Werckmeister IV, Andreas Werckmeister (1645-1706)
---
--- > cents_i werckmeister_iv == [0,82,196,294,392,498,588,694,784,890,1004,1086]
---
--- > scl <- scl_load "werck4"
--- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_iv
-werckmeister_iv :: Tuning
-werckmeister_iv = Tuning (Right werckmeister_iv_c) 2
-
--- | Approximate ratios for 'werckmeister_v'.
---
--- > let c = [0,96,204,300,396,504,600,702,792,900,1002,1098]
--- > in map (round . ratio_to_cents) werckmeister_v_ar == c
-werckmeister_v_ar :: [Approximate_Ratio]
-werckmeister_v_ar =
-    let c0 = 2 ** (1/4)
-        c1 = 2 ** (1/2)
-        c2 = 8 ** (1/4)
-    in [1,8/9 * c0
-       ,9/8,c0
-       ,8/9 * c1
-       ,9/8 * c0,c1
-       ,3/2,128/81
-       ,c2,3/c2
-       ,4/3 * c1]
-
--- | Cents for 'werckmeister_v'.
-werckmeister_v_c :: [Cents]
-werckmeister_v_c = map approximate_ratio_to_cents werckmeister_v_ar
-
--- | Werckmeister V, Andreas Werckmeister (1645-1706)
---
--- > cents_i werckmeister_v == [0,96,204,300,396,504,600,702,792,900,1002,1098]
---
--- > scl <- scl_load "werck5"
--- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_v
-werckmeister_v :: Tuning
-werckmeister_v = Tuning (Right werckmeister_v_c) 2
-
--- | Ratios for 'werckmeister_vi', with supposed correction of 28/25 to 49/44.
---
--- > let c = [0,91,186,298,395,498,595,698,793,893,1000,1097]
--- > in map (round . ratio_to_cents) werckmeister_vi_r == c
-werckmeister_vi_r :: [Rational]
-werckmeister_vi_r =
-    [1,98/93
-    ,49/44 {- 28/25 -},196/165
-    ,49/39
-    ,4/3,196/139
-    ,196/131,49/31
-    ,196/117,98/55
-    ,49/26]
-
--- | Werckmeister VI, Andreas Werckmeister (1645-1706)
---
--- > cents_i werckmeister_vi == [0,91,186,298,395,498,595,698,793,893,1000,1097]
---
--- > scl <- scl_load "werck6"
--- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_vi
-werckmeister_vi :: Tuning
-werckmeister_vi = Tuning (Left werckmeister_vi_r) 2
diff --git a/Music/Theory/Tuning/Db.hs b/Music/Theory/Tuning/Db.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Db.hs
@@ -0,0 +1,74 @@
+-- | Db of locally defined tunings, but for ordinary use see "Music.Theory.Tuning.Scala".
+module Music.Theory.Tuning.Db where
+
+import Data.List {- base -}
+
+import Music.Theory.Tuning.Type
+
+import Music.Theory.Tuning.Alves_1997
+import Music.Theory.Tuning.Gann_1993
+import Music.Theory.Tuning.Polansky_1978
+import Music.Theory.Tuning.Polansky_1985c
+
+import Music.Theory.Tuning.Db.Alves
+import Music.Theory.Tuning.Db.Gann
+import Music.Theory.Tuning.Db.Microtonal_Synthesis
+import Music.Theory.Tuning.Db.Riley
+import Music.Theory.Tuning.Db.Werckmeister
+
+-- | (last-name,first-name,title,year,hmt/tuning,scala/name)
+type Named_Tuning = (String,String,String,String,Tuning,String)
+
+named_tuning_t :: Named_Tuning -> Tuning
+named_tuning_t (_,_,_,_,t,_) = t
+
+tuning_db :: [Named_Tuning]
+tuning_db =
+    [("Aaron","Pietro","","1523",pietro_aaron_1523,"meanquar")
+    ,("Alves","Bill","Slendro","",alves_slendro,"slendro_alves") -- slendro9
+    ,("Alves","Bill","Pelog/Bem","",alves_pelog_bem,"") -- hirajoshi2 / pelog_jc
+    ,("Alves","Bill","Pelog/Barang","",alves_pelog_barang,"") -- surupan_degung / degung3
+    ,("Gann","Kyle","Superparticular","1992",gann_superparticular,"gann_super")
+    ,("Harrison","Lou","Ditone","",harrison_ditone,"") -- pyth_12 / zwolle
+    ,("Harrison","Lou","16-tone","",lou_harrison_16,"harrison_16")
+    ,("Johnston","Ben","MTP","1977",ben_johnston_mtp_1977,"") -- carlos_harm
+    ,("Johnston","Ben","25-tone","",ben_johnston_25,"johnston_25")
+    ,("Kirnberger","Johann Philipp","III","",kirnberger_iii,"kirnberger")
+    ,("Malcolm","Alexander","Monochord","1721",five_limit_tuning,"malcolm") -- wurschmidt
+    ,("Partch","Harry","43-tone","",partch_43,"partch_43")
+    ,("Polansky","Larry","Piano Study #5","1985",ps5_jpr,"polansky_ps") -- 56-any
+    ,("Polansky","Larry","Psaltery","1978",psaltery_o,"") -- dconv9marv
+    ,("Riley","Terry","Harp of New Albion","",riley_albion,"riley_albion")
+    ,("Tsuda","Mayumi","13-limit","",mayumi_tsuda,"tsuda13")
+    ,("Vallotti","","","1754",vallotti,"vallotti") -- bemetzrieder2
+    ,("Werckmeister","Andreas","Werckmeister III","",werckmeister_iii,"werck3")
+    ,("Werckmeister","Andreas","Werckmeister IV","",werckmeister_iv,"werck4")
+    ,("Werckmeister","Andreas","Werckmeister V","",werckmeister_v,"werck5") -- ammerbach1
+    ,("Werckmeister","Andreas","Werckmeister VI","",werckmeister_vi,"werck6")
+    ,("Young","La Monte","The Well-Tuned Piano","",lmy_wtp,"young-lm_piano")
+    ,("Young","Thomas","","1799",thomas_young_1799,"young1") -- young2
+    ,("Zarlino","Gioseffo","","1588",zarlino_1588,"zarlino2") -- mersen_s3
+    ,("","","JI/12 7-limit","",septimal_tritone_just_intonation,"ji_12")
+    ,("","","ET/12","",tn_equal_temperament_12,"et12")
+    ,("","","ET/19","",tn_equal_temperament_19,"et19")
+    ,("","","ET/31","",tn_equal_temperament_31,"et13")
+    ,("","","ET/53","",tn_equal_temperament_53,"et53")
+    ,("","","ET/72","",tn_equal_temperament_72,"et72")
+    ,("","","ET/96","",tn_equal_temperament_96,"et96")
+    ,("","","Pythagorean/12","",pythagorean_12,"pyth_12") -- zwolle
+    ]
+
+tuning_db_lookup_scl :: String -> Maybe Tuning
+tuning_db_lookup_scl nm = fmap named_tuning_t (find (\(_,_,_,_,_,scl) -> scl == nm) tuning_db)
+
+{-
+
+import Music.Theory.Tuning.Scala
+db <- scl_load_db
+f n = take n . scl_db_query_cdiff_asc round db . sort . tn_cents_octave
+f 2 pietro_aaron_1523
+pp = mapM_ (putStrLn . unlines . scale_stat . snd)
+mapM_ pp (map (f 2 . named_tuning_t) tuning_db)
+
+-}
+
diff --git a/Music/Theory/Tuning/Db/Alves.hs b/Music/Theory/Tuning/Db/Alves.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Db/Alves.hs
@@ -0,0 +1,30 @@
+-- | Bill Alves.
+module Music.Theory.Tuning.Db.Alves where
+
+import Music.Theory.Tuning.Type {- hmt -}
+
+{- | Ratios for 'harrison_ditone' (SCALA=pyth_12)
+
+> import Music.Theory.Tuning {- hmt -}
+> let c = [0,114,204,294,408,498,612,702,816,906,996,1110]
+> map (round . ratio_to_cents) harrison_ditone_r == c
+
+> import Music.Theory.Tuning.Scala {- hmt -}
+> scl_find_ji (harrison_ditone_r ++ [2])
+-}
+harrison_ditone_r :: [Rational]
+harrison_ditone_r =
+    [1,2187/2048 {- 256/243 -}
+    ,9/8,32/27
+    ,81/64
+    ,4/3,729/512
+    ,3/2,6561/4096 {- 128/81 -}
+    ,27/16,16/9
+    ,243/128]
+
+-- | Ditone/pythagorean tuning, <http://www.billalves.com/porgitaro/ditonesettuning.html>
+--
+-- > tn_divisions harrison_ditone == 12
+-- > tn_cents_i harrison_ditone == [0,114,204,294,408,498,612,702,816,906,996,1110]
+harrison_ditone :: Tuning
+harrison_ditone = Tuning (Left harrison_ditone_r) Nothing
diff --git a/Music/Theory/Tuning/Db/Gann.hs b/Music/Theory/Tuning/Db/Gann.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Db/Gann.hs
@@ -0,0 +1,130 @@
+-- | Kyle Gann.
+module Music.Theory.Tuning.Db.Gann where
+
+import Music.Theory.Tuning {- hmt -}
+import Music.Theory.Tuning.Type {- hmt -}
+
+-- * Historical
+
+-- | Cents for 'pietro_aaron_1523'.
+--
+-- > let c = [0,76,193,310,386,503,580,697,773,890,1007,1083]
+-- > map round pietro_aaron_1523_c == c
+--
+-- > map ((+ 60) . (/ 100)) pietro_aaron_1523_c
+pietro_aaron_1523_c :: [Cents]
+pietro_aaron_1523_c =
+    [0,76.0
+    ,193.2,310.3
+    ,386.3 -- 5/4
+    ,503.4,579.5
+    ,696.8,772.6 -- 25/16
+    ,889.7,1006.8
+    ,1082.9]
+
+-- | Pietro Aaron (1523) meantone temperament, see
+-- <http://www.kylegann.com/histune.html>
+--
+-- > tn_cents_i pietro_aaron_1523 == [0,76,193,310,386,503,580,697,773,890,1007,1083]
+--
+-- > import Music.Theory.Tuning.Scala
+-- > scl <- scl_load "meanquar"
+-- > tn_cents_i (scale_to_tuning 0.01 scl) == [0,76,193,310,386,503,579,697,773,890,1007,1083]
+pietro_aaron_1523 :: Tuning
+pietro_aaron_1523 = Tuning (Right pietro_aaron_1523_c) Nothing
+
+-- | Cents for 'thomas_young_1799'.
+--
+-- > let c = [0,94,196,298,392,500,592,698,796,894,1000,1092]
+-- > map round thomas_young_1799_c == c
+thomas_young_1799_c :: [Cents]
+thomas_young_1799_c =
+    [0,93.9
+    ,195.8,297.8
+    ,391.7
+    ,499.9,591.9
+    ,697.9,795.8
+    ,893.8,999.8
+    ,1091.8]
+
+-- | Thomas Young (1799), Well Temperament, <http://www.kylegann.com/histune.html>.
+--
+-- > tn_cents_i thomas_young_1799 == [0,94,196,298,392,500,592,698,796,894,1000,1092]
+--
+-- > scl <- scl_load "young2"
+-- > tn_cents_i (scale_to_tuning 0.01 scl) == tn_cents_i thomas_young_1799
+thomas_young_1799 :: Tuning
+thomas_young_1799 = Tuning (Right thomas_young_1799_c) Nothing
+
+-- | Ratios for 'zarlino'.
+--
+-- > length zarlino_1588_r == 16
+zarlino_1588_r :: [Rational]
+zarlino_1588_r = [1,25/24,10/9,9/8,32/27,6/5,5/4,4/3,25/18,45/32,3/2,25/16,5/3,16/9,9/5,15/8]
+
+-- | Gioseffo Zarlino, 1588, see <http://www.kylegann.com/tuning.html>.
+--
+-- > tn_divisions zarlino_1588 == 16
+-- > tn_cents_i zarlino_1588 == [0,71,182,204,294,316,386,498,569,590,702,773,884,996,1018,1088]
+--
+-- > scl <- scl_load "zarlino2"
+-- > tn_cents_i (scale_to_tuning 0.01 scl) == tn_cents_i zarlino_1588
+zarlino_1588 :: Tuning
+zarlino_1588 = Tuning (Left zarlino_1588_r) Nothing
+
+-- * 20th Century
+
+-- | Ratios for 'ben_johnston_mtp_1977'.
+--
+-- > let c = [0,105,204,298,386,471,551,702,841,906,969,1088]
+-- > map (round . ratio_to_cents) ben_johnston_mtp_1977_r == c
+ben_johnston_mtp_1977_r :: [Rational]
+ben_johnston_mtp_1977_r =
+    [1,17/16
+    ,9/8,19/16
+    ,5/4
+    ,216,11/8
+    ,3/2,13/8
+    ,27/16,7/4
+    ,15/8]
+
+-- | Ben Johnston's \"Suite for Microtonal Piano\" (1977), see
+-- <http://www.kylegann.com/tuning.html>
+--
+-- > tn_cents_i ben_johnston_mtp_1977 == [0,105,204,298,386,471,551,702,841,906,969,1088]
+ben_johnston_mtp_1977 :: Tuning
+ben_johnston_mtp_1977 = Tuning (Left ben_johnston_mtp_1977_r) Nothing
+
+-- * Gann
+
+-- | Ratios for 'gann_arcana_xvi'.
+gann_arcana_xvi_r :: [Rational]
+gann_arcana_xvi_r =
+    [1,21/20,16/15,9/8,7/6,6/5,11/9,5/4,216,4/3,27/20,7/5
+    ,22/15,3/2,55/36,8/5,44/27,5/3,42/25,7/4,9/5,11/6,15/8,88/45]
+
+-- | Kyle Gann, _Arcana XVI_, see <http://www.kylegann.com/Arcana.html>.
+--
+-- > let r = [0,84,112,204,267,316,347,386,471,498,520,583,663,702,734,814,845,884,898,969,1018,1049,1088,1161]
+-- > tn_cents_i gann_arcana_xvi == r
+gann_arcana_xvi :: Tuning
+gann_arcana_xvi = Tuning (Left gann_arcana_xvi_r) Nothing
+
+-- | Ratios for 'gann_superparticular'.
+gann_superparticular_r :: [Rational]
+gann_superparticular_r =
+    [1,110,10/9,9/8,8/7,7/6,6/5,5/4,9/7,4/3
+    ,11/8,7/5,10/7,3/2
+    ,11/7,14/9,8/5,5/3,12/7,7/4,16/9,9/5]
+
+-- | Kyle Gann, _Superparticular_, see <http://www.kylegann.com/Super.html>.
+--
+-- > tn_divisions gann_superparticular == 22
+--
+-- > let r = [0,165,182,204,231,267,316,386,435,498,551,583,617,702,782,765,814,884,933,969,996,1018]
+-- > tn_cents_i gann_superparticular == r
+--
+-- > scl <- scl_load "gann_super"
+-- > tn_cents_i (scale_to_tuning 0.01 scl) == tn_cents_i gann_superparticular
+gann_superparticular :: Tuning
+gann_superparticular = Tuning (Left gann_superparticular_r) Nothing
diff --git a/Music/Theory/Tuning/Db/Microtonal_Synthesis.hs b/Music/Theory/Tuning/Db/Microtonal_Synthesis.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Db/Microtonal_Synthesis.hs
@@ -0,0 +1,231 @@
+-- | <http://www.microtonal-synthesis.com/scales.html>
+module Music.Theory.Tuning.Db.Microtonal_Synthesis where
+
+import Music.Theory.Tuning {- hmt -}
+import Music.Theory.Tuning.Type {- hmt -}
+
+-- | Ratios for 'pythagorean'.
+pythagorean_12_r :: [Rational]
+pythagorean_12_r =
+    [1,2187/2048 {- 256/243 -}
+    ,9/8,32/27
+    ,81/64
+    ,4/3,729/512
+    ,3/2,6561/4096 {- 128/81 -}
+    ,27/16,16/9
+    ,243/128]
+
+-- | Pythagorean tuning, <http://www.microtonal-synthesis.com/scale_pythagorean.html>.
+--
+-- > cents_i pythagorean_12 == [0,114,204,294,408,498,612,702,816,906,996,1110]
+--
+-- > scl <- scl_load "pyth_12"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i pythagorean_12
+pythagorean_12 :: Tuning
+pythagorean_12 = Tuning (Left pythagorean_12_r) Nothing
+
+-- | Ratios for 'five_limit_tuning'.
+--
+-- > let c = [0,112,204,316,386,498,590,702,814,884,996,1088]
+-- > in map (round . ratio_to_cents) five_limit_tuning_r == c
+five_limit_tuning_r :: [Rational]
+five_limit_tuning_r =
+    [1,16/15
+    ,9/8,6/5
+    ,5/4
+    ,4/3,45/32 {- 64/45 -}
+    ,3/2,8/5
+    ,5/3,16/9 {- 9/5 -}
+    ,15/8]
+
+-- | Five-limit tuning (five limit just intonation), Alexander Malcolm's Monochord (1721).
+--
+-- > cents_i five_limit_tuning == [0,112,204,316,386,498,590,702,814,884,996,1088]
+--
+-- > scl <- scl_load "malcolm"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i five_limit_tuning
+five_limit_tuning :: Tuning
+five_limit_tuning = Tuning (Left five_limit_tuning_r) Nothing
+
+-- | Ratios for 'septimal_tritone_just_intonation'.
+--
+-- > let c = [0,112,204,316,386,498,583,702,814,884,1018,1088]
+-- > in map (round . ratio_to_cents) septimal_tritone_just_intonation == c
+septimal_tritone_just_intonation_r :: [Rational]
+septimal_tritone_just_intonation_r =
+    [1,16/15
+    ,9/8,6/5
+    ,5/4
+    ,4/3,7/5
+    ,3/2,8/5
+    ,5/3,9/5
+    ,15/8]
+
+-- | Septimal tritone Just Intonation, see
+-- <http://www.microtonal-synthesis.com/scale_just_intonation.html>
+--
+-- > let c = [0,112,204,316,386,498,583,702,814,884,1018,1088]
+-- > in cents_i septimal_tritone_just_intonation == c
+--
+-- > scl <- scl_load "ji_12"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i septimal_tritone_just_intonation
+septimal_tritone_just_intonation :: Tuning
+septimal_tritone_just_intonation = Tuning (Left septimal_tritone_just_intonation_r) Nothing
+
+-- | Ratios for 'seven_limit_just_intonation'.
+--
+-- > let c = [0,112,204,316,386,498,583,702,814,884,969,1088]
+-- > in map (round . ratio_to_cents) seven_limit_just_intonation == c
+seven_limit_just_intonation_r :: [Rational]
+seven_limit_just_intonation_r =
+    [1,16/15
+    ,9/8,6/5
+    ,5/4
+    ,4/3,7/5
+    ,3/2,8/5
+    ,5/3,7/4
+    ,15/8]
+
+-- | Seven limit Just Intonation.
+--
+-- > cents_i seven_limit_just_intonation == [0,112,204,316,386,498,583,702,814,884,969,1088]
+seven_limit_just_intonation :: Tuning
+seven_limit_just_intonation = Tuning (Left seven_limit_just_intonation_r) Nothing
+
+-- | Approximate ratios for 'kirnberger_iii'.
+--
+-- > let c = [0,90,193,294,386,498,590,697,792,890,996,1088]
+-- > in map (round.to_cents) kirnberger_iii_ar == c
+kirnberger_iii_ar :: [Approximate_Ratio]
+kirnberger_iii_ar =
+    [1,256/243
+    ,sqrt 5 / 2,32/27
+    ,5/4
+    ,4/3,45/32
+    ,5 ** 0.25,128/81
+    ,(5 ** 0.75)/2,16/9
+    ,15/8]
+
+-- | <http://www.microtonal-synthesis.com/scale_kirnberger.html>.
+--
+-- > cents_i kirnberger_iii == [0,90,193,294,386,498,590,697,792,890,996,1088]
+--
+-- > scl <- scl_load "kirnberger"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i kirnberger_iii
+kirnberger_iii :: Tuning
+kirnberger_iii = Tuning (Right (map approximate_ratio_to_cents kirnberger_iii_ar)) Nothing
+
+-- > let c = [0,94,196,298,392,502,592,698,796,894,1000,1090]
+-- > in map round vallotti_c == c
+vallotti_c :: [Cents]
+vallotti_c =
+    [0.0,94.135
+    ,196.09,298.045
+    ,392.18
+    ,501.955,592.18
+    ,698.045,796.09
+    ,894.135,1000.0
+    ,1090.225]
+
+-- | Vallotti & Young scale (Vallotti version), see
+-- <http://www.microtonal-synthesis.com/scale_vallotti_young.html>.
+--
+-- > cents_i vallotti == [0,94,196,298,392,502,592,698,796,894,1000,1090]
+--
+-- > scl <- scl_load "vallotti"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i vallotti
+vallotti :: Tuning
+vallotti = Tuning (Right vallotti_c) Nothing
+
+-- > let c = [0,128,139,359,454,563,637,746,841,911,1072,1183]
+-- > in map (round . ratio_to_cents) mayumi_tsuda == c
+mayumi_tsuda_r :: [Rational]
+mayumi_tsuda_r =
+    [1,14/13
+    ,13/12,16/13
+    ,13/10
+    ,18/13,13/9
+    ,20/13,13/8
+    ,22/13,13/7
+    ,208/105]
+
+-- | Mayumi Tsuda 13-limit Just Intonation scale,
+-- <http://www.microtonal-synthesis.com/scale_reinhard.html>.
+--
+-- > cents_i mayumi_tsuda == [0,128,139,359,454,563,637,746,841,911,1072,1183]
+--
+-- > scl <- scl_load "tsuda13"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i mayumi_tsuda
+mayumi_tsuda :: Tuning
+mayumi_tsuda = Tuning (Left mayumi_tsuda_r) Nothing
+
+-- | Ratios for 'lou_harrison_16'.
+--
+-- > length lou_harrison_16_r == 16
+--
+-- > let c = [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
+-- > in map (round . ratio_to_cents) lou_harrison_16_r == c
+lou_harrison_16_r :: [Rational]
+lou_harrison_16_r =
+    [1,16/15
+    ,10/9,8/7
+    ,7/6,6/5,5/4
+    ,4/3
+    ,17/12
+    ,3/2
+    ,8/5,5/3,12/7
+    ,7/4,9/5,15/8]
+
+-- | Lou Harrison 16 tone Just Intonation scale, see
+-- <http://www.microtonal-synthesis.com/scale_harrison_16.html>
+--
+-- > let r = [0,112,182,231,267,316,386,498,603,702,814,884,933,969,1018,1088]
+-- > in cents_i lou_harrison_16 == r
+--
+-- > import Music.Theory.Tuning.Scala
+-- > scl <- scl_load "harrison_16"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i lou_harrison_16
+lou_harrison_16 :: Tuning
+lou_harrison_16 = Tuning (Left lou_harrison_16_r) Nothing
+
+-- | Ratios for 'partch_43'.
+partch_43_r :: [Rational]
+partch_43_r =
+    [1,81/80,33/32,21/20,16/15,12/11,110,10/9,9/8,8/7
+    ,7/6,32/27,6/5,11/9,5/4,14/11,9/7
+    ,216,4/3,27/20
+    ,11/8,7/5,10/7,16/11
+    ,40/27,3/2,32/21,14/9,11/7,8/5,18/11,5/3,27/16,12/7
+    ,7/4,16/9,9/5,20/11,11/6,15/8,40/21,64/33,160/81]
+
+-- | Harry Partch 43 tone scale, see
+-- <http://www.microtonal-synthesis.com/scale_partch.html>
+--
+-- > cents_i partch_43 == [0,22,53,84,112,151,165
+-- >                      ,182,204,231,267,294,316
+-- >                      ,347,386,418,435
+-- >                      ,471,498,520,551,583,617,649
+-- >                      ,680,702,729,765,782,814,853,884,906,933
+-- >                      ,969,996,1018,1035,1049,1088,1116,1147,1178]
+--
+-- > scl <- scl_load "partch_43"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i partch_43
+partch_43 :: Tuning
+partch_43 = Tuning (Left partch_43_r) Nothing
+
+-- | Ratios for 'ben_johnston_25'.
+ben_johnston_25_r :: [Rational]
+ben_johnston_25_r =
+    [1,25/24,135/128,16/15,10/9
+    ,9/8,75/64,6/5,5/4,81/64
+    ,32/25,4/3,27/20,45/32,36/25
+    ,3/2,25/16,8/5,5/3,27/16
+    ,225/128,16/9,9/5,15/8,48/25]
+
+-- | Ben Johnston 25 note just enharmonic scale, see
+-- <http://www.microtonal-synthesis.com/scale_johnston_25.html>
+--
+-- > scl <- scl_load "johnston_25"
+-- > cents_i (scale_tuning 0.1 scl) == cents_i ben_johnston_25
+ben_johnston_25 :: Tuning
+ben_johnston_25 = Tuning (Left ben_johnston_25_r) Nothing
diff --git a/Music/Theory/Tuning/Db/Riley.hs b/Music/Theory/Tuning/Db/Riley.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Db/Riley.hs
@@ -0,0 +1,22 @@
+-- | Terry Riley.
+module Music.Theory.Tuning.Db.Riley where
+
+import Music.Theory.Tuning.Type {- hmt -}
+
+-- | Ratios for 'riley_albion'.
+--
+-- > let r = [0,112,204,316,386,498,610,702,814,884,996,1088]
+-- > in map (round . ratio_to_cents) riley_albion_r == r
+riley_albion_r :: [Rational]
+riley_albion_r = [1,16/15,9/8,6/5,5/4,4/3,64/45,3/2,8/5,5/3,16/9,15/8]
+
+-- | Riley's five-limit tuning as used in _The Harp of New Albion_,
+-- see <http://www.ex-tempore.org/Volx1/hudson/hudson.htm>.
+--
+-- > cents_i riley_albion == [0,112,204,316,386,498,610,702,814,884,996,1088]
+--
+-- > import Music.Theory.Tuning.Scala
+-- > scl <- scl_load "riley_albion"
+-- > cents_i (scale_tuning 0.01 scl) == cents_i riley_albion
+riley_albion :: Tuning
+riley_albion = Tuning (Left riley_albion_r) Nothing
diff --git a/Music/Theory/Tuning/Db/Werckmeister.hs b/Music/Theory/Tuning/Db/Werckmeister.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Db/Werckmeister.hs
@@ -0,0 +1,118 @@
+-- | Andreas Werckmeister (1645-1706).
+module Music.Theory.Tuning.Db.Werckmeister where
+
+import Music.Theory.Tuning {- hmt -}
+import Music.Theory.Tuning.Type {- hmt -}
+
+-- | Approximate ratios for 'werckmeister_iii'.
+--
+-- > let c = [0,90,192,294,390,498,588,696,792,888,996,1092]
+-- > in map (round . ratio_to_cents) werckmeister_iii_ar == c
+werckmeister_iii_ar :: [Approximate_Ratio]
+werckmeister_iii_ar =
+    let c0 = 2 ** (1/2)
+        c1 = 2 ** (1/4)
+        c2 = 8 ** (1/4)
+    in [1,256/243
+       ,64/81 * c0,32/27
+       ,256/243 * c1
+       ,4/3,1024/729
+       ,8/9 * c2,128/81
+       ,1024/729 * c1,16/9
+       ,128/81 * c1]
+
+-- | Cents for 'werckmeister_iii'.
+werckmeister_iii_ar_c :: [Cents]
+werckmeister_iii_ar_c = map approximate_ratio_to_cents werckmeister_iii_ar
+
+-- | Werckmeister III, Andreas Werckmeister (1645-1706)
+--
+-- > cents_i werckmeister_iii == [0,90,192,294,390,498,588,696,792,888,996,1092]
+--
+-- > import Music.Theory.Tuning.Scala
+-- > scl <- scl_load "werck3"
+-- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_iii
+werckmeister_iii :: Tuning
+werckmeister_iii = Tuning (Right werckmeister_iii_ar_c) Nothing
+
+-- | Approximate ratios for 'werckmeister_iv'.
+--
+-- > let c = [0,82,196,294,392,498,588,694,784,890,1004,1086]
+-- > in map (round . ratio_to_cents) werckmeister_iv_ar == c
+werckmeister_iv_ar :: [Approximate_Ratio]
+werckmeister_iv_ar =
+    let c0 = 2 ** (1/3)
+        c1 = 4 ** (1/3)
+    in [1,16384/19683 * c0
+       ,8/9 * c0,32/27
+       ,64/81 * c1
+       ,4/3,1024/729
+       ,32/27 * c0,8192/6561 * c0
+       ,256/243 * c1,9/(4*c0)
+       ,4096/2187]
+
+-- | Cents for 'werckmeister_iv'.
+werckmeister_iv_c :: [Cents]
+werckmeister_iv_c = map approximate_ratio_to_cents werckmeister_iv_ar
+
+-- | Werckmeister IV, Andreas Werckmeister (1645-1706)
+--
+-- > cents_i werckmeister_iv == [0,82,196,294,392,498,588,694,784,890,1004,1086]
+--
+-- > scl <- scl_load "werck4"
+-- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_iv
+werckmeister_iv :: Tuning
+werckmeister_iv = Tuning (Right werckmeister_iv_c) Nothing
+
+-- | Approximate ratios for 'werckmeister_v'.
+--
+-- > let c = [0,96,204,300,396,504,600,702,792,900,1002,1098]
+-- > in map (round . ratio_to_cents) werckmeister_v_ar == c
+werckmeister_v_ar :: [Approximate_Ratio]
+werckmeister_v_ar =
+    let c0 = 2 ** (1/4)
+        c1 = 2 ** (1/2)
+        c2 = 8 ** (1/4)
+    in [1,8/9 * c0
+       ,9/8,c0
+       ,8/9 * c1
+       ,9/8 * c0,c1
+       ,3/2,128/81
+       ,c2,3/c2
+       ,4/3 * c1]
+
+-- | Cents for 'werckmeister_v'.
+werckmeister_v_c :: [Cents]
+werckmeister_v_c = map approximate_ratio_to_cents werckmeister_v_ar
+
+-- | Werckmeister V, Andreas Werckmeister (1645-1706)
+--
+-- > cents_i werckmeister_v == [0,96,204,300,396,504,600,702,792,900,1002,1098]
+--
+-- > scl <- scl_load "werck5"
+-- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_v
+werckmeister_v :: Tuning
+werckmeister_v = Tuning (Right werckmeister_v_c) Nothing
+
+-- | Ratios for 'werckmeister_vi', with supposed correction of 28/25 to 49/44.
+--
+-- > let c = [0,91,186,298,395,498,595,698,793,893,1000,1097]
+-- > in map (round . ratio_to_cents) werckmeister_vi_r == c
+werckmeister_vi_r :: [Rational]
+werckmeister_vi_r =
+    [1,98/93
+    ,49/44 {- 28/25 -},196/165
+    ,49/39
+    ,4/3,196/139
+    ,196/131,49/31
+    ,196/117,98/55
+    ,49/26]
+
+-- | Werckmeister VI, Andreas Werckmeister (1645-1706)
+--
+-- > cents_i werckmeister_vi == [0,91,186,298,395,498,595,698,793,893,1000,1097]
+--
+-- > scl <- scl_load "werck6"
+-- > cents_i (scale_tuning 0.01 scl) == cents_i werckmeister_vi
+werckmeister_vi :: Tuning
+werckmeister_vi = Tuning (Left werckmeister_vi_r) Nothing
diff --git a/Music/Theory/Tuning/ET.hs b/Music/Theory/Tuning/ET.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/ET.hs
+++ /dev/null
@@ -1,259 +0,0 @@
--- | Equal temperament tuning tables.
-module Music.Theory.Tuning.ET where
-
-import Data.List {- base -}
-import Data.List.Split {- split -}
-import Data.Ratio {- base -}
-import Text.Printf {- base -}
-
-import qualified Music.Theory.List as T {- hmt -}
-import Music.Theory.Pitch {- hmt -}
-import Music.Theory.Pitch.Note {- hmt -}
-import Music.Theory.Pitch.Spelling.Table {- hmt -}
-import Music.Theory.Tuning {- hmt -}
-
--- | 'octpc_to_pitch' and 'octpc_to_cps'.
-octpc_to_pitch_cps_f0 :: (Floating n) => n -> OctPC -> (Pitch,n)
-octpc_to_pitch_cps_f0 f0 x = (octpc_to_pitch pc_spell_ks x,octpc_to_cps_f0 f0 x)
-
--- | 'octpc_to_pitch' and 'octpc_to_cps'.
-octpc_to_pitch_cps :: (Floating n) => OctPC -> (Pitch,n)
-octpc_to_pitch_cps = octpc_to_pitch_cps_f0 440
-
--- | 12-tone equal temperament table equating 'Pitch' and frequency
--- over range of human hearing, where @A4@ has given frequency.
---
--- > tbl_12et_f0 415
-tbl_12et_f0 :: Double -> [(Pitch,Double)]
-tbl_12et_f0 f0 =
-    let z = [(o,pc) | o <- [0..10], pc <- [0..11]]
-    in map (octpc_to_pitch_cps_f0 f0) z
-
--- | 'tbl_12et_f0' @440@hz.
---
--- > length tbl_12et == 132
--- > minmax (map (round . snd) tbl_12et) == (16,31609)
-tbl_12et :: [(Pitch,Double)]
-tbl_12et = tbl_12et_f0 440
-
--- | 24-tone equal temperament variant of 'tbl_12et_f0'.
-tbl_24et_f0 :: Double -> [(Pitch,Double)]
-tbl_24et_f0 f0 =
-    let f x = let p = fmidi_to_pitch_err pc_spell_ks x
-                  p' = pitch_rewrite_threequarter_alteration p
-              in (p',fmidi_to_cps_f0 f0 x)
-    in map f [12,12.5 .. 143.5]
-
--- | 'tbl_24et_f0' @440@.
---
--- > length tbl_24et == 264
--- > minmax (map (round . snd) tbl_24et) == (16,32535)
-tbl_24et :: [(Pitch,Double)]
-tbl_24et = tbl_24et_f0 440
-
--- | Given an @ET@ table (or like) find bounds of frequency.
---
--- import qualified Music.Theory.Tuple as T
---
--- > let r = Just (T.t2_map octpc_to_pitch_cps ((3,11),(4,0)))
--- > in bounds_et_table tbl_12et 256 == r
-bounds_et_table :: Ord s => [(t,s)] -> s -> Maybe ((t,s),(t,s))
-bounds_et_table = T.find_bounds True (compare . snd)
-
--- | 'bounds_et_table' of 'tbl_12et'.
---
--- > map bounds_12et_tone (hsn 17 55)
-bounds_12et_tone :: Double -> Maybe ((Pitch,Double),(Pitch,Double))
-bounds_12et_tone = bounds_et_table tbl_12et
-
--- | Tuple indicating nearest 'Pitch' to /frequency/ with @ET@
--- frequency, and deviation in hertz and 'Cents'.
---
--- (cps,nearest-pitch,cps-of-nearest-pitch,cps-deviation,cents-deviation)
-type HS_R p = (Double,p,Double,Double,Cents)
-
--- | /n/-decimal places.
---
--- > ndp 3 (1/3) == "0.333"
-ndp :: Int -> Double -> String
-ndp = printf "%.*f"
-
--- | Pretty print 'HS_R'.
-hs_r_pp :: (p -> String) -> Int -> HS_R p -> [String]
-hs_r_pp pp n (f,p,pf,fd,c) =
-    let dp = ndp n
-    in [dp f
-       ,pp p
-       ,dp pf
-       ,dp fd
-       ,dp c]
-
-hs_r_pitch_pp :: Int -> HS_R Pitch -> [String]
-hs_r_pitch_pp = hs_r_pp pitch_pp
-
-{- | Form 'HS_R' for /frequency/ by consulting table.
-
-> let {f = 256
->     ;f' = octpc_to_cps (4,0)
->     ;r = (f,Pitch C Natural 4,f',f-f',fratio_to_cents (f/f'))}
-> in nearest_et_table_tone tbl_12et 256 == r
-
--}
-nearest_et_table_tone :: [(p,Double)] -> Double -> HS_R p
-nearest_et_table_tone tbl f =
-    case bounds_et_table tbl f of
-      Nothing -> error "nearest_et_table_tone: no bounds?"
-      Just ((lp,lf),(rp,rf)) ->
-          let ld = f - lf
-              rd = f - rf
-          in if abs ld < abs rd
-             then (f,lp,lf,ld,fratio_to_cents (f/lf))
-             else (f,rp,rf,rd,fratio_to_cents (f/rf))
-
--- | 'nearest_et_table_tone' for 'tbl_12et'.
-nearest_12et_tone :: Double -> HS_R Pitch
-nearest_12et_tone = nearest_et_table_tone tbl_12et
-
--- | 'nearest_et_table_tone' for 'tbl_24et'.
---
--- > let r = "55.0 A1 55.0 0.0 0.0"
--- > in unwords (hs_r_pitch_pp 1 (nearest_24et_tone 55)) == r
-nearest_24et_tone :: Double -> HS_R Pitch
-nearest_24et_tone = nearest_et_table_tone tbl_24et
-
--- * 72ET
-
--- | Monzo 72-edo HEWM notation.  The domain is (-9,9).
--- <http://www.tonalsoft.com/enc/number/72edo.aspx>
---
--- > let r = ["+",">","^","#<","#-","#","#+","#>","#^"]
--- > in map alteration_72et_monzo [1 .. 9] == r
---
--- > let r = ["-","<","v","b>","b+","b","b-","b<","bv"]
--- > in map alteration_72et_monzo [-1,-2 .. -9] == r
-alteration_72et_monzo :: Integral n => n -> String
-alteration_72et_monzo n =
-    let spl = splitOn ","
-        asc = spl ",+,>,^,#<,#-,#,#+,#>,#^"
-        dsc = spl ",-,<,v,b>,b+,b,b-,b<,bv"
-    in case compare n 0 of
-         LT -> genericIndex dsc (- n)
-         EQ -> ""
-         GT -> genericIndex asc n
-
--- | Given a midi note number and @1/6@ deviation determine 'Pitch''
--- and frequency.
---
--- > let {f = pitch'_pp . fst . pitch_72et
--- >     ;r = "C4 C+4 C>4 C^4 C#<4 C#-4 C#4 C#+4 C#>4 C#^4"}
--- > in unwords (map f (zip (repeat 60) [0..9])) == r
---
--- > let {f = pitch'_pp . fst . pitch_72et
--- >     ;r = "A4 A+4 A>4 A^4 Bb<4 Bb-4 Bb4 Bb+4 Bb>4 Bv4"}
--- > in unwords (map f (zip (repeat 69) [0..9]))
---
--- > let {f = pitch'_pp . fst . pitch_72et
--- >     ;r = "Bb4 Bb+4 Bb>4 Bv4 B<4 B-4 B4 B+4 B>4 B^4"}
--- > in unwords (map f (zip (repeat 70) [0..9])) == r
-pitch_72et :: (Int,Int) -> (Pitch_R,Double)
-pitch_72et (x,n) =
-    let p = midi_to_pitch pc_spell_ks x
-        t = note p
-        a = alteration p
-        (t',n') = case a of
-                    Flat -> if n < (-3) then (pred t,n + 6) else (t,n - 6)
-                    Natural -> (t,n)
-                    Sharp -> if n > 3 then (succ t,n - 6) else (t,n + 6)
-                    _ -> error "pitch_72et: alteration?"
-        a' = alteration_72et_monzo n'
-        x' = fromIntegral x + (fromIntegral n / 6)
-        r = (Pitch_R t' (fromIntegral n' % 12,a') (octave p),fmidi_to_cps x')
-        r' = if n > 3
-             then pitch_72et (x + 1,n - 6)
-             else if n < (-3)
-                  then pitch_72et (x - 1,n + 6)
-                  else r
-    in case a of
-         Natural -> r'
-         _ -> r
-
--- | 72-tone equal temperament table equating 'Pitch'' and frequency
--- over range of human hearing, where @A4@ = @440@hz.
---
--- > length tbl_72et == 792
--- > min_max (map (round . snd) tbl_72et) == (16,33167)
-tbl_72et :: [(Pitch_R,Double)]
-tbl_72et =
-    let f n = map pitch_72et (zip (replicate 6 n) [0..5])
-    in concatMap f [12 .. 143]
-
--- | 'nearest_et_table_tone' for 'tbl_72et'.
---
--- > let r = "324.0 E<4 323.3 0.7 3.5"
--- > in unwords (hs_r_pp pitch'_pp 1 (nearest_72et_tone 324))
---
--- > let {f = take 2 . hs_r_pp pitch'_pp 1 . nearest_72et_tone . snd}
--- > in mapM_ (print . unwords . f) tbl_72et
-nearest_72et_tone :: Double -> HS_R Pitch_R
-nearest_72et_tone = nearest_et_table_tone tbl_72et
-
--- * Detune
-
--- | 'Pitch' with 12-ET/24-ET tuning deviation given in 'Cents'.
-type Pitch_Detune = (Pitch,Cents)
-
--- | Extract 'Pitch_Detune' from 'HS_R'.
-hsr_to_pitch_detune :: HS_R Pitch -> Pitch_Detune
-hsr_to_pitch_detune (_,p,_,_,c) = (p,c)
-
--- | Nearest 12-ET 'Pitch_Detune' to indicated frequency (hz).
---
--- > nearest_pitch_detune_12et 452.8929841231365
-nearest_pitch_detune_12et :: Double -> Pitch_Detune
-nearest_pitch_detune_12et = hsr_to_pitch_detune . nearest_12et_tone
-
--- | Nearest 24-ET 'Pitch_Detune' to indicated frequency (hz).
---
--- > nearest_pitch_detune_24et 452.8929841231365
-nearest_pitch_detune_24et :: Double -> Pitch_Detune
-nearest_pitch_detune_24et = hsr_to_pitch_detune . nearest_24et_tone
-
--- | Given /near/ function, /f0/ and ratio derive 'Pitch_Detune'.
-ratio_to_pitch_detune :: (Double -> HS_R Pitch) -> OctPC -> Rational -> Pitch_Detune
-ratio_to_pitch_detune near_f f0 r =
-    let f = octpc_to_cps f0 * realToFrac r
-        (_,p,_,_,c) = near_f f
-    in (p,c)
-
--- | Frequency (hz) of 'Pitch_Detune'.
---
--- > pitch_detune_to_cps (octpc_to_pitch pc_spell_ks (4,9),50)
-pitch_detune_to_cps :: Floating n => Pitch_Detune -> n
-pitch_detune_to_cps (p,d) = cps_shift_cents (pitch_to_cps p) (realToFrac d)
-
--- | 'ratio_to_pitch_detune' of 'nearest_12et_tone'
-ratio_to_pitch_detune_12et :: OctPC -> Rational -> Pitch_Detune
-ratio_to_pitch_detune_12et = ratio_to_pitch_detune nearest_12et_tone
-
--- | 'ratio_to_pitch_detune' of 'nearest_24et_tone'
-ratio_to_pitch_detune_24et :: OctPC -> Rational -> Pitch_Detune
-ratio_to_pitch_detune_24et = ratio_to_pitch_detune nearest_24et_tone
-
-pitch_detune_in_octave_nearest  :: Pitch -> Pitch_Detune -> Pitch_Detune
-pitch_detune_in_octave_nearest p1 (p2,d2) = (pitch_in_octave_nearest p1 p2,d2)
-
--- | Markdown pretty-printer for 'Pitch_Detune'.
-pitch_detune_md :: Pitch_Detune -> String
-pitch_detune_md (p,c) = pitch_pp p ++ cents_diff_md (round c :: Integer)
-
--- | HTML pretty-printer for 'Pitch_Detune'.
-pitch_detune_html :: Pitch_Detune -> String
-pitch_detune_html (p,c) = pitch_pp p ++ cents_diff_html (round c :: Integer)
-
--- | No-octave variant of 'pitch_detune_md'.
-pitch_class_detune_md :: Pitch_Detune -> String
-pitch_class_detune_md (p,c) = pitch_class_pp p ++ cents_diff_md (round c :: Integer)
-
--- | No-octave variant of 'pitch_detune_html'.
-pitch_class_detune_html :: Pitch_Detune -> String
-pitch_class_detune_html (p,c) = pitch_class_pp p ++ cents_diff_html (round c :: Integer)
diff --git a/Music/Theory/Tuning/Efg.hs b/Music/Theory/Tuning/Efg.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Efg.hs
@@ -0,0 +1,111 @@
+-- | Euler-Fokker genus <http://www.huygens-fokker.org/microtonality/efg.html>
+module Music.Theory.Tuning.Efg where
+
+import Data.List {- base -}
+
+import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Set.List as T {- hmt -}
+
+import Music.Theory.Tuning {- hmt -}
+
+-- | Normal form, value with occurences count (ie. exponent in notation above).
+type Efg i = [(i,Int)]
+
+-- | Degree of Efg, ie. sum of exponents.
+--
+-- > efg_degree [(3,3),(7,2)] == 3 + 2
+efg_degree :: Efg i -> Int
+efg_degree = sum . map snd
+
+-- | Number of tones of Efg, ie. product of increment of exponents.
+--
+-- > efg_tones [(3,3),(7,2)] == (3 + 1) * (2 + 1)
+efg_tones :: Efg i -> Int
+efg_tones = product . map ((+ 1) . snd)
+
+-- | Collate a genus given as a multiset into standard form, ie. histogram.
+--
+-- > efg_collate [3,3,3,7,7] == [(3,3),(7,2)]
+efg_collate :: Ord i => [i] -> Efg i
+efg_collate = T.histogram . sort
+
+{- | Factors of Efg given with co-ordinate of grid location.
+
+> efg_factors [(3,3)]
+
+> let r = [([0,0],[]),([0,1],[7]),([0,2],[7,7])
+>         ,([1,0],[3]),([1,1],[3,7]),([1,2],[3,7,7])
+>         ,([2,0],[3,3]),([2,1],[3,3,7]),([2,2],[3,3,7,7])
+>         ,([3,0],[3,3,3]),([3,1],[3,3,3,7]),([3,2],[3,3,3,7,7])]
+
+> efg_factors [(3,3),(7,2)] == r
+
+-}
+efg_factors :: Efg i -> [([Int],[i])]
+efg_factors efg =
+    let k = map (\(_,n) -> [0 .. n]) efg
+        k' = if length efg == 1
+             then concatMap (map return) k
+             else T.nfold_cartesian_product k
+        z = map fst efg
+        f ix = (ix,concat (zipWith (\n m -> replicate n (z !! m)) ix [0..]))
+    in map f k'
+
+{- | Ratios of Efg, taking /n/ as the 1:1 ratio, with indices, folded into one octave.
+
+> import Data.List
+> let r = sort $ map snd $ efg_ratios 7 [(3,3),(7,2)]
+> r == [1/1,9/8,8/7,9/7,21/16,189/128,3/2,27/16,12/7,7/4,27/14,63/32]
+> map (round . ratio_to_cents) r == [0,204,231,435,471,675,702,906,933,969,1137,1173]
+
+      0:         1/1          C          0.000 cents
+      1:         9/8          D        203.910 cents
+      2:         8/7          D+       231.174 cents
+      3:         9/7          E+       435.084 cents
+      4:        21/16         F-       470.781 cents
+      5:       189/128        G-       674.691 cents
+      6:         3/2          G        701.955 cents
+      7:        27/16         A        905.865 cents
+      8:        12/7          A+       933.129 cents
+      9:         7/4          Bb-      968.826 cents
+     10:        27/14         B+      1137.039 cents
+     11:        63/32         C-      1172.736 cents
+     12:         2/1          C       1200.000 cents
+
+> let r' = sort $ map snd $ efg_ratios 5 [(5,2),(7,3)]
+> r' == [1/1,343/320,35/32,49/40,5/4,343/256,7/5,49/32,8/5,1715/1024,7/4,245/128]
+> map (round . ratio_to_cents) r' == [0,120,155,351,386,506,583,738,814,893,969,1124]
+
+> let r'' = sort $ map snd $ efg_ratios 3 [(3,1),(5,1),(7,1)]
+> r'' == [1/1,35/32,7/6,5/4,4/3,35/24,5/3,7/4]
+> map (round . ratio_to_cents) r'' == [0,155,267,386,498,653,884,969]
+
+> let c0 = [0,204,231,435,471,675,702,906,933,969,1137,1173,1200]
+> let c1 = [0,120,155,351,386,506,583,738,814,893,969,1124,1200]
+> let c2 = [0,155,267,386,498,653,884,969,1200]
+> let f (c',y) = map (\x -> (x,y,x,y + 10)) c'
+> map f (zip [c0,c1,c2] [0,20,40])
+
+-}
+efg_ratios :: Real r => Rational -> Efg r -> [([Int],Rational)]
+efg_ratios n =
+    let to_r = fold_ratio_to_octave_err . (/ n) . toRational . product
+        f (ix,i) = (ix,to_r i)
+    in map f . efg_factors
+
+{- | Generate a line drawing, as a set of (x0,y0,x1,y1) 4-tuples.
+     h=row height, m=distance of vertical mark from row edge, k=distance between rows
+
+> let e = [[3,3,3],[3,3,5],[3,5,5],[3,5,7],[3,7,7],[5,5,5],[5,5,7],[3,3,7],[5,7,7],[7,7,7]]
+> let e = [[3,3,3],[5,5,5],[7,7,7],[3,3,5],[3,5,5],[5,5,7],[5,7,7],[3,7,7],[3,3,7],[3,5,7]]
+> let e' = map efg_collate e
+> efg_diagram_set (round,25,4,75) e'
+
+-}
+efg_diagram_set :: (Enum n,Real n) => (Cents -> n,n,n,n) -> [Efg n] -> [(n,n,n,n)]
+efg_diagram_set (to_f,h,m,k) e =
+    let f = (++ [1200]) . sort . map (to_f . ratio_to_cents . snd) . efg_ratios 1
+        g (c,y) = let y' = y + h
+                      b = [(0,y,1200,y),(0,y',1200,y')]
+                  in b ++ map (\x -> (x,y + m,x,y' - m)) c
+    in concatMap g (zip (map f e) [0,k ..])
diff --git a/Music/Theory/Tuning/Et.hs b/Music/Theory/Tuning/Et.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Et.hs
@@ -0,0 +1,253 @@
+-- | Equal temperament tuning tables.
+module Music.Theory.Tuning.Et where
+
+import Data.List {- base -}
+import Data.List.Split {- split -}
+import Data.Ratio {- base -}
+import Text.Printf {- base -}
+
+import qualified Music.Theory.List as T {- hmt -}
+import Music.Theory.Pitch {- hmt -}
+import Music.Theory.Pitch.Note {- hmt -}
+import Music.Theory.Pitch.Spelling.Table {- hmt -}
+import Music.Theory.Tuning {- hmt -}
+
+-- | 'octpc_to_pitch' and 'octpc_to_cps_k0'.
+octpc_to_pitch_cps_k0 :: (Floating n) => (n,n) -> OctPc -> (Pitch,n)
+octpc_to_pitch_cps_k0 zero x = (octpc_to_pitch pc_spell_ks x,octpc_to_cps_k0 zero x)
+
+-- | 'octpc_to_pitch_cps_k0' of (69,440)
+octpc_to_pitch_cps :: (Floating n) => OctPc -> (Pitch,n)
+octpc_to_pitch_cps = octpc_to_pitch_cps_k0 (69,440)
+
+-- | 12-tone equal temperament table equating 'Pitch' and frequency
+-- over range of human hearing, where @A4@ has given frequency.
+--
+-- > tbl_12et_k0 (69,440)
+tbl_12et_k0 :: (Double,Double) -> [(Pitch,Double)]
+tbl_12et_k0 zero =
+    let z = [(o,pc) | o <- [-5 .. 10], pc <- [0 .. 11]]
+    in map (octpc_to_pitch_cps_k0 zero) z
+
+-- | 'tbl_12et_k0' @(69,440)@.
+--
+-- > length tbl_12et == 192
+-- > T.minmax (map (round . snd) tbl_12et) == (1,31609)
+tbl_12et :: [(Pitch,Double)]
+tbl_12et = tbl_12et_k0 (69,440)
+
+-- | 24-tone equal temperament variant of 'tbl_12et_k0'.
+tbl_24et_k0 :: (Double,Double) -> [(Pitch,Double)]
+tbl_24et_k0 zero =
+    let f x = let p = fmidi_to_pitch_err pc_spell_ks x
+                  p' = pitch_rewrite_threequarter_alteration p
+              in (p',fmidi_to_cps_k0 zero x)
+        k0 = -36
+    in map f [k0,k0 + 0.5 .. 143.5]
+
+-- | 'tbl_24et_k0' @(69,440)@.
+--
+-- > length tbl_24et == 360
+-- > T.minmax (map (round . snd) tbl_24et) == (1,32535)
+tbl_24et :: [(Pitch,Double)]
+tbl_24et = tbl_24et_k0 (69,440)
+
+-- | Given an @Et@ table (or like) find bounds of frequency.
+--
+-- > import qualified Music.Theory.Tuple as T
+-- > let r = Just (T.t2_map octpc_to_pitch_cps ((3,11),(4,0)))
+-- > bounds_et_table tbl_12et 256 == r
+bounds_et_table :: Ord s => [(t,s)] -> s -> Maybe ((t,s),(t,s))
+bounds_et_table = T.find_bounds True (compare . snd)
+
+-- | 'bounds_et_table' of 'tbl_12et'.
+--
+-- > import qualified Music.Theory.Tuning.Hs as T
+-- > map bounds_12et_tone (T.harmonic_series_cps_n 17 55)
+bounds_12et_tone :: Double -> Maybe ((Pitch,Double),(Pitch,Double))
+bounds_12et_tone = bounds_et_table tbl_12et
+
+-- | Tuple indicating nearest 'Pitch' to /frequency/ with @Et@
+-- frequency, and deviation in hertz and 'Cents'.
+--
+-- (cps,nearest-pitch,cps-of-nearest-pitch,cps-deviation,cents-deviation)
+type HS_R p = (Double,p,Double,Double,Cents)
+
+-- | /n/-decimal places.
+--
+-- > ndp 3 (1/3) == "0.333"
+ndp :: Int -> Double -> String
+ndp = printf "%.*f"
+
+-- | Pretty print 'HS_R'.  This discards the /cps-deviation/ field, ie. it has only four fields.
+hs_r_pp :: (p -> String) -> Int -> HS_R p -> [String]
+hs_r_pp pp n (f,p,pf,_,c) = let dp = ndp n in [dp f,pp p,dp pf,dp c]
+
+-- | 'hs_r_pp' of 'pitch_pp'
+hs_r_pitch_pp :: Int -> HS_R Pitch -> [String]
+hs_r_pitch_pp = hs_r_pp pitch_pp
+
+{- | Form 'HS_R' for /frequency/ by consulting table.
+
+> let f = 256
+> let f' = octpc_to_cps (4,0)
+> let r = (f,Pitch C Natural 4,f',f-f',fratio_to_cents (f/f'))
+> nearest_et_table_tone tbl_12et 256 == r
+
+-}
+nearest_et_table_tone :: [(p,Double)] -> Double -> HS_R p
+nearest_et_table_tone tbl f =
+    case bounds_et_table tbl f of
+      Nothing -> error "nearest_et_table_tone: no bounds?"
+      Just ((lp,lf),(rp,rf)) ->
+          let ld = f - lf
+              rd = f - rf
+          in if abs ld < abs rd
+             then (f,lp,lf,ld,fratio_to_cents (f/lf))
+             else (f,rp,rf,rd,fratio_to_cents (f/rf))
+
+-- | 'nearest_et_table_tone' for 'tbl_12et_k0'.
+nearest_12et_tone_k0 :: (Double,Double) -> Double -> HS_R Pitch
+nearest_12et_tone_k0 zero = nearest_et_table_tone (tbl_12et_k0 zero)
+
+-- | 'nearest_et_table_tone' for 'tbl_24et'.
+--
+-- > let r = "55.0 A1 55.0 0.0"
+-- > unwords (hs_r_pitch_pp 1 (nearest_24et_tone_k0 (69,440) 55)) == r
+nearest_24et_tone_k0 :: (Double,Double) -> Double -> HS_R Pitch
+nearest_24et_tone_k0 zero = nearest_et_table_tone (tbl_24et_k0 zero)
+
+-- * 72Et
+
+-- | Monzo 72-edo HEWM notation.  The domain is (-9,9).
+-- <http://www.tonalsoft.com/enc/number/72edo.aspx>
+--
+-- > let r = ["+",">","^","#<","#-","#","#+","#>","#^"]
+-- > map alteration_72et_monzo [1 .. 9] == r
+--
+-- > let r = ["-","<","v","b>","b+","b","b-","b<","bv"]
+-- > map alteration_72et_monzo [-1,-2 .. -9] == r
+alteration_72et_monzo :: Integral n => n -> String
+alteration_72et_monzo n =
+    let spl = splitOn ","
+        asc = spl ",+,>,^,#<,#-,#,#+,#>,#^"
+        dsc = spl ",-,<,v,b>,b+,b,b-,b<,bv"
+    in case compare n 0 of
+         LT -> genericIndex dsc (- n)
+         EQ -> ""
+         GT -> genericIndex asc n
+
+-- | Given a midi note number and @1/6@ deviation determine 'Pitch''
+-- and frequency.
+--
+-- > let f = pitch_r_pp . fst . pitch_72et_k0 (69,440)
+-- > let r = "C4 C+4 C>4 C^4 C#<4 C#-4 C#4 C#+4 C#>4 C#^4"
+-- > unwords (map f (zip (repeat 60) [0..9])) == r
+--
+-- > let r = "A4 A+4 A>4 A^4 Bb<4 Bb-4 Bb4 Bb+4 Bb>4 Bv4"
+-- > unwords (map f (zip (repeat 69) [0..9])) == r
+--
+-- > let r = "Bb4 Bb+4 Bb>4 Bv4 B<4 B-4 B4 B+4 B>4 B^4"
+-- > unwords (map f (zip (repeat 70) [0..9])) == r
+pitch_72et_k0 :: (Double,Double) -> (Midi,Int) -> (Pitch_R,Double)
+pitch_72et_k0 zero (x,n) =
+    let p = midi_to_pitch_ks x
+        t = note p
+        a = alteration p
+        (t',n') = case a of
+                    Flat -> if n < (-3) then (pred t,n + 6) else (t,n - 6)
+                    Natural -> (t,n)
+                    Sharp -> if n > 3 then (succ t,n - 6) else (t,n + 6)
+                    _ -> error "pitch_72et: alteration?"
+        a' = alteration_72et_monzo n'
+        x' = fromIntegral x + (fromIntegral n / 6)
+        r = (Pitch_R t' (fromIntegral n' % 12,a') (octave p),fmidi_to_cps_k0 zero x')
+        r' = if n > 3
+             then pitch_72et_k0 zero (x + 1,n - 6)
+             else if n < (-3)
+                  then pitch_72et_k0 zero (x - 1,n + 6)
+                  else r
+    in case a of
+         Natural -> r'
+         _ -> r
+
+-- | 72-tone equal temperament table equating 'Pitch'' and frequency
+-- over range of human hearing, where @A4@ = @440@hz.
+--
+-- > length (tbl_72et_k0 (69,440)) == 792
+-- > T.minmax (map (round . snd) (tbl_72et_k0 (69,440))) == (16,33167)
+tbl_72et_k0 :: (Double, Double) -> [(Pitch_R,Double)]
+tbl_72et_k0 zero =
+    let f n = zipWith (curry (pitch_72et_k0 zero)) (replicate 6 n) [0..5]
+    in concatMap f [12 .. 143]
+
+-- | 'nearest_et_table_tone' for 'tbl_72et'.
+--
+-- > let r = "324.0 E<4 323.3 0.7 3.5"
+-- > unwords (hs_r_pp pitch_r_pp 1 (nearest_72et_tone_k0 (69,440) 324))
+--
+-- > let f = take 2 . hs_r_pp pitch_r_pp 1 . nearest_72et_tone_k0 (69,440) . snd
+-- > mapM_ (print . unwords . f) (tbl_72et_k0 (69,440))
+nearest_72et_tone_k0 :: (Double,Double) -> Double -> HS_R Pitch_R
+nearest_72et_tone_k0 zero = nearest_et_table_tone (tbl_72et_k0 zero)
+
+-- * Detune
+
+-- | 'Pitch' with 12-Et/24-Et tuning deviation given in 'Cents'.
+type Pitch_Detune = (Pitch,Cents)
+
+-- | Extract 'Pitch_Detune' from 'HS_R'.
+hsr_to_pitch_detune :: HS_R Pitch -> Pitch_Detune
+hsr_to_pitch_detune (_,p,_,_,c) = (p,c)
+
+-- | Nearest 12-Et 'Pitch_Detune' to indicated frequency (hz).
+--
+-- > nearest_pitch_detune_12et_k0 (69,440) 452.8929841231365
+nearest_pitch_detune_12et_k0 :: (Double, Double) -> Double -> Pitch_Detune
+nearest_pitch_detune_12et_k0 zero = hsr_to_pitch_detune . nearest_12et_tone_k0 zero
+
+-- | Nearest 24-Et 'Pitch_Detune' to indicated frequency (hz).
+--
+-- > nearest_pitch_detune_24et_k0 (69,440) 452.8929841231365
+nearest_pitch_detune_24et_k0 :: (Double, Double) -> Double -> Pitch_Detune
+nearest_pitch_detune_24et_k0 zero = hsr_to_pitch_detune . nearest_24et_tone_k0 zero
+
+-- | Given /near/ function, /f0/ and ratio derive 'Pitch_Detune'.
+ratio_to_pitch_detune :: (Double -> HS_R Pitch) -> OctPc -> Rational -> Pitch_Detune
+ratio_to_pitch_detune near_f f0 r =
+    let f = octpc_to_cps f0 * realToFrac r
+        (_,p,_,_,c) = near_f f
+    in (p,c)
+
+-- | Frequency (hz) of 'Pitch_Detune'.
+--
+-- > pitch_detune_to_cps (octpc_to_pitch pc_spell_ks (4,9),50)
+pitch_detune_to_cps :: Floating n => Pitch_Detune -> n
+pitch_detune_to_cps (p,d) = cps_shift_cents (pitch_to_cps p) (realToFrac d)
+
+-- | 'ratio_to_pitch_detune' of 'nearest_12et_tone'
+ratio_to_pitch_detune_12et_k0 :: (Double, Double) -> OctPc -> Rational -> Pitch_Detune
+ratio_to_pitch_detune_12et_k0 zero = ratio_to_pitch_detune (nearest_12et_tone_k0 zero)
+
+-- | 'ratio_to_pitch_detune' of 'nearest_24et_tone'
+ratio_to_pitch_detune_24et_k0 :: (Double, Double) -> OctPc -> Rational -> Pitch_Detune
+ratio_to_pitch_detune_24et_k0 zero = ratio_to_pitch_detune (nearest_24et_tone_k0 zero)
+
+pitch_detune_in_octave_nearest  :: Pitch -> Pitch_Detune -> Pitch_Detune
+pitch_detune_in_octave_nearest p1 (p2,d2) = (pitch_in_octave_nearest p1 p2,d2)
+
+-- | Markdown pretty-printer for 'Pitch_Detune'.
+pitch_detune_md :: Pitch_Detune -> String
+pitch_detune_md (p,c) = pitch_pp p ++ cents_diff_md (round c :: Integer)
+
+-- | HTML pretty-printer for 'Pitch_Detune'.
+pitch_detune_html :: Pitch_Detune -> String
+pitch_detune_html (p,c) = pitch_pp p ++ cents_diff_html (round c :: Integer)
+
+-- | No-octave variant of 'pitch_detune_md'.
+pitch_class_detune_md :: Pitch_Detune -> String
+pitch_class_detune_md (p,c) = pitch_class_pp p ++ cents_diff_md (round c :: Integer)
+
+-- | No-octave variant of 'pitch_detune_html'.
+pitch_class_detune_html :: Pitch_Detune -> String
+pitch_class_detune_html (p,c) = pitch_class_pp p ++ cents_diff_html (round c :: Integer)
diff --git a/Music/Theory/Tuning/Euler.hs b/Music/Theory/Tuning/Euler.hs
deleted file mode 100644
--- a/Music/Theory/Tuning/Euler.hs
+++ /dev/null
@@ -1,138 +0,0 @@
--- | Euler plane diagrams as /dot/ language graph.
-module Music.Theory.Tuning.Euler where
-
-import Data.List {- base -}
-import Data.Ratio {- base -}
-
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Math as T {- hmt -}
-import qualified Music.Theory.Pitch.Note as T {- hmt -}
-import qualified Music.Theory.Tuning as T {- hmt -}
-import qualified Music.Theory.Tuple as T {- hmt -}
-
--- | 'T.fold_ratio_to_octave' of '*'.
-rat_mul :: Rational -> Rational -> Rational
-rat_mul r = T.fold_ratio_to_octave_err . (* r)
-
--- | 'T.fold_ratio_to_octave' of '/'.
-rat_div :: Rational -> Rational -> Rational
-rat_div p q = T.fold_ratio_to_octave_err (p / q)
-
--- | /n/ = length, /m/ equals multiplier, /r/ = initial ratio.
---
--- > tun_seq 5 (3/2) 1 == [1/1,3/2,9/8,27/16,81/64]
-tun_seq :: Int -> Rational -> Rational -> [Rational]
-tun_seq n m = take n . iterate (rat_mul m)
-
-mod12 :: Integral a => a -> a
-mod12 n = n `mod` 12
-
--- | 'T.ratio_to_cents' rounded to nearest multiple of 100, modulo 12.
---
--- > map (ratio_to_pc 0) [1,4/3,3/2,2] == [0,5,7,0]
-ratio_to_pc :: Int -> Rational -> Int
-ratio_to_pc n = mod12 . (+ n) . round . (/ 100) . T.ratio_to_cents
-
-all_pairs :: [t] -> [u] -> [(t,u)]
-all_pairs p q = [(x,y) | x <- p, y <- q]
-
--- | Give all pairs from (l2,l1) and (l3,l2) that are at interval ratios r1 and r2 respectively.
-euler_align_rat :: T.T2 Rational -> T.T3 [Rational] -> T.T2 [T.T2 Rational]
-euler_align_rat (r1,r2) (l1,l2,l3) =
-    let f r (p,q) = rat_mul p r == q
-    in (filter (f r1) (all_pairs l2 l1)
-       ,filter (f r2) (all_pairs l3 l2))
-
--- | Pretty printer for pitch class.
---
--- > unwords (map pc_pp [0..11]) == "C♮ C♯ D♮ E♭ E♮ F♮ F♯ G♮ A♭ A♮ B♭ B♮"
-pc_pp :: (Integral i,Show i) => i -> String
-pc_pp x =
-    case T.pc_to_note_alteration_ks x of
-      Just (n,a) -> [T.note_pp n,T.alteration_symbol a]
-      Nothing -> error (show ("pc_pp",x))
-
-cents_pp :: Rational -> String
-cents_pp = show . (round :: Double -> Integer) . T.ratio_to_cents
-
--- > rat_label (0,False) 1 == "C♮\\n1:1"
--- > rat_label (3,True) (7/4) == "C♯=969\\n7:4"
-rat_label :: (Int,Bool) -> Rational -> String
-rat_label (k,with_cents) r =
-    if r < 1 || r >= 2
-    then error (show ("rat_label",r))
-    else concat [pc_pp (ratio_to_pc k r)
-                ,if with_cents
-                 then '=' : cents_pp r
-                 else ""
-                ,"\\n",T.ratio_pp r]
-
--- > rat_id (5/4) == "R_5_4"
-rat_id :: Rational-> String
-rat_id r = "R_" ++ show (numerator r) ++ "_" ++ show (denominator r)
-
-rat_edge_label :: (Rational, Rational) -> String
-rat_edge_label (p,q) = concat ["   (",T.ratio_pp (rat_div p q),")"]
-
--- | Zip start-middle-end.
---
--- > zip_sme (0,1,2) "abcd" == [(0,'a'),(1,'b'),(1,'c'),(2,'d')]
-zip_sme :: (t,t,t) -> [u] -> [(t,u)]
-zip_sme (s,m,e) xs =
-    case xs of
-      x0:x1:xs' -> (s,x0) : (m,x1) : T.at_last (\x -> (m,x)) (\x -> (e,x)) xs'
-      _ -> error "zip_sme: not SME list"
-
-type Euler_Plane t = ([[t]],[(t,t)])
-
-euler_plane_to_dot :: (t -> String,t -> String,(t,t) -> String) -> Euler_Plane t -> [String]
-euler_plane_to_dot (n_id,n_pp,e_pp) (h,v) =
-    let mk_lab_term x =concat [" [label=\"",x,"\"];"]
-        node_to_dot x = concat [n_id x,mk_lab_term (n_pp x)]
-        subgraph_edges x = intercalate " -- " (map n_id x) ++ ";"
-        edge_to_dot (lhs,rhs) = concat [n_id lhs," -- ",n_id rhs,mk_lab_term (e_pp (lhs,rhs))]
-        subgraphs_to_dot (ty,x) = concat ["{rank=",ty,"; ",unwords (map n_id x),"}"]
-    in ["graph g {"
-       ,"graph [layout=\"dot\",rankdir=\"TB\",nodesep=0.5];"
-       ,"edge [fontsize=\"8\",fontname=\"century schoolbook\"];"
-       ,"node [shape=\"plaintext\",fontsize=\"10\",fontname=\"century schoolbook\"];"] ++
-       map node_to_dot (concat h) ++
-       map subgraph_edges h ++
-       map edge_to_dot v ++
-       map subgraphs_to_dot (zip_sme ("min","same","max") h) ++
-       ["}"]
-
-euler_plane_to_dot_rat :: (Int, Bool) -> Euler_Plane Rational -> [String]
-euler_plane_to_dot_rat opt = euler_plane_to_dot (rat_id,rat_label opt,rat_edge_label)
-
-{-
-
-let j5 =
-    let {l1 = tun_seq 3 (3%2) (5%3)
-        ;l2 = tun_seq 5 (3%2) (16%9)
-        ;l3 = tun_seq 4 (3%2) (64%45)
-        ;(c1,c2) = euler_align_rat (5%8,5%4) (l1,l2,l3)}
-    in ([l1,l2,l3],c1 ++ c2)
-
-let j5' =
-    let {f = T.fold_ratio_to_octave_err
-        ;l1 = tun_seq 4 (3/2) (f (1 * 2/3 * 5/4))
-        ;l2 = tun_seq 5 (3/2) (f (1 * 2/3 * 2/3))
-        ;l3 = tun_seq 3 (3/2) (f (1 * 2/3 * 4/5))
-        ;(c1,c2) = euler_align_rat (5/4,5/4) (l1,l2,l3)}
-    in ([l1,l2,l3],c1 ++ c2)
-
-let j7 =
-    let {l1 = tun_seq 4 (3%2) (5%4)
-        ;l2 = tun_seq 5 (3%2) (4%3)
-        ;l3 = tun_seq 3 (3%2) (14%9)
-        ;(c1,c2) = euler_align_rat (5%4,4%7) (l1,l2,l3)}
-    in ([l1,l2,l3],c1 ++ c2)
-
-let dir = "/home/rohan/sw/hmt/data/dot/"
-let f = unlines . euler_plane_to_dot_rat (0,False)
-writeFile (dir ++ "euler-j5-a.dot") (f j5)
-writeFile (dir ++ "euler-j5-b.dot") (f j5')
-writeFile (dir ++ "euler-j7.dot") (f j7)
-
--}
diff --git a/Music/Theory/Tuning/Gann_1993.hs b/Music/Theory/Tuning/Gann_1993.hs
--- a/Music/Theory/Tuning/Gann_1993.hs
+++ b/Music/Theory/Tuning/Gann_1993.hs
@@ -6,9 +6,11 @@
 import Data.Maybe {- base -}
 
 import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Math as T {- hmt -}
 import qualified Music.Theory.Pitch as T {- hmt -}
 import qualified Music.Theory.Tuning as T {- hmt -}
-import qualified Music.Theory.Tuning.Euler as T {- hmt -}
+import qualified Music.Theory.Tuning.Graph.Euler as T {- hmt -}
+import qualified Music.Theory.Tuning.Type as T {- hmt -}
 
 {- | Ratios for 'lmy_wtp'. lmy = La Monte Young. wtp = Well-Tuned Piano.
 
@@ -82,7 +84,7 @@
 
 -}
 lmy_wtp_uniq :: [(Rational,[(T.PitchClass,T.PitchClass)])]
-lmy_wtp_uniq = sortOn (T.ratio_nd_sum . fst) $ T.collate_on fst snd $ lmy_wtp_univ
+lmy_wtp_uniq = sortOn (T.ratio_nd_sum . fst) (T.collate_on fst snd lmy_wtp_univ)
 
 {- | Gann, 1993, p.137.
 
@@ -101,7 +103,7 @@
 
 -}
 lmy_wtp :: T.Tuning
-lmy_wtp = T.Tuning (Left lmy_wtp_r) 2
+lmy_wtp = T.Tuning (Left lmy_wtp_r) Nothing
 
 -- | Ratios for 'lmy_wtp_1964.
 lmy_wtp_1964_r :: [Rational]
@@ -121,7 +123,7 @@
 
 -}
 lmy_wtp_1964 :: T.Tuning
-lmy_wtp_1964 = T.Tuning (Left lmy_wtp_1964_r) 2
+lmy_wtp_1964 = T.Tuning (Left lmy_wtp_1964_r) Nothing
 
 {- | Euler diagram for 'lmy_wtp'.
 
@@ -134,6 +136,6 @@
 lmy_wtp_euler =
     let {l1 = T.tun_seq 4 (3/2) (49/32)
         ;l2 = T.tun_seq 5 (3/2) (7/4)
-        ;l3 = T.tun_seq 3 (3/2) (1/1)
+        ;l3 = T.tun_seq 3 (3/2) 1
         ;(c1,c2) = T.euler_align_rat (7/4,7/4) (l1,l2,l3)}
     in ([l1,l2,l3],c1 ++ c2)
diff --git a/Music/Theory/Tuning/Graph/Euler.hs b/Music/Theory/Tuning/Graph/Euler.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Graph/Euler.hs
@@ -0,0 +1,124 @@
+-- | Euler plane diagrams as /dot/ language graphs.
+--
+-- <http://rohandrape.net/?t=hmt-texts&e=md/euler.md>
+module Music.Theory.Tuning.Graph.Euler where
+
+import Data.List {- base -}
+import Data.Ratio {- base -}
+
+import qualified Music.Theory.Function as T {- hmt -}
+import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Pitch.Note as T {- hmt -}
+import qualified Music.Theory.Show as T {- hmt -}
+import qualified Music.Theory.Tuning as T {- hmt -}
+import qualified Music.Theory.Tuple as T {- hmt -}
+
+-- | 'T.fold_ratio_to_octave_err' of '*'.
+rat_mul :: Rational -> Rational -> Rational
+rat_mul r = T.fold_ratio_to_octave_err . (* r)
+
+-- | 'T.fold_ratio_to_octave_err' of '/'.
+rat_div :: Rational -> Rational -> Rational
+rat_div p q = T.fold_ratio_to_octave_err (p / q)
+
+-- | /n/ = length, /m/ = multiplier, /r/ = initial ratio.
+--
+-- > tun_seq 5 (3/2) 1 == [1/1,3/2,9/8,27/16,81/64]
+tun_seq :: Int -> Rational -> Rational -> [Rational]
+tun_seq n m = take n . iterate (rat_mul m)
+
+-- | All possible pairs of elements (/x/,/y/) where /x/ is from /p/ and /y/ from /q/.
+--
+-- > all_pairs "ab" "cde" == [('a','c'),('a','d'),('a','e'),('b','c'),('b','d'),('b','e')]
+all_pairs :: [t] -> [u] -> [(t,u)]
+all_pairs p q = [(x,y) | x <- p, y <- q]
+
+-- | Give all pairs from (l2,l1) and (l3,l2) that are at interval ratios r1 and r2 respectively.
+euler_align_rat :: T.T2 Rational -> T.T3 [Rational] -> T.T2 [T.T2 Rational]
+euler_align_rat (r1,r2) (l1,l2,l3) =
+    let f r (p,q) = rat_mul p r == q
+    in (filter (f r1) (all_pairs l2 l1)
+       ,filter (f r2) (all_pairs l3 l2))
+
+-- | Pretty printer for pitch class (UNICODE).
+--
+-- > unwords (map pc_pp [0..11]) == "C♮ C♯ D♮ E♭ E♮ F♮ F♯ G♮ A♭ A♮ B♭ B♮"
+pc_pp :: (Integral i,Show i) => i -> String
+pc_pp x =
+    case T.pc_to_note_alteration_ks x of
+      Just (n,a) -> [T.note_pp n,T.alteration_symbol a]
+      Nothing -> error (show ("pc_pp",x))
+
+-- | Show ratio as intergral ('round') cents value.
+cents_pp :: Rational -> String
+cents_pp = show . (round :: Double -> Integer) . T.ratio_to_cents
+
+-- | (unit-pitch-class,print-cents)
+type RAT_LABEL_OPT = (Int,Bool)
+
+-- | Dot label for ratio, /k/ is the pitch-class of the unit ratio.
+--
+-- > rat_label (0,False) 1 == "C♮\\n1:1"
+-- > rat_label (3,True) (7/4) == "C♯=969\\n7:4"
+rat_label :: RAT_LABEL_OPT -> Rational -> String
+rat_label (k,with_cents) r =
+    if r < 1 || r >= 2
+    then error (show ("rat_label",r))
+    else concat [pc_pp (T.ratio_to_pc k r)
+                ,if with_cents
+                 then '=' : cents_pp r
+                 else ""
+                ,"\\n",T.ratio_pp r]
+
+-- | Generate value /dot/ node identifier for ratio.
+--
+-- > rat_id (5/4) == "R_5_4"
+rat_id :: Rational-> String
+rat_id r = "R_" ++ show (numerator r) ++ "_" ++ show (denominator r)
+
+-- | Printer for edge label between given ratio nodes.
+rat_edge_label :: (Rational, Rational) -> String
+rat_edge_label (p,q) = concat ["   (",T.ratio_pp (rat_div p q),")"]
+
+-- | Zip start-middle-end.
+--
+-- > zip_sme (0,1,2) "abcd" == [(0,'a'),(1,'b'),(1,'c'),(2,'d')]
+zip_sme :: (t,t,t) -> [u] -> [(t,u)]
+zip_sme (s,m,e) xs =
+    case xs of
+      x0:x1:xs' -> (s,x0) : (m,x1) : T.at_last (\x -> (m,x)) (\x -> (e,x)) xs'
+      _ -> error "zip_sme: not SME list"
+
+-- | Euler diagram given as (/h/,/v/) duple,
+-- where /h/ are the horizontal sequences and /v/ are the vertical edges.
+type Euler_Plane t = ([[t]],[(t,t)])
+
+-- | Ratios at plane, sorted.
+euler_plane_r :: Ord t => Euler_Plane t -> [t]
+euler_plane_r = sort . concat . fst
+
+-- | Apply /f/ at all nodes of the plane.
+euler_plane_map :: (t -> u) -> Euler_Plane t -> Euler_Plane u
+euler_plane_map f (p,q) = (map (map f) p,map (T.bimap1 f) q)
+
+-- | Generate /dot/ graph given printer functions and an /Euler_Plane/.
+euler_plane_to_dot :: (t -> String,t -> String,(t,t) -> String) -> Euler_Plane t -> [String]
+euler_plane_to_dot (n_id,n_pp,e_pp) (h,v) =
+    let mk_lab_term x = concat [" [label=\"",x,"\"];"]
+        node_to_dot x = concat [n_id x,mk_lab_term (n_pp x)]
+        subgraph_edges x = intercalate " -- " (map n_id x) ++ ";"
+        edge_to_dot (lhs,rhs) = concat [n_id lhs," -- ",n_id rhs,mk_lab_term (e_pp (lhs,rhs))]
+        subgraphs_to_dot (ty,x) = concat ["{rank=",ty,"; ",unwords (map n_id x),"}"]
+    in ["graph g {"
+       ,"graph [layout=\"dot\",rankdir=\"TB\",nodesep=0.5];"
+       ,"edge [fontsize=\"8\",fontname=\"century schoolbook\"];"
+       ,"node [shape=\"plaintext\",fontsize=\"10\",fontname=\"century schoolbook\"];"] ++
+       map node_to_dot (concat h) ++
+       map subgraph_edges h ++
+       map edge_to_dot v ++
+       map subgraphs_to_dot (zip_sme ("min","same","max") h) ++
+       ["}"]
+
+-- | Variant with default printers and fixed node type.
+euler_plane_to_dot_rat :: RAT_LABEL_OPT -> Euler_Plane Rational -> [String]
+euler_plane_to_dot_rat opt = euler_plane_to_dot (rat_id,rat_label opt,rat_edge_label)
diff --git a/Music/Theory/Tuning/Graph/Iset.hs b/Music/Theory/Tuning/Graph/Iset.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Graph/Iset.hs
@@ -0,0 +1,127 @@
+-- | Tuning graph with edges determined by interval set.
+module Music.Theory.Tuning.Graph.Iset where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Data.Graph.Inductive.Graph as Fgl {- fgl -}
+import qualified Data.Graph.Inductive.PatriciaTree as Fgl {- fgl -}
+
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Show as T {- hmt-base -}
+
+import qualified Music.Theory.Graph.Dot as T {- hmt -}
+import qualified Music.Theory.Graph.Fgl as T {- hmt -}
+import qualified Music.Theory.Tuning as T {- hmt -}
+import qualified Music.Theory.Tuning.Graph.Euler as Euler {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
+
+-- * R
+
+-- | R = Rational
+type R = Rational
+
+-- | Flip a ratio in (1,2) and multiply by 2.
+--
+-- > import Data.Ratio {- base -}
+-- > map r_flip [5%4,3%2,7%4] == [8%5,4%3,8%7]
+-- > map r_flip [3/2,5/4,7/4] == [4/3,8/5,8/7]
+r_flip :: R -> R
+r_flip n = if n < 1 || n > 2 then error "r_flip" else 1 / n * 2
+
+-- | r = ratio, nrm = normalise
+r_nrm :: R -> R
+r_nrm = T.ratio_interval_class_by id
+
+-- | The folded interval from p to q.
+--
+-- > r_rel (1,3/2) == 4/3
+r_rel :: (R,R) -> R
+r_rel (p,q) = T.fold_ratio_to_octave_err (p / q)
+
+-- | The interval set /i/ and it's 'r_flip'.
+iset_sym :: [R] -> [R]
+iset_sym l = l ++ map r_flip l
+
+-- | Require r to have a perfect octave as last element, and remove it.
+rem_oct :: [R] -> [R]
+rem_oct r = if last r /= 2 then error "rem_oct" else T.drop_last r
+
+r_pcset :: [R] -> [Int]
+r_pcset = sort . map (T.ratio_to_pc 0)
+
+r_pcset_univ :: [R] -> [Int]
+r_pcset_univ = nub . r_pcset
+
+-- | Does [R] construct indicated /pcset/.
+r_is_pcset :: [Int] -> [R] -> Bool
+r_is_pcset pcset = (==) pcset . r_pcset
+
+-- * G
+
+-- | Edges are (v1,v2) where v1 < v2
+type G = T.Gr R
+
+edj_r :: (R, R) -> R
+edj_r = r_nrm . r_rel
+
+-- | The graph with vertices /scl_r/ and all edges where the interval (i,j) is in /iset/.
+mk_graph :: [R] -> [R] -> G
+mk_graph iset scl_r =
+  (scl_r
+  ,filter
+    (\e -> edj_r e `elem` iset_sym iset)
+    [(p,q) |
+     p <- scl_r,
+     q <- scl_r,
+     p < q])
+
+gen_graph :: Ord v => [T.Dot_Meta_Attr] -> T.Graph_Pp v e -> [T.Edge_Lbl v e] -> [String]
+gen_graph opt pp es = T.fgl_to_udot opt pp (T.g_from_edges_l es)
+
+g_to_dot :: Int -> [(String,String)] -> (R -> [(String,String)]) -> G -> [String]
+g_to_dot k attr v_attr (_,e_set) =
+  let opt =
+        [("graph:layout","neato")
+        ,("node:shape","plaintext")
+        ,("node:fontsize","10")
+        ,("node:fontname","century schoolbook")
+        ,("edge:fontsize","9")]
+  in gen_graph
+     (opt ++ attr)
+     (\(_,v) -> ("label",Euler.rat_label (k,True) v) : v_attr v
+     ,\(_,e) -> [("label",T.rational_pp e)])
+     (map (\e -> (e,edj_r e)) e_set)
+
+-- * SCALA
+
+mk_graph_scl :: [R] -> Scala.Scale -> G
+mk_graph_scl iset = mk_graph iset . rem_oct . Scala.scale_ratios_req
+
+scl_to_dot :: ([R], Int, [(String, String)], R -> [(String, String)]) -> String -> IO [String]
+scl_to_dot (iset,k,attr,v_attr) nm = do
+  sc <- Scala.scl_load nm
+  let gr = mk_graph_scl iset sc
+  return (g_to_dot k attr v_attr gr)
+
+-- * Fgl
+
+graph_to_fgl :: G -> Fgl.Gr R R
+graph_to_fgl (v,e) =
+  let fgl_v = zip [0..] v
+      r_to_v :: R -> Int
+      r_to_v x = fromJust (T.reverse_lookup x fgl_v)
+      fgl_e = map (\(p,q) -> (r_to_v p,r_to_v q,edj_r (p,q))) e
+  in Fgl.mkGraph fgl_v fgl_e
+
+mk_graph_fgl :: [R] -> [R] -> Fgl.Gr R R
+mk_graph_fgl iset = graph_to_fgl . mk_graph iset
+
+{-
+-- | List of nodes at /g/ connected to node /r/.
+g_edge_list :: G -> R -> [R]
+g_edge_list (_,e) r =
+  let f (p,q) = if r == p then Just q else if r == q then Just p else Nothing
+  in mapMaybe f e
+-}
diff --git a/Music/Theory/Tuning/Hs.hs b/Music/Theory/Tuning/Hs.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Hs.hs
@@ -0,0 +1,81 @@
+-- | Harmonic series
+module Music.Theory.Tuning.Hs where
+
+import Data.List {- base -}
+import Data.Ratio {- base -}
+import qualified Safe {- safe -}
+
+import qualified Music.Theory.Pitch as T {- hmt -}
+import Music.Theory.Tuning {- hmt -}
+import Music.Theory.Tuning.Type {- hmt -}
+
+
+-- | Harmonic series to /n/th partial, with indicated octave.
+--
+-- > harmonic_series 17 2
+harmonic_series :: Integer -> Maybe Rational -> Tuning
+harmonic_series n o = Tuning (Left [1 .. n%1]) (fmap Left o)
+
+-- | Harmonic series on /n/.
+harmonic_series_cps :: (Num t, Enum t) => t -> [t]
+harmonic_series_cps n = [n,n * 2 ..]
+
+-- | /n/ elements of 'harmonic_series_cps'.
+--
+-- > let r = [55,110,165,220,275,330,385,440,495,550,605,660,715,770,825,880,935]
+-- > harmonic_series_cps_n 17 55 == r
+harmonic_series_cps_n :: (Num a, Enum a) => Int -> a -> [a]
+harmonic_series_cps_n n = take n . harmonic_series_cps
+
+-- | Sub-harmonic series on /n/.
+subharmonic_series_cps :: (Fractional t,Enum t) => t -> [t]
+subharmonic_series_cps n = map ((* n) . recip) [1..]
+
+-- | /n/ elements of 'harmonic_series_cps'.
+--
+-- > let r = [1760,880,587,440,352,293,251,220,196,176,160,147,135,126,117,110,104]
+-- > map round (subharmonic_series_cps_n 17 1760) == r
+subharmonic_series_cps_n :: (Fractional t,Enum t) => Int -> t -> [t]
+subharmonic_series_cps_n n = take n . subharmonic_series_cps
+
+-- | /n/th partial of /f1/, ie. one indexed.
+--
+-- > map (partial 55) [1,5,3] == [55,275,165]
+partial :: (Num a, Enum a) => a -> Int -> a
+partial f1 k = harmonic_series_cps f1 `Safe.at` (k - 1)
+
+-- | Derivative harmonic series, based on /k/th partial of /f1/.
+--
+-- > import Music.Theory.Pitch
+--
+-- > let r = [52,103,155,206,258,309,361,412,464,515,567,618,670,721,773]
+-- > let d = harmonic_series_cps_derived 5 (T.octpc_to_cps (1,4))
+-- > map round (take 15 d) == r
+harmonic_series_cps_derived :: (RealFrac a, Floating a, Enum a) => Int -> a -> [a]
+harmonic_series_cps_derived k f1 =
+    let f0 = T.cps_in_octave_above f1 (partial f1 k)
+    in harmonic_series_cps f0
+
+-- | Harmonic series to /n/th harmonic (folded, duplicated removed).
+--
+-- > harmonic_series_folded_r 17 == [1,17/16,9/8,5/4,11/8,3/2,13/8,7/4,15/8]
+--
+-- > let r = [0,105,204,386,551,702,841,969,1088]
+-- > map (round . ratio_to_cents) (harmonic_series_folded_r 17) == r
+harmonic_series_folded_r :: Integer -> [Rational]
+harmonic_series_folded_r n = nub (sort (map fold_ratio_to_octave_err [1 .. n%1]))
+
+-- | 'ratio_to_cents' variant of 'harmonic_series_folded'.
+harmonic_series_folded_c :: Integer -> [Cents]
+harmonic_series_folded_c = map ratio_to_cents . harmonic_series_folded_r
+
+harmonic_series_folded :: Integer -> Tuning
+harmonic_series_folded n = Tuning (Left (harmonic_series_folded_r n)) Nothing
+
+-- | @12@-tone tuning of first @21@ elements of the harmonic series.
+--
+-- > tn_cents_i harmonic_series_folded_21 == [0,105,204,298,386,471,551,702,841,969,1088]
+-- > tn_divisions harmonic_series_folded_21 == 11
+harmonic_series_folded_21 :: Tuning
+harmonic_series_folded_21 = harmonic_series_folded 21
+
diff --git a/Music/Theory/Tuning/Load.hs b/Music/Theory/Tuning/Load.hs
--- a/Music/Theory/Tuning/Load.hs
+++ b/Music/Theory/Tuning/Load.hs
@@ -3,16 +3,19 @@
 
 import System.Random {- random -}
 
-import qualified Music.Theory.Array.CSV as T
-import qualified Music.Theory.Pitch as T
+import qualified Music.Theory.Array.Csv as T {- hmt-base -}
+
+import qualified Music.Theory.Pitch as T {- hmt -}
 import qualified Music.Theory.Tuning as T
+import qualified Music.Theory.Tuning.Midi as T
 import qualified Music.Theory.Tuning.Scala as T
+import qualified Music.Theory.Tuning.Type as T
 
 -- | Load possibly sparse and possibly one-to-many
--- (midi-note-number,cps-frequency) table from CSV file.
+-- (midi-note-number,cps-frequency) table from Csv file.
 --
 -- > load_cps_tbl "/home/rohan/dr.csv"
-load_cps_tbl :: FilePath -> IO [(Int,Double)]
+load_cps_tbl :: FilePath -> IO [(T.Midi,Double)]
 load_cps_tbl nm = do
   tbl <- T.csv_table_read_def id nm
   let f e = case e of
@@ -22,22 +25,26 @@
 
 -- | Load scala scl file as 'T.Tuning'.
 load_tuning_scl :: String -> IO T.Tuning
-load_tuning_scl = fmap (T.scale_to_tuning 0.01) . T.scl_load
+load_tuning_scl = fmap T.scale_to_tuning . T.scl_load
 
+-- | cps = (tuning-name,frequency-zero,midi-note-number-of-f0)
+--   d12 = (tuning-name,cents-deviation,midi-note-offset)
+type Load_Tuning_Opt = (String,Double,T.Midi)
+
 -- | Load scala file and apply 'T.cps_midi_tuning_f'.
-load_tuning_cps :: (String,Double,Int) -> IO T.Sparse_Midi_Tuning_F
+load_tuning_cps :: Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
 load_tuning_cps (nm,f0,k) =
-    let f tn = T.cps_midi_tuning_f (tn,f0,k,128-k)
+    let f tn = T.cps_midi_tuning_f (tn,f0,k,128 - T.midi_to_int k)
     in fmap f (load_tuning_scl nm)
 
 -- | Load scala file and apply 'T.d12_midi_tuning_f'.
-load_tuning_d12 :: (String,Double,Int) -> IO T.Sparse_Midi_Tuning_F
+load_tuning_d12 :: Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
 load_tuning_d12 (nm,dt,k) =
     let f tn = T.lift_tuning_f (T.d12_midi_tuning_f (tn,dt,k))
     in fmap f (load_tuning_scl nm)
 
 -- | Lookup first matching element in table.
-load_tuning_tbl :: (String,Double,Int) -> IO T.Sparse_Midi_Tuning_F
+load_tuning_tbl :: Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
 load_tuning_tbl (nm,dt,k) =
     let from_cps = T.cps_to_midi_detune . flip T.cps_shift_cents dt
         f tbl mnn = fmap from_cps (lookup (mnn + k) tbl)
@@ -52,7 +59,7 @@
     in (l !! i,g')
 
 -- | Load tuning table with stateful selection function for one-to-many entries.
-load_tuning_tbl_st :: Choose_f st (Int,Double) -> (String,Double,Int) -> IO (T.Sparse_Midi_Tuning_ST_F st)
+load_tuning_tbl_st :: Choose_f st (T.Midi,Double) -> Load_Tuning_Opt -> IO (T.Sparse_Midi_Tuning_St_f st)
 load_tuning_tbl_st choose_f (nm,dt,k) =
     let from_cps = T.cps_to_midi_detune . flip T.cps_shift_cents dt
         f tbl g mnn = case filter ((== (mnn + k)) . fst) tbl of
@@ -61,7 +68,7 @@
                              in (g',Just (from_cps e))
     in fmap f (load_cps_tbl nm)
 
-load_tuning_ty :: String -> (String,Double,Int) -> IO T.Sparse_Midi_Tuning_F
+load_tuning_ty :: String -> Load_Tuning_Opt -> IO T.Sparse_Midi_Tuning_f
 load_tuning_ty ty opt =
     case ty of
       "cps" -> load_tuning_cps opt
@@ -69,7 +76,7 @@
       "tbl" -> load_tuning_tbl opt
       _ -> error "cps|d12|tbl"
 
-load_tuning_st_ty :: String -> (String,Double,Int) -> IO (T.Sparse_Midi_Tuning_ST_F StdGen)
+load_tuning_st_ty :: String -> Load_Tuning_Opt -> IO (T.Sparse_Midi_Tuning_St_f StdGen)
 load_tuning_st_ty ty opt =
     case ty of
       "cps" -> fmap T.lift_sparse_tuning_f (load_tuning_cps opt)
diff --git a/Music/Theory/Tuning/Meyer_1929.hs b/Music/Theory/Tuning/Meyer_1929.hs
--- a/Music/Theory/Tuning/Meyer_1929.hs
+++ b/Music/Theory/Tuning/Meyer_1929.hs
@@ -95,13 +95,17 @@
 degree :: Integral i => i -> i
 degree = genericLength . elements
 
--- | <http://en.wikipedia.org/wiki/Farey_sequence>
---
--- > let r = [[0,1/2,1]
--- >         ,[0,1/3,1/2,2/3,1]
--- >         ,[0,1/4,1/3,1/2,2/3,3/4,1]
--- >         ,[0,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,1]
--- >         ,[0,1/6,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,5/6,1]]
--- > in map farey_sequence [2..6] == r
+{- | <http://en.wikipedia.org/wiki/Farey_sequence>
+
+> r = [[0                                              ]
+>     ,[0                                            ,1]
+>     ,[0                    ,1/2                    ,1]
+>     ,[0            ,1/3    ,1/2    ,2/3            ,1]
+>     ,[0        ,1/4,1/3    ,1/2    ,2/3,3/4        ,1]
+>     ,[0    ,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5    ,1]
+>     ,[0,1/6,1/5,1/4,1/3,2/5,1/2,3/5,2/3,3/4,4/5,5/6,1]]
+
+> map farey_sequence [0..6]
+-}
 farey_sequence :: Integral a => a -> [Ratio a]
 farey_sequence k = 0 : nub (sort [n%d | d <- [1..k], n <- [1..d]])
diff --git a/Music/Theory/Tuning/Midi.hs b/Music/Theory/Tuning/Midi.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Midi.hs
@@ -0,0 +1,128 @@
+-- | Midi + Tuning
+module Music.Theory.Tuning.Midi where
+
+import Data.List {- base -}
+import qualified Data.Map as M {- containers -}
+import Data.Maybe {- base -}
+import qualified Safe {- safe -}
+
+import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Map as T {- hmt -}
+import qualified Music.Theory.Pitch as T {- hmt -}
+import qualified Music.Theory.Tuple as T {- hmt -}
+
+import Music.Theory.Tuning {- hmt -}
+import Music.Theory.Tuning.Type {- hmt -}
+
+-- | (/n/ -> /dt/).  Function from midi note number /n/ to
+-- 'Midi_Detune' /dt/.  The incoming note number is the key pressed,
+-- which may be distant from the note sounded.
+type Midi_Tuning_f = T.Midi -> T.Midi_Detune
+
+-- | Variant for tunings that are incomplete.
+type Sparse_Midi_Tuning_f = T.Midi -> Maybe T.Midi_Detune
+
+-- | Variant for sparse tunings that require state.
+type Sparse_Midi_Tuning_St_f st = st -> T.Midi -> (st,Maybe T.Midi_Detune)
+
+-- | Lift 'Midi_Tuning_f' to 'Sparse_Midi_Tuning_f'.
+lift_tuning_f :: Midi_Tuning_f -> Sparse_Midi_Tuning_f
+lift_tuning_f tn_f = Just . tn_f
+
+-- | Lift 'Sparse_Midi_Tuning_f' to 'Sparse_Midi_Tuning_St_f'.
+lift_sparse_tuning_f :: Sparse_Midi_Tuning_f -> Sparse_Midi_Tuning_St_f st
+lift_sparse_tuning_f tn_f st k = (st,tn_f k)
+
+-- | (t,c,k) where
+--   t=tuning (must have 12 divisions of octave),
+--   c=cents deviation (ie. constant detune offset),
+--   k=midi offset (ie. value to be added to incoming midi note number).
+type D12_Midi_Tuning = (Tuning,Cents,T.Midi)
+
+-- | 'Midi_Tuning_f' for 'D12_Midi_Tuning'.
+--
+-- > let f = d12_midi_tuning_f (equal_temperament 12,0,0)
+-- > map f [0..127] == zip [0..127] (repeat 0)
+d12_midi_tuning_f :: D12_Midi_Tuning -> Midi_Tuning_f
+d12_midi_tuning_f (t,c_diff,k) n =
+    let (_,pc) = T.midi_to_octpc (n + k)
+        dt = zipWith (-) (tn_cents t) [0,100 .. 1200]
+    in if tn_divisions t /= 12
+       then error "d12_midi_tuning_f: not d12"
+       else case dt `Safe.atMay` pc of
+              Nothing -> error "d12_midi_tuning_f: pc?"
+              Just c -> (n,c + c_diff)
+
+-- | (t,f0,k,g) where
+--   t=tuning, f0=fundamental-frequency, k=midi-note-number (for f0), g=gamut
+type Cps_Midi_Tuning = (Tuning,Double,T.Midi,Int)
+
+-- | 'Midi_Tuning_f' for 'Cps_Midi_Tuning'.  The function is sparse, it is only
+-- valid for /g/ values from /k/.
+--
+-- > import qualified Music.Theory.Pitch as T
+-- > let f = cps_midi_tuning_f (equal_temperament 72,T.midi_to_cps 59,59,72 * 4)
+-- > map f [59 .. 59 + 72]
+cps_midi_tuning_f :: Cps_Midi_Tuning -> Sparse_Midi_Tuning_f
+cps_midi_tuning_f (t,f0,k,g) n =
+    let r = tn_approximate_ratios_cyclic t
+        m = take g (map (T.cps_to_midi_detune . (* f0)) r)
+    in m `Safe.atMay` T.midi_to_int (n - k)
+
+-- * Midi tuning tables.
+
+-- | midi-note-number -> fractional-midi-note-number table, possibly sparse.
+type Mnn_Fmnn_Table = [(Int,Double)]
+
+-- | Load 'Mnn_Fmnn_Table' from two-column Csv file.
+mnn_fmnn_table_load_csv :: FilePath -> IO Mnn_Fmnn_Table
+mnn_fmnn_table_load_csv fn = do
+  s <- readFile fn
+  let f x = case break (== ',') x of
+              (lhs,_:rhs) -> (read lhs,read rhs)
+              _ -> error "mnn_fmidi_table_load_csv?"
+  return (map f (lines s))
+
+-- | Midi-note-number -> Cps table, possibly sparse.
+type Mnn_Cps_Table = [(T.Midi,Double)]
+
+-- | Generates 'Mnn_Cps_Table' given 'Midi_Tuning_f' with keys for all valid @Mnn@.
+--
+-- > import Sound.SC3.Plot
+-- > let f = cps_midi_tuning_f (equal_temperament 12,T.midi_to_cps 0,0,127)
+-- > plot_p2_ln [map (fmap round) (gen_cps_tuning_tbl f)]
+gen_cps_tuning_tbl :: Sparse_Midi_Tuning_f -> Mnn_Cps_Table
+gen_cps_tuning_tbl tn_f =
+    let f n = case tn_f n of
+                Just r -> Just (n,T.midi_detune_to_cps r)
+                Nothing -> Nothing
+    in mapMaybe f [0 .. 127]
+
+-- * Derived (secondary) tuning table (DTT) lookup.
+
+-- | Given an 'Mnn_Cps_Table' /tbl/, a list of @Cps@ /c/, and a @Mnn@ /m/
+-- find the @Cps@ in /c/ that is nearest to the @Cps@ in /t/ for /m/.
+-- In equal distance cases bias left.
+dtt_lookup :: (Eq k, Num v, Ord v) => [(k,v)] -> [v] -> k -> (Maybe v,Maybe v)
+dtt_lookup tbl cps n =
+    let f = lookup n tbl
+    in (f,fmap (T.find_nearest_err True cps) f)
+
+-- | Require table be non-sparse.
+dtt_lookup_err :: (Eq k, Num v, Ord v) => [(k,v)] -> [v] -> k -> (k,v,v)
+dtt_lookup_err tbl cps n =
+    case dtt_lookup tbl cps n of
+      (Just f,Just g) -> (n,f,g)
+      _ -> error "dtt_lookup"
+
+-- | Given two tuning tables generate the @dtt@ table.
+gen_dtt_lookup_tbl :: Mnn_Cps_Table -> Mnn_Cps_Table -> Mnn_Cps_Table
+gen_dtt_lookup_tbl t0 t1 =
+    let ix = [0..127]
+        cps = sort (map (T.p3_third . dtt_lookup_err t0 (map snd t1)) ix)
+    in zip ix cps
+
+gen_dtt_lookup_f :: Mnn_Cps_Table -> Mnn_Cps_Table -> Midi_Tuning_f
+gen_dtt_lookup_f t0 t1 =
+    let m = M.fromList (gen_dtt_lookup_tbl t0 t1)
+    in T.cps_to_midi_detune . T.map_ix_err m
diff --git a/Music/Theory/Tuning/Partch.hs b/Music/Theory/Tuning/Partch.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Partch.hs
@@ -0,0 +1,68 @@
+-- | Tuning, Harry Partch
+module Music.Theory.Tuning.Partch where
+
+import qualified Data.Map.Strict as M {- containers -}
+import Data.Ratio {- base -}
+
+import qualified Music.Theory.Tuning as T
+
+orelate :: Integral i => Ratio i -> i -> Ratio i
+orelate r m = T.fold_ratio_to_octave_err (r * (m % 1))
+
+urelate :: Integral i => Ratio i -> i -> Ratio i
+urelate r m = T.fold_ratio_to_octave_err (r * (1 % m))
+
+-- | Incipient Tonality Diamond
+--
+-- > itd_map [4 .. 6]
+itd_map :: [Integer] -> M.Map (Int,Int) Rational
+itd_map relation =
+  let limit = length relation
+      z = map (orelate 1) relation
+      c0 = zip (map (\n -> (n,0)) [0 .. limit - 1]) z
+      cN = [((i,k),urelate (z !! i) (relation !! k)) |
+            i <- [0 .. limit - 1],
+            k <- [1 .. limit - 1]]
+  in M.fromList (c0 ++ cN)
+
+map_to_table :: t -> (Int,Int) -> M.Map (Int,Int) t -> [[t]]
+map_to_table k (nr,nc) m =
+  [[M.findWithDefault k (i,j) m | j <- [0 .. nc - 1]] | i <- [0 .. nr - 1]]
+
+-- | 'map_to_table' of 'itd_map'.
+--
+-- > itd_tbl [4 .. 13]
+itd_tbl :: [Integer] -> [[Rational]]
+itd_tbl r =
+  let err = error "itd_tbl"
+      n = length r
+  in map_to_table err (n,n) (itd_map r)
+
+{-
+
+import Data.List {- base -}
+import qualified Music.Theory.Array.Text as T {- hmt -}
+import qualified Music.Theory.Show as T {- hmt -}
+
+pp tbl = putStrLn $ unlines $ T.table_pp T.table_opt_plain (map (map T.rational_pp) tbl)
+pp (itd_tbl [4 .. 6])
+pp (itd_tbl [4 .. 13])
+
+$ itd 4 5 6
+  1/1     8/5     4/3
+  5/4     1/1     5/3
+  3/2     6/5     1/1
+$ itd 4 5 6 7 8 9 10 11 12 13
+  1/1     8/5     4/3     8/7     1/1    16/9     8/5    16/11    4/3    16/13
+  5/4     1/1     5/3    10/7     5/4    10/9     1/1    20/11    5/3    20/13
+  3/2     6/5     1/1    12/7     3/2     4/3     6/5    12/11    1/1    24/13
+  7/4     7/5     7/6     1/1     7/4    14/9     7/5    14/11    7/6    14/13
+  1/1     8/5     4/3     8/7     1/1    16/9     8/5    16/11    4/3    16/13
+  9/8     9/5     3/2     9/7     9/8     1/1     9/5    18/11    3/2    18/13
+  5/4     1/1     5/3    10/7     5/4    10/9     1/1    20/11    5/3    20/13
+ 11/8    11/10   11/6    11/7    11/8    11/9    11/10    1/1    11/6    22/13
+  3/2     6/5     1/1    12/7     3/2     4/3     6/5    12/11    1/1    24/13
+ 13/8    13/10   13/12   13/7    13/8    13/9    13/10   13/11   13/12    1/1
+$
+
+-}
diff --git a/Music/Theory/Tuning/Polansky_1978.hs b/Music/Theory/Tuning/Polansky_1978.hs
--- a/Music/Theory/Tuning/Polansky_1978.hs
+++ b/Music/Theory/Tuning/Polansky_1978.hs
@@ -4,7 +4,8 @@
 
 import Data.List {- base -}
 
-import qualified Music.Theory.Tuning as T
+import qualified Music.Theory.Tuning as T {- hmt -}
+import qualified Music.Theory.Tuning.Type as T {- hmt -}
 
 {- | Three interlocking harmonic series on 1:5:3, by Larry Polansky in \"Psaltery\".
 
@@ -43,4 +44,4 @@
 
 -}
 psaltery_o :: T.Tuning
-psaltery_o = T.Tuning (Left psaltery_o_r) 2
+psaltery_o = T.Tuning (Left psaltery_o_r) Nothing
diff --git a/Music/Theory/Tuning/Polansky_1985c.hs b/Music/Theory/Tuning/Polansky_1985c.hs
--- a/Music/Theory/Tuning/Polansky_1985c.hs
+++ b/Music/Theory/Tuning/Polansky_1985c.hs
@@ -1,16 +1,16 @@
 -- | Larry Polansky. "Notes on Piano Study #5".
--- _1/1, The Journal of the Just Intonation Newtork_, 1(4), Autumn 1985.
+-- _1, The Journal of the Just Intonation Newtork_, 1(4), Autumn 1985.
 module Music.Theory.Tuning.Polansky_1985c where
 
-import Music.Theory.Tuning {- hmt -}
+import Music.Theory.Tuning.Type {- hmt -}
 
 -- | The tuning has four octaves, these ratios are per-octave.
 ps5_jpr_r :: [[Rational]]
 ps5_jpr_r =
-    [[1/1, 21/20, 9/8, 6/5, 5/4,  4/3,   7/5, 3/2, 8/5,  5/3,  7/4, 15/8]
-    ,[1/1, 21/20, 9/8, 6/5, 5/4,  4/3,   7/5, 3/2, 8/5,  5/3,  7/4, 15/8]
-    ,[1/1, 33/32, 9/8, 6/5, 5/4, 21/16, 11/8, 3/2, 8/5, 13/8,  7/4, 15/8]
-    ,[1/1, 21/20, 9/8, 7/6, 5/4,  4/3,  11/8, 3/2, 8/5, 27/16, 7/4, 15/8]]
+    [[1, 21/20, 9/8, 6/5, 5/4,  4/3,   7/5, 3/2, 8/5,  5/3,  7/4, 15/8]
+    ,[1, 21/20, 9/8, 6/5, 5/4,  4/3,   7/5, 3/2, 8/5,  5/3,  7/4, 15/8]
+    ,[1, 33/32, 9/8, 6/5, 5/4, 21/16, 11/8, 3/2, 8/5, 13/8,  7/4, 15/8]
+    ,[1, 21/20, 9/8, 7/6, 5/4,  4/3,  11/8, 3/2, 8/5, 27/16, 7/4, 15/8]]
 
 {- | Four-octave tuning.
 
@@ -30,6 +30,6 @@
 -}
 ps5_jpr :: Tuning
 ps5_jpr =
-    let f (m,n) = map (* m) n
-        r = concat (map f (zip [1,2,4,8] ps5_jpr_r))
-    in Tuning (Left r) 16
+    let f m n = map (* m) n
+        r = concat (zipWith f [1,2,4,8] ps5_jpr_r)
+    in Tuning (Left r) (Just (Left 4))
diff --git a/Music/Theory/Tuning/Rosenboom_1979.hs b/Music/Theory/Tuning/Rosenboom_1979.hs
--- a/Music/Theory/Tuning/Rosenboom_1979.hs
+++ b/Music/Theory/Tuning/Rosenboom_1979.hs
@@ -7,10 +7,11 @@
 import Data.List {- base -}
 import Data.Ratio {- base -}
 
+import qualified Music.Theory.Function as T
 import qualified Music.Theory.List as T
 import qualified Music.Theory.Pitch as T
 import qualified Music.Theory.Pitch.Name as T
-import qualified Music.Theory.Tuning.ET as T
+import qualified Music.Theory.Tuning.Et as T
 import qualified Music.Theory.Tuning.Scala as Scala
 import qualified Music.Theory.Tuple as T
 
@@ -35,7 +36,7 @@
 -- | Actual scale, in CPS.
 --
 -- > let r = [52,69,76,83,92,104,119,138,156,166,185,208,234,260,277,286,311,332,363]
--- > in map round dr_scale == r
+-- > map round dr_scale == r
 dr_scale :: [Double]
 dr_scale =
     let f0 = T.octpc_to_cps (1::Int,8)
@@ -45,38 +46,14 @@
 -- > putStrLn (unlines (map (unwords . T.hs_r_pitch_pp 1)  dr_scale_tbl_12et))
 -- > map (\(f,p,_,_,_) -> (T.pitch_to_midi p,f)) dr_scale_tbl_12et
 dr_scale_tbl_12et :: [T.HS_R T.Pitch]
-dr_scale_tbl_12et = map T.nearest_12et_tone dr_scale
-
-{-
-
-51.9 A♭1 51.9 0.0 0.0
-69.2 C♯2 69.3 -0.1 -2.0
-75.5 D2 73.4 2.1 48.7
-83.1 E2 82.4 0.7 13.7
-92.3 F♯2 92.5 -0.2 -3.9
-103.8 A♭2 103.8 0.0 0.0
-118.7 B♭2 116.5 2.1 31.2
-138.4 C♯3 138.6 -0.2 -2.0
-155.7 E♭3 155.6 0.2 2.0
-166.1 E3 164.8 1.3 13.7
-184.6 F♯3 185.0 -0.4 -3.9
-207.7 A♭3 207.7 0.0 0.0
-233.6 B♭3 233.1 0.5 3.9
-259.6 C4 261.6 -2.1 -13.7
-276.9 C♯4 277.2 -0.3 -2.0
-285.5 D4 293.7 -8.1 -48.7
-311.5 E♭4 311.1 0.4 2.0
-332.2 E4 329.6 2.6 13.7
-363.4 F♯4 370.0 -6.6 -31.2
-
--}
+dr_scale_tbl_12et = map (T.nearest_12et_tone_k0 (69,440)) dr_scale
 
 -- > Scala.scale_verify dr_scale_scala
 -- > putStrLn $ unlines $ Scala.scale_pp dr_scale_scala
-dr_scale_scala :: Scala.Scale Integer
+dr_scale_scala :: Scala.Scale
 dr_scale_scala =
-    let f (r,(_,p,_,_,_)) = (T.pitch_to_midi p :: Int,r)
-        sq = map f (zip dr_tuning dr_scale_tbl_12et)
+    let f r (_,p,_,_,_) = (T.pitch_to_midi p :: Int,r)
+        sq = zipWith f dr_tuning dr_scale_tbl_12et
         g z k = case lookup k sq of
                   Nothing -> (z,(k,z))
                   Just r -> (r,(k,r))
@@ -85,31 +62,7 @@
 
 -- > putStrLn (unlines (map (unwords . T.hs_r_pitch_pp 1)  dr_scale_tbl_24et))
 dr_scale_tbl_24et :: [T.HS_R T.Pitch]
-dr_scale_tbl_24et = map T.nearest_24et_tone dr_scale
-
-{-
-
-51.9 A♭1 51.9 0.0 0.0
-69.2 C♯2 69.3 -0.1 -2.0
-75.5 D𝄲2 75.6 -0.1 -1.3
-83.1 E2 82.4 0.7 13.7
-92.3 F♯2 92.5 -0.2 -3.9
-103.8 A♭2 103.8 0.0 0.0
-118.7 B𝄳2 120.0 -1.3 -18.8
-138.4 C♯3 138.6 -0.2 -2.0
-155.7 E♭3 155.6 0.2 2.0
-166.1 E3 164.8 1.3 13.7
-184.6 F♯3 185.0 -0.4 -3.9
-207.7 A♭3 207.7 0.0 0.0
-233.6 B♭3 233.1 0.5 3.9
-259.6 C4 261.6 -2.1 -13.7
-276.9 C♯4 277.2 -0.3 -2.0
-285.5 D𝄳4 285.3 0.2 1.3
-311.5 E♭4 311.1 0.4 2.0
-332.2 E4 329.6 2.6 13.7
-363.4 F𝄲4 359.5 3.9 18.8
-
--}
+dr_scale_tbl_24et = map (T.nearest_24et_tone_k0 (69,440)) dr_scale
 
 dr_chords :: [[T.Pitch]]
 dr_chords =
@@ -160,8 +113,8 @@
     ,[(8,1),(1,10)]
     ]
 
--- > import Data.Function
--- > import Data.List
+-- > import Data.Function {- base -}
+-- > import Data.List {- base -}
 -- > reverse (sortBy (compare `on` snd) dr_ratio_seq_hist)
 dr_ratio_seq_hist :: (Ord n,Num n) => [((n,n),Int)]
 dr_ratio_seq_hist = T.histogram (concat dr_ratio_seq)
diff --git a/Music/Theory/Tuning/Scala.hs b/Music/Theory/Tuning/Scala.hs
--- a/Music/Theory/Tuning/Scala.hs
+++ b/Music/Theory/Tuning/Scala.hs
@@ -1,7 +1,10 @@
--- | Parser for the Scala scale file format.  See
--- <http://www.huygens-fokker.org/scala/scl_format.html> for details.
--- This module succesfully parses all 4671 scales in v.85 of the scale
--- library.
+{- | Parser for the Scala scale file format.
+
+See <http://www.huygens-fokker.org/scala/scl_format.html> for details.
+
+This module succesfully parses all scales in v.91 of the scale library.
+
+-}
 module Music.Theory.Tuning.Scala where
 
 import Control.Monad {- base -}
@@ -13,20 +16,23 @@
 import System.Environment {- base -}
 import System.FilePath {- filepath -}
 
-import qualified Music.Theory.Directory as T {- hmt -}
-import qualified Music.Theory.Either as T {- hmt -}
-import qualified Music.Theory.Function as T {- hmt -}
-import qualified Music.Theory.IO as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Math as T {- hmt -}
+import qualified Music.Theory.Array.Csv as Csv {- hmt -}
+import qualified Music.Theory.Directory as Directory {- hmt -}
+import qualified Music.Theory.Either as Either {- hmt -}
+import qualified Music.Theory.Function as Function {- hmt -}
+import qualified Music.Theory.Io as Io {- hmt -}
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Math.Prime as Prime {- hmt -}
 import qualified Music.Theory.Read as T {- hmt -}
+import qualified Music.Theory.Show as T {- hmt -}
 import qualified Music.Theory.String as T {- hmt -}
 import qualified Music.Theory.Tuning as T {- hmt -}
+import qualified Music.Theory.Tuning.Type as T {- hmt -}
 
 -- * Pitch
 
 -- | A @.scl@ pitch is either in 'Cents' or is a 'Ratio'.
-type Pitch i = Either T.Cents (Ratio i)
+type Pitch = Either T.Cents Rational
 
 -- | An enumeration type for @.scl@ pitch classification.
 data Pitch_Type = Pitch_Cents | Pitch_Ratio deriving (Eq,Show)
@@ -35,11 +41,11 @@
 type Epsilon = Double
 
 -- | Derive 'Pitch_Type' from 'Pitch'.
-pitch_type :: Pitch i -> Pitch_Type
+pitch_type :: Pitch -> Pitch_Type
 pitch_type = either (const Pitch_Cents) (const Pitch_Ratio)
 
 -- | Pitch as 'T.Cents', conversion by 'T.ratio_to_cents' if necessary.
-pitch_cents :: Integral i => Pitch i -> T.Cents
+pitch_cents :: Pitch -> T.Cents
 pitch_cents p =
     case p of
       Left c -> c
@@ -47,14 +53,14 @@
 
 -- | Pitch as 'Rational', conversion by 'T.reconstructed_ratio' if
 -- necessary, hence /epsilon/.
-pitch_ratio :: Epsilon -> Pitch Integer -> Rational
+pitch_ratio :: Epsilon -> Pitch -> Rational
 pitch_ratio epsilon p =
     case p of
       Left c -> T.reconstructed_ratio epsilon c
       Right r -> r
 
 -- | A pair giving the number of 'Cents' and number of 'Ratio' pitches.
-pitch_representations :: Integral t => [Pitch i] -> (t,t)
+pitch_representations :: [Pitch] -> (Int,Int)
 pitch_representations =
     let f (l,r) p = case p of
                       Left _ -> (l + 1,r)
@@ -62,132 +68,148 @@
     in foldl f (0,0)
 
 -- | If scale is uniform, give type.
-uniform_pitch_type :: [Pitch i] -> Maybe Pitch_Type
+uniform_pitch_type :: [Pitch] -> Maybe Pitch_Type
 uniform_pitch_type p =
-    case pitch_representations p :: (Int,Int) of
+    case pitch_representations p of
       (0,_) -> Just Pitch_Ratio
       (_,0) -> Just Pitch_Cents
       _ -> Nothing
 
 -- | The predominant type of the pitches for 'Scale'.
-pitch_type_predominant :: [Pitch i] -> Pitch_Type
+pitch_type_predominant :: [Pitch] -> Pitch_Type
 pitch_type_predominant p =
-    let (c,r) = pitch_representations p :: (Int,Int)
+    let (c,r) = pitch_representations p
     in if c >= r then Pitch_Cents else Pitch_Ratio
 
 -- * Scale
 
--- | A scale has a name, a description, a degree, and a list of 'Pitch'es.
-type Scale i = (String,String,Int,[Pitch i])
+-- | A scale has a name, a description, a degree, and a sequence of pitches.
+--   The /name/ is the the file-name without the /.scl/ suffix.
+--   By convention the first comment line gives the file name (with suffix).
+--   The pitches do NOT include 1:1 or 0c and do include the octave.
+type Scale = (String,String,Int,[Pitch])
 
 -- | The name of a scale.
-scale_name :: Scale i -> String
+scale_name :: Scale -> String
 scale_name (nm,_,_,_) = nm
 
 -- | Text description of a scale.
-scale_description :: Scale i -> String
+scale_description :: Scale -> String
 scale_description (_,d,_,_) = d
 
 -- | The degree of the scale (number of 'Pitch'es).
-scale_degree :: Scale i -> Int
+scale_degree :: Scale -> Int
 scale_degree (_,_,n,_) = n
 
 -- | The 'Pitch'es at 'Scale'.
-scale_pitches :: Scale i -> [Pitch i]
+scale_pitches :: Scale -> [Pitch]
 scale_pitches (_,_,_,p) = p
 
+-- | Is 'Pitch' outside of the standard octave (ie. cents 0-1200 and ratios 1-2)
+pitch_non_oct :: Pitch -> Bool
+pitch_non_oct p =
+  case p of
+    Left c -> c < 0 || c > 1200
+    Right r -> r < 1 || r > 2
+
 -- | Ensure degree and number of pitches align.
-scale_verify :: Scale i -> Bool
+scale_verify :: Scale -> Bool
 scale_verify (_,_,n,p) = n == length p
 
 -- | Raise error if scale doesn't verify, else 'id'.
-scale_verify_err :: Scale i -> Scale i
-scale_verify_err scl = if scale_verify scl then scl else error "invalid scale"
+scale_verify_err :: Scale -> Scale
+scale_verify_err scl = if scale_verify scl then scl else error ("invalid scale: " ++ scale_name scl)
 
--- | The last 'Pitch' element of the scale (ie. the /ocatve/).
-scale_octave :: Scale i -> Maybe (Pitch i)
+-- | The last 'Pitch' element of the scale (ie. the /octave/).  For empty scales give 'Nothing'.
+scale_octave :: Scale -> Maybe Pitch
 scale_octave (_,_,_,s) =
     case s of
       [] -> Nothing
       _ -> Just (last s)
 
--- | Is 'scale_octave' perfect, ie. 'Ratio' of @2@ or 'Cents' of
--- @1200@.
-perfect_octave :: Integral i => Scale i -> Bool
-perfect_octave s = scale_octave s `elem` [Just (Right 2),Just (Left 1200)]
+-- | Error variant.
+scale_octave_err :: Scale -> Pitch
+scale_octave_err = fromMaybe (error "scale_octave?") . scale_octave
 
+-- | Is 'scale_octave' perfect, ie. 'Ratio' of @2@ or 'Cents' of @1200@.
+perfect_octave :: Scale -> Bool
+perfect_octave s =
+  case scale_octave s of
+    Just (Right 2) -> True
+    Just (Left 1200.0) -> True
+    _ -> False
+
 -- | Are all pitches of the same type.
-is_scale_uniform :: Scale i -> Bool
+is_scale_uniform :: Scale -> Bool
 is_scale_uniform = isJust . uniform_pitch_type . scale_pitches
 
--- | Make scale pitches uniform, conforming to the most promininent
--- pitch type.
-scale_uniform :: Epsilon -> Scale Integer -> Scale Integer
+-- | Are the pitches in ascending sequence.
+is_scale_ascending :: Scale -> Bool
+is_scale_ascending = List.is_ascending . map pitch_cents . scale_pitches
+
+-- | Make scale pitches uniform, conforming to the most predominant pitch type.
+scale_uniform :: Epsilon -> Scale -> Scale
 scale_uniform epsilon (nm,d,n,p) =
     case pitch_type_predominant p of
       Pitch_Cents -> (nm,d,n,map (Left . pitch_cents) p)
       Pitch_Ratio -> (nm,d,n,map (Right . pitch_ratio epsilon) p)
 
 -- | Scale as list of 'T.Cents' (ie. 'pitch_cents') with @0@ prefix.
-scale_cents :: Integral i => Scale i -> [T.Cents]
+scale_cents :: Scale -> [T.Cents]
 scale_cents s = 0 : map pitch_cents (scale_pitches s)
 
 -- | 'map' 'round' of 'scale_cents'.
-scale_cents_i :: Integral i => Scale i -> [i]
+scale_cents_i :: Scale -> [T.Cents_I]
 scale_cents_i = map round . scale_cents
 
 -- | Scale as list of 'Rational' (ie. 'pitch_ratio') with @1@ prefix.
-scale_ratios :: Epsilon -> Scale Integer -> [Rational]
+scale_ratios :: Epsilon -> Scale -> [Rational]
 scale_ratios epsilon s = 1 : map (pitch_ratio epsilon) (scale_pitches s)
 
--- | Require that 'Scale' be uniformlay of 'Ratio's.
-scale_ratios_req :: Integral i => Scale i -> [Ratio i]
-scale_ratios_req =
-    let err = error "scale_ratios_req"
-    in (1 :) . map (fromMaybe err . T.fromRight) . scale_pitches
-
--- | Translate 'Scale' to 'T.Tuning'.  If 'Scale' is uniformly
--- rational, 'T.Tuning' is rational, else 'T.Tuning' is in 'T.Cents'.
--- 'Epsilon' is used to recover the 'Rational' octave if required.
-scale_to_tuning :: Epsilon -> Scale Integer -> T.Tuning
-scale_to_tuning epsilon (_,_,_,p) =
-    case partitionEithers p of
-      ([],r) -> let (r',o) = T.separate_last r
-                in T.Tuning (Left (1 : r')) o
-      _ -> let (c,o) = T.separate_last p
-               c' = 0 : map pitch_cents c
-               o' = either (T.reconstructed_ratio epsilon) id o
-           in T.Tuning (Right c') o'
+-- | Require that 'Scale' be uniformly of 'Ratio's.
+scale_ratios_u :: Scale -> Maybe [Rational]
+scale_ratios_u scl =
+  let err = error "scale_ratios_u?"
+      p = scale_pitches scl
+  in case uniform_pitch_type p of
+       Just Pitch_Ratio -> Just (1 : map (fromMaybe err . Either.from_right) p)
+       _ -> Nothing
 
--- | Convert 'T.Tuning' to 'Scale'.
---
--- > tuning_to_scale ("et12","12 tone equal temperament") (T.equal_temperament 12)
-tuning_to_scale :: (String,String) -> T.Tuning -> Scale Integer
-tuning_to_scale (nm,dsc) (T.Tuning p o) =
-    let n = either length length p
-        p' = either (map Right . tail) (map Left . tail) p ++ [Right o]
-    in (nm,dsc,n,p')
+-- | Erroring variant of 'scale_ratios_u.
+scale_ratios_req :: Scale -> [Rational]
+scale_ratios_req = fromMaybe (error "scale_ratios_req") . scale_ratios_u
 
 {- | Are scales equal ('==') at degree and tuning data.
 
 > db <- scl_load_db
 > let r = [2187/2048,9/8,32/27,81/64,4/3,729/512,3/2,6561/4096,27/16,16/9,243/128,2/1]
-> let Just py = find (scale_eq ("","",12,map Right r)) db
+> let Just py = find (scale_eq ("","",length r,map Right r)) db
 > scale_name py == "pyth_12"
 
+'scale_eqv' provides an approximate equality function.
+
 > let c = map T.ratio_to_cents r
-> let Just py' = find (scale_eqv ("","",12,map Left c)) db
+> let Just py' = find (scale_eqv 0.00001 ("","",length c,map Left c)) db
 > scale_name py' == "pyth_12"
+
 -}
-scale_eq :: Eq n => Scale n -> Scale n -> Bool
+scale_eq :: Scale -> Scale -> Bool
 scale_eq (_,_,d0,p0) (_,_,d1,p1) = d0 == d1 && p0 == p1
 
--- | Are scales equal ('==') at degree and tuning data after 'pitch_cents'.
-scale_eqv :: Integral n => Scale n -> Scale n -> Bool
-scale_eqv (_,_,d0,p0) (_,_,d1,p1) =
-    let f = map pitch_cents
-    in d0 == d1 && f p0 == f p1
+-- | Are scales equal at degree and 'intersect' to at least /k/ places of tuning data.
+scale_eq_n :: Int -> Scale -> Scale -> Bool
+scale_eq_n k (_,_,d0,p0) (_,_,d1,p1) = d0 == d1 && length (p0 `intersect` p1) >= k
 
+-- | Is `s1` a proper subset of `s2`.
+scale_sub :: Scale -> Scale -> Bool
+scale_sub (_,_,d0,p0) (_,_,d1,p1) = d0 < d1 && intersect p0 p1 == p0
+
+-- | Are scales equal at degree and equivalent to within /epsilon/ at 'pitch_cents'.
+scale_eqv :: Epsilon -> Scale -> Scale -> Bool
+scale_eqv epsilon (_,_,d0,p0) (_,_,d1,p1) =
+    let (~=) p q = abs (pitch_cents p - pitch_cents q) < epsilon
+    in d0 == d1 && and (zipWith (~=) p0 p1)
+
 -- * Parser
 
 -- | Comment lines begin with @!@.
@@ -203,45 +225,48 @@
 remove_eol_comments :: String -> String
 remove_eol_comments = takeWhile (/= '!')
 
--- | Remove comments and null lines and trailing comments.
+-- | Remove comments and trailing comments (the description may be empty, keep nulls)
 --
--- > filter_comments ["!a","b","","c","d!e"] == ["b","c","d"]
+-- > filter_comments ["!a","b","","c","d!e"] == ["b","","c","d"]
 filter_comments :: [String] -> [String]
 filter_comments =
     map remove_eol_comments .
-    filter (not . T.predicate_any [is_comment,null])
+    filter (not . Function.predicate_any [is_comment])
 
 -- | Pitches are either cents (with decimal point, possibly trailing) or ratios (with @/@).
 --
--- > map parse_pitch ["700.0","350.","3/2","2"] == [Left 700,Left 350,Right (3/2),Right 2]
-parse_pitch :: (Read i,Integral i) => String -> Pitch i
+-- > map parse_pitch ["70.0","350.","3/2","2","2/1"] == [Left 70,Left 350,Right (3/2),Right 2,Right 2]
+parse_pitch :: String -> Pitch
 parse_pitch p =
     if '.' `elem` p
     then Left (T.read_fractional_allow_trailing_point_err p)
     else Right (T.read_ratio_with_div_err p)
 
 -- | Pitch lines may contain commentary.
-parse_pitch_ln :: (Read i, Integral i) => String -> Pitch i
+parse_pitch_ln :: String -> Pitch
 parse_pitch_ln x =
     case words x of
       p:_ -> parse_pitch p
       _ -> error (show ("parse_pitch_ln",words x))
 
 -- | Parse @.scl@ file.
-parse_scl :: (Read i, Integral i) => String -> String -> Scale i
+parse_scl :: String -> String -> Scale
 parse_scl nm s =
     case filter_comments (lines (T.filter_cr s)) of
-      t:n:p -> let scl = (nm,T.delete_trailing_whitespace t,T.read_err n,map parse_pitch_ln p)
+      t:n:p -> let scl = (nm
+                         ,T.delete_trailing_whitespace t
+                         ,T.read_err_msg "degree" n
+                         ,map parse_pitch_ln p)
                in scale_verify_err scl
       _ -> error "parse"
 
--- * IO
+-- * Io
 
 -- | Read the environment variable @SCALA_SCL_DIR@, which is a
 -- sequence of directories used to locate scala files on.
 --
--- > setEnv "SCALA_DIST_DIR" "/home/rohan/data/scala/85/scl"
-scl_get_dir :: IO [String]
+-- > setEnv "SCALA_SCL_DIR" "/home/rohan/data/scala/90/scl"
+scl_get_dir :: IO [FilePath]
 scl_get_dir = fmap splitSearchPath (getEnv "SCALA_SCL_DIR")
 
 -- | Lookup the @SCALA_SCL_DIR@ environment variable, which must exist, and derive the filepath.
@@ -253,14 +278,14 @@
   dir <- scl_get_dir
   when (null dir) (error "scl_derive_filename: SCALA_SCL_DIR: nil")
   when (hasExtension nm) (error "scl_derive_filename: name has extension")
-  T.path_scan_err dir (nm <.> "scl")
+  Directory.path_scan_err dir (nm <.> "scl")
 
 -- | If the name is an absolute file path and has a @.scl@ extension,
 -- then return it, else run 'scl_derive_filename'.
 --
 -- > scl_resolve_name "young-lm_piano"
--- > scl_resolve_name "/home/rohan/data/scala/85/scl/young-lm_piano.scl"
--- > scl_resolve_name "/home/rohan/data/scala/85/scl/unknown-tuning.scl"
+-- > scl_resolve_name "/home/rohan/data/scala/90/scl/young-lm_piano.scl"
+-- > scl_resolve_name "/home/rohan/data/scala/90/scl/unknown-tuning.scl"
 scl_resolve_name :: String -> IO FilePath
 scl_resolve_name nm =
     let ex_f x = if x then return nm else error "scl_resolve_name: file does not exist"
@@ -273,81 +298,76 @@
 -- > s <- scl_load "xenakis_chrom"
 -- > pitch_representations (scale_pitches s) == (6,1)
 -- > scale_ratios 1e-3 s == [1,21/20,29/23,179/134,280/187,11/7,100/53,2]
-scl_load :: (Read i, Integral i) => String -> IO (Scale i)
+scl_load :: String -> IO Scale
 scl_load nm = do
   fn <- scl_resolve_name nm
-  s <- T.read_file_iso_8859_1 fn
+  s <- Io.read_file_iso_8859_1 fn
   return (parse_scl (takeBaseName nm) s)
 
--- | 'scale_to_tuning' of 'scl_load'.
-scl_load_tuning :: Epsilon -> String -> IO T.Tuning
-scl_load_tuning epsilon = fmap (scale_to_tuning epsilon) . scl_load
-
-{- | Load all @.scl@ files at /dir/.
-
-> dir <- scl_get_dir
-> dir == ["/home/rohan/data/scala/85/scl","/home/rohan/sw/hmt/data/scl"]
-> let [scl_85_dir,ext_dir] = dir
-> db <- scl_load_dir scl_85_dir
-> length db == 4671
-> length (filter ((== 0) . scale_degree) db) == 0
-> length (filter ((/= 1) . head . scale_ratios 1e-3) db) == 0
-> length (filter ((/= 0) . head . scale_cents) db) == 0
-> length (filter (== Just (Right 2)) (map scale_octave db)) == 4003
-> length (filter is_scale_uniform db) == 2816
-
-> let na = filter (not . T.is_ascending . scale_cents) db
-> length na == 121
-> mapM_ (putStrLn . unlines . scale_stat) na
-
-> import qualified Music.Theory.List as T
-> import Sound.SC3.Plot
-> plot_p2_stp [T.histogram (map scale_degree db)]
-
-> import Data.List
-
-> let r = ["Xenakis's Byzantine Liturgical mode, 5 + 19 + 6 parts"
->         ,"Xenakis's Byzantine Liturgical mode, 12 + 11 + 7 parts"
->         ,"Xenakis's Byzantine Liturgical mode, 7 + 16 + 7 parts"]
-> in filter (isInfixOf "Xenakis") (map scale_description db) == r
-
-> let r = ["LaMonte Young, tuning of For Guitar '58. 1/1 March '92, inv.of Mersenne lute 1"
->         ,"LaMonte Young's Well-Tuned Piano"]
-> in filter (isInfixOf "LaMonte Young") (map scale_description db) == r
-
-> length (filter (not . perfect_octave) db) == 663
+{- | Load all @.scl@ files at /dir/, associate with file-name.
 
+> db <- scl_load_dir_fn "/home/rohan/data/scala/91/scl"
+> length db == 5176 -- v.91
+> map (\(fn,s) -> (takeFileName fn,scale_name s)) db
 -}
-scl_load_dir :: (Read i, Integral i) => FilePath -> IO [Scale i]
-scl_load_dir d = T.dir_subset [".scl"] d >>= mapM scl_load
+scl_load_dir_fn :: FilePath -> IO [(FilePath,Scale)]
+scl_load_dir_fn d = do
+  fn <- Directory.dir_subset [".scl"] d
+  scl <- mapM scl_load fn
+  return (zip fn scl)
 
+-- | 'snd' of 'scl_load_dir_fn'
+scl_load_dir :: FilePath -> IO [Scale]
+scl_load_dir = fmap (map snd) . scl_load_dir_fn
+
 -- | Load Scala data base at 'scl_get_dir'.
 --
 -- > db <- scl_load_db
--- > mapM_ (putStrLn.unlines.scale_stat) (filter (not . perfect_octave) db)
-scl_load_db :: (Read i, Integral i) => IO [Scale i]
+-- > mapM_ (putStrLn . unlines . scale_stat) (filter (not . perfect_octave) db)
+scl_load_db :: IO [Scale]
 scl_load_db = do
   dir <- scl_get_dir
   r <- mapM scl_load_dir dir
   return (concat r)
 
--- * PP
+-- * Pp
 
-scale_stat :: (Integral i,Show i) => Scale i -> [String]
+-- | <http://www.huygens-fokker.org/docs/scalesdir.txt>
+scales_dir_txt_tbl :: [Scale] -> [[String]]
+scales_dir_txt_tbl =
+  let f s = [scale_name s,show (scale_degree s),scale_description s]
+  in map f
+
+-- | Format as CSV file.
+--
+-- > db <- scl_load_db
+-- > writeFile "/tmp/scl.csv" (scales_dir_txt_csv db)
+scales_dir_txt_csv :: [Scale] -> String
+scales_dir_txt_csv db = Csv.csv_table_pp id Csv.def_csv_opt (Nothing,scales_dir_txt_tbl db)
+
+-- | Simple plain-text display of scale data.
+--
+-- > db <- scl_load_db
+-- > writeFile "/tmp/scl.txt" (unlines (intercalate [""] (map scale_stat db)))
+scale_stat :: Scale -> [String]
 scale_stat s =
-    let ty = uniform_pitch_type (scale_pitches s)
-    in ["scale-name        : " ++ scale_name s
-       ,"scale-description : " ++ scale_description s
-       ,"scale-degree      : " ++ show (scale_degree s)
-       ,"scale-type        : " ++ maybe "non-uniform" show ty
-       ,"perfect-octave    : " ++ show (perfect_octave s)
-       ,"scale-cents-i     : " ++ show (scale_cents_i s)
-       ,if ty == Just Pitch_Ratio
-        then "scale-ratios      : " ++ intercalate "," (map T.rational_pp (scale_ratios_req s))
+    let p = scale_pitches s
+        u_ty = uniform_pitch_type p
+        n_ty = let p_ty = pitch_type_predominant p
+                   (p_i,p_j) = pitch_representations p
+               in concat ["non-uniform (",show p_ty,",",show p_i,":",show p_j,")"]
+    in ["name        : " ++ scale_name s
+       ,"description : " ++ scale_description s
+       ,"degree      : " ++ show (scale_degree s)
+       ,"type        : " ++ maybe n_ty show u_ty
+       ,"perfect-oct : " ++ show (perfect_octave s)
+       ,"cents-i     : " ++ show (scale_cents_i s)
+       ,if u_ty == Just Pitch_Ratio
+        then "ratios      : " ++ intercalate "," (map T.rational_pp (scale_ratios_req s))
         else ""]
 
 -- | Pretty print 'Pitch' in @Scala@ format.
-pitch_pp :: Show i => Pitch i -> String
+pitch_pp :: Pitch -> String
 pitch_pp p =
     case p of
       Left c -> show c
@@ -355,10 +375,10 @@
 
 -- | Pretty print 'Scale' in @Scala@ format.
 --
--- > s <- scl_load "et19"
--- > s <- scl_load "young-lm_piano"
--- > putStr $ unlines $ scale_pp s
-scale_pp :: Show i => Scale i -> [String]
+-- > scl <- scl_load "et19"
+-- > scl <- scl_load "young-lm_piano"
+-- > putStr $ unlines $ scale_pp scl
+scale_pp :: Scale -> [String]
 scale_pp (nm,dsc,k,p) =
     ["! " ++ nm ++ ".scl"
     ,"!"
@@ -366,19 +386,119 @@
     ,show k
     ,"!"] ++ map pitch_pp p
 
--- * DIST
+scale_wr :: FilePath -> Scale -> IO ()
+scale_wr fn = writeFile fn . unlines . scale_pp
 
+-- | Write /scl/ to /dir/ with the file-name 'scale_name'.scl
+scale_wr_dir :: FilePath -> Scale -> IO ()
+scale_wr_dir dir scl = scale_wr (dir </> scale_name scl <.> "scl") scl
+
+-- * Dist
+
 -- | @scala@ distribution directory, given at @SCALA_DIST_DIR@.
 --
--- > fmap (== "/home/rohan/opt/build/scala-22-pc64-linux") dist_get_dir
+-- > setEnv "SCALA_DIST_DIR" "/home/rohan/opt/build/scala-22"
 dist_get_dir :: IO String
 dist_get_dir = getEnv "SCALA_DIST_DIR"
 
 -- | Load file from 'dist_get_dir'.
---
--- > s <- load_dist_file "intnam.par"
--- > length s == 473
-load_dist_file :: FilePath -> IO [String]
+load_dist_file :: FilePath -> IO String
 load_dist_file nm = do
   d <- dist_get_dir
-  fmap lines (readFile (d </> nm))
+  readFile (d </> nm)
+
+{- | 'fmap' 'lines' 'load_dist_file'
+
+> s <- load_dist_file_ln "intnam.par"
+> length s == 565 -- Scala 2.46d
+-}
+load_dist_file_ln :: FilePath -> IO [String]
+load_dist_file_ln = fmap lines . load_dist_file
+
+-- * Query
+
+-- | Is scale just-intonation (ie. are all pitches ratios)
+scl_is_ji :: Scale -> Bool
+scl_is_ji = (==) (Just Pitch_Ratio) . uniform_pitch_type . scale_pitches
+
+-- | Calculate limit for JI scale (ie. largest prime factor)
+scl_ji_limit :: Scale -> Integer
+scl_ji_limit = maximum . map fst . concatMap Prime.rational_prime_factors_m . scale_ratios_req
+
+-- | Sum of absolute differences to scale given in cents, sorted, with rotation.
+scl_cdiff_abs_sum :: [T.Cents] -> Scale -> [(Double,[T.Cents],Int)]
+scl_cdiff_abs_sum c scl =
+  let r = map (List.dx_d 0) (List.rotations (List.d_dx (sort (scale_cents scl))))
+      ndiff x i = let d = zipWith (-) c x in (sum (map abs d),d,i)
+  in sort (zipWith ndiff r [0..])
+
+{- | Variant selecting only nearest and with post-processing function.
+
+> scl <- scl_load "holder"
+> scale_cents_i scl
+> c = [0,83,193,308,388,502,584,695,778,890,1004,1085,1200]
+> (_,r,_) = scl_cdiff_abs_sum_1 round c scl
+> r == [0,2,-1,1,0,-1,0,-1,0,0,0,0,0]
+-}
+scl_cdiff_abs_sum_1 :: (Double -> n) -> [T.Cents] -> Scale -> (Double,[n],Int)
+scl_cdiff_abs_sum_1 pp c scl =
+  case scl_cdiff_abs_sum c scl of
+    [] -> error "scl_cdiff_abs_sum_1"
+    (n,d,r):_ -> (n,map pp d,r)
+
+{- | Sort DB into ascending order of sum of absolute of differences to scale given in cents.
+     Scales are sorted and all rotations are considered.
+
+> db <- scl_load_db
+> c = [0,83,193,308,388,502,584,695,778,890,1004,1085,1200]
+> r = scl_db_query_cdiff_asc round db c
+> ((_,dx,_),_):_ = r
+> dx == [0,2,-1,1,0,-1,0,-1,0,0,0,0,0]
+> mapM_ (putStrLn . unlines . scale_stat . snd) (take 10 r)
+-}
+scl_db_query_cdiff_asc :: Ord n => (Double -> n) -> [Scale] -> [T.Cents] -> [((Double,[n],Int),Scale)]
+scl_db_query_cdiff_asc pp db c =
+  let n = length c - 1
+      db_n = filter ((== n) . scale_degree) db
+  in sort (map (\scl -> (scl_cdiff_abs_sum_1 pp c scl,scl)) db_n)
+
+-- | Is /x/ the same scale as /scl/ under /cmp/.
+scale_cmp_ji :: ([Rational] -> [Rational] -> Bool) -> [Rational] -> Scale -> Bool
+scale_cmp_ji cmp x scl =
+  case scale_ratios_u scl of
+    Nothing -> False
+    Just r -> cmp x r
+
+-- | Find scale(s) that are 'scale_cmp_ji' to /x/.
+--   Usual /cmp/ are (==) and 'is_subset'.
+scl_find_ji :: ([Rational] -> [Rational] -> Bool) -> [Rational] -> [Scale] -> [Scale]
+scl_find_ji cmp x = filter (scale_cmp_ji cmp x)
+
+-- * Tuning
+
+-- | Translate 'Scale' to 'T.Tuning'.  If 'Scale' is uniformly
+-- rational, 'T.Tuning' is rational, else it is in 'T.Cents'.
+scale_to_tuning :: Scale -> T.Tuning
+scale_to_tuning (_,_,_,p) =
+    case partitionEithers p of
+      ([],r) -> let (r',o) = List.separate_last r
+                in T.Tuning (Left (1 : r')) (if o == 2 then Nothing else Just (Left o))
+      _ -> let (c,o) = List.separate_last p
+               c' = 0 : map pitch_cents c
+               o' = if o == Left 1200 || o == Right 2 then Nothing else Just (Either.either_swap o)
+           in T.Tuning (Right c') o'
+
+-- | Convert 'T.Tuning' to 'Scale'.
+--
+-- > tuning_to_scale ("et12","12 tone equal temperament") (T.tn_equal_temperament 12)
+tuning_to_scale :: (String,String) -> T.Tuning -> Scale
+tuning_to_scale (nm,dsc) tn@(T.Tuning p _) =
+    let n = either length length p
+        p' = either (map Right . tail) (map Left . tail) p ++ [Either.either_swap (T.tn_octave_def tn)]
+    in (nm,dsc,n,p')
+
+-- | 'scale_to_tuning' of 'scl_load'.
+--
+-- > fmap T.tn_limit (scl_load_tuning "pyra") -- Just 59
+scl_load_tuning :: String -> IO T.Tuning
+scl_load_tuning = fmap scale_to_tuning . scl_load
diff --git a/Music/Theory/Tuning/Scala/Cli.hs b/Music/Theory/Tuning/Scala/Cli.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Scala/Cli.hs
@@ -0,0 +1,271 @@
+-- | Command line interface to hmt/scala.
+module Music.Theory.Tuning.Scala.Cli where
+
+import Data.Char {- base -}
+import Data.List {- base -}
+import System.Environment {- base -}
+import Text.Printf {- base -}
+
+import qualified Music.Theory.Array.Text as T {- hmt-base -}
+import qualified Music.Theory.Function as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Read as T {- hmt-base -}
+import qualified Music.Theory.Show as T {- hmt-base -}
+
+import qualified Music.Theory.Array.Csv.Midi.Mnd as T {- hmt -}
+import qualified Music.Theory.Pitch as T {- hmt -}
+import qualified Music.Theory.Pitch.Spelling.Table as T {- hmt -}
+import qualified Music.Theory.Time.Seq as T {- hmt -}
+import qualified Music.Theory.Tuning as T {- hmt -}
+import qualified Music.Theory.Tuning.Et as T {- hmt -}
+import qualified Music.Theory.Tuning.Midi as T {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
+import qualified Music.Theory.Tuning.Scala.Kbm as Kbm {- hmt -}
+import qualified Music.Theory.Tuning.Scala.Functions as Functions {- hmt -}
+import qualified Music.Theory.Tuning.Scala.Interval as Interval {- hmt -}
+import qualified Music.Theory.Tuning.Scala.Mode as Mode {- hmt -}
+import qualified Music.Theory.Tuning.Type as T {- hmt -}
+
+type R = Double
+
+db_stat :: IO ()
+db_stat = do
+  db <- Scala.scl_load_db
+  let po = filter (== Just (Right 2)) (map Scala.scale_octave db)
+      uf = filter Scala.is_scale_uniform db
+      r = ["# entries        : " ++ show (length db)
+          ,"# perfect-octave : " ++ show (length po)
+          ,"# scale-uniform  : " ++ show (length uf)]
+  putStrLn (unlines r)
+
+-- > db_summarise (Just 15) (Just 65)
+db_summarise :: Maybe Int -> Maybe Int -> IO ()
+db_summarise nm_lim dsc_lim = do
+  db <- Scala.scl_load_db
+  let nm_seq = map Scala.scale_name db
+      nm_max = maybe (maximum (map length nm_seq)) id nm_lim
+      dsc_seq = map Scala.scale_description db
+      fmt (nm,dsc) = printf "%-*s : %s" nm_max (take nm_max nm) (maybe dsc (flip take dsc) dsc_lim)
+      tbl = map fmt (zip nm_seq dsc_seq)
+  putStrLn (unlines tbl)
+
+env :: IO ()
+env = do
+  scl_dir <- Scala.scl_get_dir
+  dist_dir <- getEnv "SCALA_DIST_DIR"
+  putStrLn ("SCALA_SCL_DIR = " ++ if null scl_dir then "NOT SET" else intercalate ":" scl_dir)
+  putStrLn ("SCALA_DIST_DIR = " ++ if null dist_dir then "NOT SET" else dist_dir)
+
+cut :: Maybe Int -> [a] -> [a]
+cut lm s = maybe s (\n -> take n s) lm
+
+search :: (IO [a], a -> String, a -> [String]) -> (Bool, Maybe Int) -> [String] -> IO ()
+search (load_f,descr_f,stat_f) (ci,lm) txt = do
+  db <- load_f
+  let modify = if ci then map toLower else id
+      txt' = map modify txt
+      db' = filter (T.predicate_all (map isInfixOf txt') . modify . descr_f) db
+  mapM_ (putStrLn . unlines . map (cut lm) . stat_f) db'
+
+-- > search_scale (True,Nothing) ["xenakis"]
+-- > search_scale (True,Just 75) ["lamonte","young"]
+search_scale :: (Bool,Maybe Int) -> [String] -> IO ()
+search_scale = search (Scala.scl_load_db,Scala.scale_description,Scala.scale_stat)
+
+-- > search_mode (True,Nothing) ["xenakis"]
+search_mode :: (Bool,Maybe Int) -> [String] -> IO ()
+search_mode = search (fmap Mode.modenam_modes Mode.load_modenam,Mode.mode_description,Mode.mode_stat)
+
+-- > stat_all Nothing
+stat_all :: Maybe Int -> IO ()
+stat_all character_limit = do
+  db <- Scala.scl_load_db
+  mapM_ (putStrLn . unlines . map (cut character_limit) . Scala.scale_stat) db
+
+-- > stat_by_name Nothing "young-lm_piano"
+stat_by_name :: Maybe Int -> FilePath -> IO ()
+stat_by_name lm nm = do
+  sc <- Scala.scl_load nm
+  putStrLn (unlines (map (cut lm) (Scala.scale_stat sc)))
+
+-- > rng_enum (60,72) == [60 .. 72]
+rng_enum :: Enum t => (t,t) -> [t]
+rng_enum (l,r) = [l .. r]
+
+cps_tbl :: String -> T.Mnn_Cps_Table -> (T.Midi,T.Midi) -> IO ()
+cps_tbl fmt tbl mnn_rng = do
+  let cps_pp = T.double_pp 2
+      cents_pp = T.double_pp 1
+      gen_t i = (i,T.midi_to_pitch_ks i,T.lookup_err i tbl)
+      t_pp (i,p,cps) =
+          let ref = T.midi_to_cps i
+              (_,nr,nr_cps,_,_) = T.nearest_12et_tone_k0 (69,440) cps
+          in [show i
+             ,cps_pp cps,T.pitch_pp_iso nr,cents_pp (T.cps_difference_cents nr_cps cps)
+             ,cps_pp ref,T.pitch_pp_iso p,cents_pp (T.cps_difference_cents ref cps)]
+      hdr = ["MNN"
+            ,"CPS","ET12","CENTS-/+"
+            ,"REF CPS","REF ET12","CENTS-/+"]
+      dat = map (t_pp . gen_t) (rng_enum mnn_rng)
+      ln = case fmt of
+             "md" -> T.table_pp T.table_opt_simple (hdr : dat)
+             "csv" -> map (intercalate ",") dat
+             _ -> error "cps_tbl: fmt?"
+  putStr (unlines ln)
+
+-- > cps_tbl_d12 "md" ("young-lm_piano",-74.7,-3) (60,72)
+cps_tbl_d12 :: String -> (String,T.Cents,T.Midi) -> (T.Midi,T.Midi) -> IO ()
+cps_tbl_d12 fmt (nm,c,k) mnn_rng = do
+  t <- Scala.scl_load_tuning nm :: IO T.Tuning
+  let tbl = T.gen_cps_tuning_tbl (T.lift_tuning_f (T.d12_midi_tuning_f (t,c,k)))
+  cps_tbl fmt tbl mnn_rng
+
+-- > cps_tbl_cps "md" ("cet111",27.5,9,127-9) (69,69+25)
+cps_tbl_cps :: String -> (String,R,T.Midi,Int) -> (T.Midi,T.Midi) -> IO ()
+cps_tbl_cps fmt (nm,f0,k,n) mnn_rng = do
+  t <- Scala.scl_load_tuning nm
+  let tbl = T.gen_cps_tuning_tbl (T.cps_midi_tuning_f (t,f0,k,n))
+  cps_tbl fmt tbl mnn_rng
+
+csv_mnd_retune_d12 :: (String,T.Cents,T.Midi) -> FilePath -> FilePath -> IO ()
+csv_mnd_retune_d12 (nm,c,k) in_fn out_fn = do
+  t <- Scala.scl_load_tuning nm
+  let retune_f = T.midi_detune_to_fmidi . T.d12_midi_tuning_f (t,c,k)
+  m <- T.csv_midi_read_wseq in_fn :: IO (T.Wseq R (R,R,T.Channel,T.Param))
+  let f (tm,(mnn,vel,ch,pm)) = (tm,(retune_f (floor mnn),vel,ch,pm))
+  T.csv_mndd_write_wseq 4 out_fn (map f m)
+
+-- > fluidsynth_tuning_d12 ("young-lm_piano",0,0) ("young-lm_piano",-74.7,-3)
+fluidsynth_tuning_d12 :: (String,Int,Int) -> (String,T.Cents,T.Midi) -> IO ()
+fluidsynth_tuning_d12 (fs_name,fs_bank,fs_prog) (nm,c,k) = do
+  t <- Scala.scl_load_tuning nm :: IO T.Tuning
+  let tun_f = T.d12_midi_tuning_f (t,c,k)
+      pp_f n = let (mnn,dt) = tun_f n
+                   cents = fromIntegral mnn * 100 + dt
+                   cents_non_neg = if cents < 0 then 0 else cents
+               in printf "tune %d %d %d %.2f" fs_bank fs_prog n cents_non_neg
+      l = printf "tuning \"%s\" %d %d" fs_name fs_bank fs_prog : map pp_f [0 .. 127]
+  putStrLn (unlines l)
+
+{-
+import Data.Int {- base -}
+import Data.Word {- base -}
+
+int_to_int8 :: Int -> Int8
+int_to_int8 = fromIntegral
+
+int8_to_word8 :: Int8 -> Word8
+int8_to_word8 = fromIntegral
+
+midi_tbl_binary_mnn_cents_tuning_d12 :: FilePath -> (String,T.Cents,Int) -> IO ()
+midi_tbl_binary_mnn_cents_tuning_d12 fn (nm,c,k) = do
+  t <- Scala.scl_load_tuning nm :: IO T.Tuning
+  let tun_f = T.d12_midi_tuning_f (t,c,k)
+      pp_f n = let (mnn,dt) = T.midi_detune_normalise (tun_f n)
+               in [int_to_int8 mnn,int_to_int8 (round dt)]
+  B.writeFile fn (B.pack (map int8_to_word8 (concatMap pp_f [0 .. 127])))
+-}
+
+{-
+> midi_tbl_tuning_d12 "freq" ("meanquar",0,0)
+> midi_tbl_tuning_d12 "fmidi" ("meanquar",0,0)
+> midi_tbl_tuning_d12 "mts" ("young-lm_piano",-74.7,-3)
+-}
+midi_tbl_tuning_d12 :: String -> (String,T.Cents,T.Midi) -> IO ()
+midi_tbl_tuning_d12 typ (nm,c,k) = do
+  t <- Scala.scl_load_tuning nm :: IO T.Tuning
+  let tun_f = T.d12_midi_tuning_f (t,c,k)
+      pp_f n =
+        case typ of
+          "fmidi" -> printf "%3d,%10.6f" n (T.midi_detune_to_fmidi (tun_f n))
+          "freq" -> printf "%3d,%10.4f" n (T.midi_detune_to_cps (tun_f n))
+          "mts" ->
+            let (mnn,dt) = T.midi_detune_normalise_positive (tun_f n)
+            in printf "%3d,%3d,%7.4f" n (mnn `mod` 0x80) dt
+          _ -> error "midi_tbl_tuning_d12"
+  putStr (unlines (map pp_f [0 .. 127]))
+
+ratio_cents_pp :: Rational -> String
+ratio_cents_pp = show . (round :: Double -> Int) . T.ratio_to_cents
+
+-- > intnam_lookup [7/4,7/6,9/8,13/8]
+intnam_lookup :: [Rational] -> IO ()
+intnam_lookup r_sq = do
+  let f db r = let nm = maybe "*Unknown*" snd (Interval.intnam_search_ratio db r)
+               in concat [T.ratio_pp r," = ",nm," = ",ratio_cents_pp r]
+  db <- Interval.load_intnam
+  mapM_ (putStrLn . f db) r_sq
+
+-- > intnam_search "didymus"
+intnam_search :: String -> IO ()
+intnam_search txt = do
+  db <- Interval.load_intnam
+  let f (r,nm) = concat [T.ratio_pp r," = ",nm," = ",ratio_cents_pp r]
+  mapM_ (putStrLn . f) (Interval.intnam_search_description_ci db txt)
+
+kbm_tbl :: String -> String -> String -> IO ()
+kbm_tbl ty scl_nm kbm_nm = do
+  scl <- Scala.scl_load scl_nm
+  kbm <- Kbm.kbm_load kbm_nm
+  let tbl = case ty of
+        "cps" -> Kbm.kbm_cps_tbl kbm scl
+        "fmidi" -> Kbm.kbm_fmidi_tbl kbm scl
+        _ -> error "kbm_tbl: unknown type"
+      fmt (i,j) = printf "%d,%.4f" i j
+      txt = unlines (map fmt tbl)
+  putStrLn txt
+
+-- * Main
+
+help :: [String]
+help =
+    ["cps-tbl md|csv cps name:string f0:real mnn0:int gamut:int mnn-l:int mnn-r:int"
+    ,"cps-tbl md|csv d12 name:string cents:real mnn:int mnn-l:int mnn-r:int"
+    ,"csv-mnd-retune d12 name:string cents:real mnn:int input-file output-file"
+    ,"db stat"
+    ,"db summarise nm-lm|nil dsc-lm|nil"
+    ,"env"
+    ,"fluidsynth d12 scl-name:string cents:real mnn:int fs-name:string fs-bank:int fs-prog:int"
+    ,"intervals {half-matrix|list|matrix} {cents|ratios} scale-name:string"
+    ,"intname lookup interval:rational..."
+    ,"intname search text:string"
+    ,"kbm table {cps | fmidi} scala-name:string kbm-name:string"
+    ,"midi-table fmidi|freq|mts d12 name:string cents:real mnn:int"
+    ,"search scale|mode ci|cs lm|nil text:string..."
+    ,"stat all lm|nil"
+    ,"stat scale lm|nil name:string|file-path"
+    ,""
+    ,"  lm:int = line character limit"]
+
+nil_or_read :: Read a => String -> Maybe a
+nil_or_read s = if s == "nil" then Nothing else Just (T.read_err s)
+
+scala_cli :: [String] -> IO ()
+scala_cli arg = do
+  let usage = putStrLn (unlines help)
+  case arg of
+    ["cps-tbl",fmt,"cps",nm,f0,k,n,l,r] -> cps_tbl_cps fmt (nm,read f0,read k,read n) (read l,read r)
+    ["cps-tbl",fmt,"d12",nm,c,k,l,r] -> cps_tbl_d12 fmt (nm,read c,read k) (read l,read r)
+    ["csv-mnd-retune","d12",nm,c,k,in_fn,out_fn] -> csv_mnd_retune_d12 (nm,read c,read k) in_fn out_fn
+    ["db","stat"] -> db_stat
+    ["db","summarise",nm_lim,dsc_lim] -> db_summarise (nil_or_read nm_lim) (nil_or_read dsc_lim)
+    ["env"] -> env
+    ["fluidsynth","d12",scl_nm,c,k,fs_nm,fs_bank,fs_prog] ->
+        fluidsynth_tuning_d12 (fs_nm,read fs_bank,read fs_prog) (scl_nm,read c,read k)
+    ["intervals","half-matrix",'c':_,k,nm] -> Functions.intervals_half_matrix_cents (read k) nm
+    ["intervals","half-matrix",'r':_,nm] -> Functions.intervals_half_matrix_ratios nm
+    ["intervals","list",'r':_,nm] -> Functions.intervals_list_ratios nm
+    ["intervals","matrix",'c':_,k,nm] -> Functions.intervals_matrix_cents (read k) nm
+    ["intervals","matrix",'r':_,nm] -> Functions.intervals_matrix_ratios nm
+    "intnam":"lookup":r_sq -> intnam_lookup (map T.read_ratio_with_div_err r_sq)
+    ["intnam","search",txt] -> intnam_search txt
+    ["kbm","table",ty,scl_nm,kbm_nm] -> kbm_tbl ty scl_nm kbm_nm
+    ["midi-table",typ,"d12",scl_nm,c,k] -> midi_tbl_tuning_d12 typ (scl_nm,read c,read k)
+    "search":ty:ci:lm:txt ->
+        case ty of
+          "scale" -> search_scale (ci == "ci",nil_or_read lm) txt
+          "mode" -> search_mode (ci == "ci",nil_or_read lm) txt
+          _ -> usage
+    ["stat","all",lm] -> stat_all (nil_or_read lm)
+    ["stat","scale",lm,nm] -> stat_by_name (nil_or_read lm) nm
+    _ -> usage
diff --git a/Music/Theory/Tuning/Scala/Functions.hs b/Music/Theory/Tuning/Scala/Functions.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Scala/Functions.hs
@@ -0,0 +1,123 @@
+-- | Scala functions, <http://www.huygens-fokker.org/scala/help.htm>
+module Music.Theory.Tuning.Scala.Functions where
+
+import Data.List {- base -}
+
+import qualified Music.Theory.Array.Text as Text {- hmt -}
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Math as Math {- hmt -}
+import qualified Music.Theory.Show as Show {- hmt -}
+import qualified Music.Theory.Tuning as Tuning {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
+import qualified Music.Theory.Tuning.Scala.Interval as Interval {- hmt -}
+
+{- | <http://www.huygens-fokker.org/scala/help.htm#EQUALTEMP>
+
+> map round (equaltemp 12 2 13) == [0,100,200,300,400,500,600,700,800,900,1000,1100,1200]
+> map round (equaltemp 13 3 14) == [0,146,293,439,585,732,878,1024,1170,1317,1463,1609,1756,1902]
+> map round (equaltemp 12.5 3 14) == [0,152,304,456,609,761,913,1065,1217,1369,1522,1674,1826,1978]
+-}
+equaltemp :: Double -> Double -> Int -> [Double]
+equaltemp division octave scale_size =
+  let step = Tuning.fratio_to_cents octave / division
+  in take scale_size [0,step ..]
+
+{- | <http://www.huygens-fokker.org/scala/help.htm#LINEARTEMP>
+
+> let py = lineartemp 12 2 () (3/2 :: Rational) 3
+> py == [1/1,2187/2048,9/8,32/27,81/64,4/3,729/512,3/2,6561/4096,27/16,16/9,243/128,2/1]
+-}
+lineartemp :: (Fractional n, Ord n) => Int -> n -> () -> n -> Int -> [n]
+lineartemp scale_size octave _degree_of_fifth fifth down =
+  let geom i m = i : geom (i * m) m
+      geom_oct i = map Tuning.fold_ratio_to_octave_err . geom i
+      lhs = take (down + 1) (geom_oct 1 (1 / fifth))
+      rhs = tail (take (scale_size - down) (geom_oct 1 fifth))
+  in sort (lhs ++ rhs) ++ [octave]
+
+-- * INTERVALS
+
+interval_hist_ratios :: (Fractional t,Ord t) => [t] -> [(t,Int)]
+interval_hist_ratios x = List.histogram [(if p < q then p * 2 else p) / q | p <- x, q <- x, p /= q]
+
+intervals_list_ratios_r :: Interval.INTNAM -> [Rational] -> IO ()
+intervals_list_ratios_r nam_db rat = do
+  let hst = interval_hist_ratios rat
+      ln (r,n) = let nm = maybe "" snd (Interval.intnam_search_ratio nam_db r)
+                     c = Tuning.ratio_to_cents r
+                     i = Math.real_round_int (c / 100)
+                 in [show i,show n,Show.ratio_pp r,Show.real_pp 1 c,nm]
+      tbl = map ln hst
+      pp = Text.table_pp Text.table_opt_plain
+  putStrLn (unlines (pp tbl))
+
+{- | <http://www.huygens-fokker.org/scala/help.htm#SHOW_INTERVALS>
+
+> mapM_ intervals_list_ratios (words "pyth_12 kepler1")
+-}
+intervals_list_ratios :: String -> IO ()
+intervals_list_ratios scl_nm = do
+  nam_db <- Interval.load_intnam
+  scl <- Scala.scl_load scl_nm
+  intervals_list_ratios_r nam_db (tail (Scala.scale_ratios_req scl))
+
+-- * INTERVALS
+
+-- | Given interval function (ie. '-' or '/') and scale generate interval half-matrix.
+interval_half_matrix :: (t -> t -> u) -> [t] -> [[u]]
+interval_half_matrix interval_f =
+  let tails' = filter ((>= 2) . length) . tails
+      f l = case l of
+              [] -> []
+              i : l' -> map (`interval_f` i) l'
+  in map f . tails'
+
+interval_half_matrix_tbl :: (t -> String) -> (t -> t -> t) -> [t] -> [[String]]
+interval_half_matrix_tbl show_f interval_f scl =
+    let f n l = replicate n "" ++ map show_f l
+    in zipWith f [1..] (interval_half_matrix interval_f scl)
+
+intervals_half_matrix :: (Scala.Scale -> [t]) -> (t -> t -> t) -> (t -> String) -> String -> IO ()
+intervals_half_matrix scl_f interval_f show_f nm = do
+  scl <- Scala.scl_load nm
+  let txt = interval_half_matrix_tbl show_f interval_f (scl_f scl)
+      pp = Text.table_pp Text.table_opt_plain
+  putStrLn (unlines (pp txt))
+
+-- > mapM_ (intervals_half_matrix_cents 0) (words "pyth_12 kepler1")
+intervals_half_matrix_cents :: Int -> String -> IO ()
+intervals_half_matrix_cents k = intervals_half_matrix Scala.scale_cents (-) (Show.real_pp k)
+
+-- > mapM_ (intervals_half_matrix_ratios) (words "pyth_12 kepler1")
+intervals_half_matrix_ratios :: String -> IO ()
+intervals_half_matrix_ratios = intervals_half_matrix Scala.scale_ratios_req (/) Show.ratio_pp
+
+{-
+> r = [3*5,3*7,3*11,5*7,5*11,7*11]
+> r = let u = [1,3,5,7,9,11] in [i*j*k | i <- u, j <- u, k <- u, i < j, j < k]
+> intervals_matrix_wr Show.ratio_pp (interval_matrix_ratio r)
+-}
+interval_matrix_ratio :: [Rational] -> [[Rational]]
+interval_matrix_ratio x = let f i = map (\j -> if j < i then j * 2 / i else j / i) x in map f x
+
+interval_matrix_cents :: [Tuning.Cents] -> [[Tuning.Cents]]
+interval_matrix_cents x = let f i = map (\j -> if j < i then j + 1200 - i else j - i) x in map f x
+
+intervals_matrix_wr :: (t -> String) -> [[t]] -> IO ()
+intervals_matrix_wr pp_f x = do
+  let txt = map (map pp_f) x
+      pp = Text.table_pp Text.table_opt_plain
+  putStrLn (unlines (pp txt))
+
+intervals_matrix :: (Scala.Scale -> [t]) -> ([t] -> [[t]]) -> (t -> String) -> String -> IO ()
+intervals_matrix scl_f tbl_f pp_f nm = do
+  scl <- Scala.scl_load nm
+  intervals_matrix_wr pp_f (tbl_f (scl_f scl))
+
+-- > mapM_ (intervals_matrix_cents 0) (words "pyth_12 kepler1")
+intervals_matrix_cents :: Int -> String -> IO ()
+intervals_matrix_cents k = intervals_matrix Scala.scale_cents interval_matrix_cents (Show.real_pp k)
+
+-- > mapM_ intervals_matrix_ratios (words "pyth_12 kepler1")
+intervals_matrix_ratios :: String -> IO ()
+intervals_matrix_ratios = intervals_matrix Scala.scale_ratios_req interval_matrix_ratio Show.ratio_pp
diff --git a/Music/Theory/Tuning/Scala/Interval.hs b/Music/Theory/Tuning/Scala/Interval.hs
--- a/Music/Theory/Tuning/Scala/Interval.hs
+++ b/Music/Theory/Tuning/Scala/Interval.hs
@@ -1,11 +1,12 @@
--- | Parser for the @intnam.par@ file.
+-- | Parser for the SCALA @intnam.par@ file.
 module Music.Theory.Tuning.Scala.Interval where
 
 import Data.Char {- base -}
 import Data.List {- base -}
+import Data.Maybe {- base -}
 
-import qualified Music.Theory.Read as T {- hmt -}
-import qualified Music.Theory.Tuning.Scala as T
+import qualified Music.Theory.Read as Read {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
 
 -- | Interval and name, ie. (3/2,"perfect fifth")
 type INTERVAL = (Rational,String)
@@ -13,21 +14,39 @@
 -- | Length prefixed list of 'INTERVAL'.
 type INTNAM = (Int,[INTERVAL])
 
--- | Lookup ratio in 'INTNAM'.
---
--- > db <- load_intnam
--- > intnam_search_ratio db (3/2) == Just (3/2,"perfect fifth")
--- > intnam_search_ratio db (2/3) == Nothing
--- > intnam_search_ratio db (4/3) == Just (4/3,"perfect fourth")
--- > map (intnam_search_ratio db) [3/2,4/3,7/4,7/6,9/7,12/7,14/9]
--- > intnam_search_ratio db (31/16) == Just (31/16,"31st harmonic")
+{- | Lookup ratio in 'INTNAM'.
+
+> db <- load_intnam
+> intnam_search_ratio db (3/2) == Just (3/2,"perfect fifth")
+> intnam_search_ratio db (2/3) == Nothing
+> intnam_search_ratio db (4/3) == Just (4/3,"perfect fourth")
+> intnam_search_ratio db (31/16) == Just (31/16,"=31st harmonic")
+> intnam_search_ratio db (64/49) == Just (64 % 49,"=2 septatones or septatonic major third")
+> map (intnam_search_ratio db) [3/2,4/3,7/4,7/6,9/7,9/8,12/7,14/9]
+> import Data.Maybe {- base -}
+> mapMaybe (intnam_search_ratio db) [567/512,147/128,21/16,1323/1024,189/128,49/32,441/256,63/32]
+-}
 intnam_search_ratio :: INTNAM -> Rational -> Maybe INTERVAL
 intnam_search_ratio (_,i) x = find ((== x) . fst) i
 
+{- | Lookup approximate ratio in 'INTNAM' given espilon.
+
+> r = [Just (3/2,"perfect fifth"),Just (64/49,"=2 septatones or septatonic major third")]
+> map (intnam_search_fratio 0.0001 db) [1.5,1.3061] == r
+-}
+intnam_search_fratio :: (Fractional n,Ord n) => n -> INTNAM -> n -> Maybe INTERVAL
+intnam_search_fratio epsilon (_,i) x =
+  let near p q = abs (p - q) < epsilon
+  in find (near x . fromRational . fst) i
+
+-- | Lookup name of interval, or error.
+intnam_search_ratio_name_err :: INTNAM -> Rational -> String
+intnam_search_ratio_name_err db = snd . fromJust . intnam_search_ratio db
+
 -- | Lookup interval name in 'INTNAM', ci = case-insensitive.
 --
 -- > db <- load_intnam
--- > intnam_search_description_ci db "didymus"
+-- > intnam_search_description_ci db "didymus" == [(81/80,"syntonic comma, Didymus comma")]
 intnam_search_description_ci :: INTNAM -> String -> [INTERVAL]
 intnam_search_description_ci (_,i) x =
     let downcase = map toLower
@@ -36,27 +55,32 @@
 
 -- * Parser
 
-parse_intnam_entry :: [String] -> INTERVAL
-parse_intnam_entry w =
-    case w of
-      r:w' -> (T.read_ratio_with_div_err r,unwords w')
+-- | Parse line from intnam.par
+parse_intnam_entry :: String -> INTERVAL
+parse_intnam_entry str =
+    case words str of
+      r:w -> (Read.read_ratio_with_div_err r,unwords w)
       _ -> error "parse_intnam_entry"
 
+-- | Parse non-comment lines from intnam.par
 parse_intnam :: [String] -> INTNAM
 parse_intnam l =
     case l of
       _:n:i -> let n' = read n :: Int
-                   i' = map (parse_intnam_entry . words) i
+                   i' = map parse_intnam_entry i
                in if n' == length i' then (n',i') else error "parse_intnam"
       _ -> error "parse_intnam"
 
 -- * IO
 
--- | 'parse_intnam' of 'T.load_dist_file' of "intnam.par".
---
--- > intnam <- load_intnam
--- > fst intnam == length (snd intnam)
+{- | 'parse_intnam' of 'Scala.load_dist_file_ln' of "intnam.par".
+
+> intnam <- load_intnam
+> fst intnam == 516 -- Scala 2.42p
+> fst intnam == length (snd intnam)
+> lookup (129140163/128000000) (snd intnam) == Just "gravity comma"
+-}
 load_intnam :: IO INTNAM
 load_intnam = do
-  l <- T.load_dist_file "intnam.par"
-  return (parse_intnam (T.filter_comments l))
+  l <- Scala.load_dist_file_ln "intnam.par"
+  return (parse_intnam (Scala.filter_comments l))
diff --git a/Music/Theory/Tuning/Scala/Kbm.hs b/Music/Theory/Tuning/Scala/Kbm.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Scala/Kbm.hs
@@ -0,0 +1,217 @@
+{- | Scala "keyboard mapping" files (.kbm) and related data structure.
+
+<http://www.huygens-fokker.org/scala/help.htm#mappings>
+-}
+module Music.Theory.Tuning.Scala.Kbm where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import System.FilePath {- filepath -}
+import Text.Printf {- base -}
+
+import qualified Music.Theory.Directory as Directory {- hmt -}
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Pitch as Pitch {- hmt -}
+import qualified Music.Theory.Tuning as Tuning {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
+
+{- | Scala keyboard mapping
+
+(sz,(m0,mN),mC,(mF,f),o,m)
+
+- sz      = size of map, the pattern repeats every so many keys
+- (m0,mN) = the first and last midi note numbers to retune
+- mC      = the middle note where the first entry of the mapping is mapped to
+- (mF,f)  = the reference midi-note for which a frequency is given, ie. (69,440)
+- o       = scale degree to consider as formal octave
+- m       = mapping, numbers represent scale degrees mapped to keys, Nothing indicates no mapping
+
+-}
+type Kbm = (Int,(Int,Int),Int,(Int,Double),Int,[Maybe Int])
+
+-- | Pretty-printer for scala .kbm file.
+kbm_pp :: Kbm -> String
+kbm_pp (sz,(m0,mN),mC,(mF,f),o,m) =
+  unlines
+  [printf "size = %d" sz
+  ,printf "note-range = (%d,%d)" m0 mN
+  ,printf "note-center = %d" mC
+  ,printf "note-reference = (%d,%f)" mF f
+  ,printf "formal-octave = %d" o
+  ,printf "map = [%s] #%d" (intercalate "," (map (maybe "x" show) m)) (length m)]
+
+-- | Is /mnn/ in range?
+kbm_in_rng :: Kbm -> Int -> Bool
+kbm_in_rng (_,(m0,mN),_,_,_,_) mnn = mnn >= m0 && mnn <= mN
+
+-- | Is /kbm/ linear?, ie. is size zero? (formal-octave may or may not be zero)
+kbm_is_linear :: Kbm -> Bool
+kbm_is_linear (sz,_,_,_,_o,_) = sz == 0 -- && o == 0
+
+{- | Given kbm and midi-note-number lookup (octave,scale-degree).
+
+> k <- kbm_load_dist "example.kbm" -- 12-tone scale
+> k <- kbm_load_dist "a440.kbm" -- linear
+> k <- kbm_load_dist "white.kbm" -- 7-tone scale on white notes
+> k <- kbm_load_dist "black.kbm" -- 5-tone scale on black notes
+> k <- kbm_load_dist "128.kbm"
+
+> map (kbm_lookup k) [48 .. 72]
+
+-}
+kbm_lookup :: Kbm -> Int -> Maybe (Int,Int)
+kbm_lookup kbm mnn =
+  if not (kbm_in_rng kbm mnn)
+  then Nothing
+  else if kbm_is_linear kbm
+       then Just (0,mnn)
+       else let (sz,(_m0,_mN),mC,(_mF,_f),_o,m) = kbm
+                (oct,ix) = ((mnn - mC) `divMod` sz)
+            in fmap (\dgr -> (oct,dgr)) (m !! ix)
+
+-- | Return the triple (mF,kbm_lookup k mF,f).  The lookup for mF is not-nil by definition.
+--
+-- > kbm_lookup_mF k
+kbm_lookup_mF :: Kbm -> (Int,(Int,Int),Double)
+kbm_lookup_mF k@(_,_,_,(mF,f),_,_) =
+  case kbm_lookup k mF of
+    Nothing -> error "kbm_lookup_mF?"
+    Just r -> (mF,r,f)
+
+-- | Parser for scala .kbm file.
+kbm_parse :: String -> Kbm
+kbm_parse s =
+  let f x = case x of
+              "x" -> Nothing
+              _ -> Just (read x)
+      to_m sz = List.pad_right_no_truncate Nothing sz . map f -- _err -- some scala .kbm have |m| > sz?
+  in case Scala.filter_comments (lines s) of
+       i1:i2:i3:i4:i5:d1:i6:m ->
+         let sz = read i1
+         in (sz,(read i2,read i3),read i4,(read i5,read d1),read i6,to_m sz m)
+       _ -> error "kbm_parse?"
+
+-- | 'kbm_parse' of 'readFile'
+kbm_load_file :: FilePath -> IO Kbm
+kbm_load_file = fmap kbm_parse . readFile
+
+{- | 'kbm_parse' of 'Scala.load_dist_file'
+
+> pp nm = kbm_load_dist nm >>= \x -> putStrLn (kbm_pp x)
+> pp "example"
+> pp "bp"
+> pp "7" -- error -- 12/#13
+> pp "8" -- error -- 12/#13
+> pp "white" -- error -- 12/#13
+> pp "black" -- error -- 12/#13
+> pp "128"
+> pp "a440"
+> pp "61"
+-}
+kbm_load_dist :: String -> IO Kbm
+kbm_load_dist nm = fmap kbm_parse (Scala.load_dist_file (nm <.> "kbm"))
+
+-- | If /nm/ is a file name (has a .kbm) extension run 'kbm_load_file' else run 'kbm_load_dist'.
+kbm_load :: String -> IO Kbm
+kbm_load nm = if hasExtension nm then kbm_load_file nm else kbm_load_dist nm
+
+-- | Load all .kbm files at directory.
+kbm_load_dir_fn :: FilePath -> IO [(FilePath, Kbm)]
+kbm_load_dir_fn d = do
+  fn <- Directory.dir_subset [".kbm"] d
+  kbm <- mapM kbm_load fn
+  return (zip fn kbm)
+
+{- | Load all .kbm files at scala dist dir.
+
+> db <- kbm_load_dist_dir_fn
+> length db == 41
+> x = map (\(fn,(sz,_,_,_,o,m)) -> (System.FilePath.takeFileName fn,sz,length m,o)) db
+> filter (\(_,i,j,_) -> i < j) x -- size < map-length
+> filter (\(_,i,_,k) -> i == 0 && k == 0) x -- size and formal octave both zero
+
+> map (\(fn,k) -> (System.FilePath.takeFileName fn,kbm_lookup_mF k)) db
+-}
+kbm_load_dist_dir_fn :: IO [(FilePath, Kbm)]
+kbm_load_dist_dir_fn = Scala.dist_get_dir >>= kbm_load_dir_fn
+
+{- | Pretty-printer for scala .kbm file.
+
+> m <- kbm_load_dist "7.kbm"
+> kbm_parse (kbm_format m) == m
+> putStrLn $ kbm_pp m
+-}
+kbm_format :: Kbm -> String
+kbm_format (i1,(i2,i3),i4,(i5,d1),i6,m) =
+  let from_m = map (maybe "x" show)
+  in unlines ([show i1,show i2,show i3,show i4,show i5,show d1,show i6] ++ from_m m)
+
+-- | 'writeFile' of 'kbm_format'
+kbm_wr :: FilePath -> Kbm -> IO ()
+kbm_wr fn = writeFile fn . kbm_format
+
+{- | Standard 12-tone mapping with A=440hz (ie. example.kbm)
+
+> fmap (== kbm_d12_a440) (kbm_load_dist "example.kbm")
+> putStrLn $ kbm_pp kbm_d12_a440
+-}
+kbm_d12_a440 :: Kbm
+kbm_d12_a440 = (12,(0,127),60,(69,440.0),12,map Just [0 .. 11])
+
+kbm_d12_c256 :: Kbm
+kbm_d12_c256 = (12,(0,127),60,(60,256.0),12,map Just [0 .. 11])
+
+-- | Given size and note-center calculate relative octave and key
+--   number (not scale degree) of the zero entry.
+--
+-- > map (kbm_k0 12) [59,60,61] == [(-4,1),(-5,0),(-5,11)]
+kbm_k0 :: Int -> Int -> (Int,Int)
+kbm_k0 sz mC = let (o,r) = mC `quotRem` sz in (negate o,negate r `mod` sz)
+
+-- | Given size and note-center calculate complete octave and key
+-- number sequence (ie. for entries 0 - 127).
+--
+-- > map (zip [0..] . kbm_oct_key_seq 12) [59,60,61]
+kbm_oct_key_seq :: Kbm -> [(Int,(Int,Int))]
+kbm_oct_key_seq (sz,(m0,mN),mC,(_mF,_f),_o,_m) =
+  let (o0,k0) = kbm_k0 sz mC
+      dgr = map (`mod` sz) (take 128 [k0 ..])
+      upd o j = if j == 0 then (o + 1,(o + 1,j)) else (o,(o,j))
+      key_seq = snd (mapAccumL upd (o0 - 1) dgr)
+  in zip [m0 .. ] (take (mN - m0 + 1) (drop m0 key_seq))
+
+-- | Given Kbm and SCL calculate frequency of note-center.
+kbm_mC_freq :: Kbm -> Scala.Scale -> Double
+kbm_mC_freq (sz,(_m0,_mN),mC,(mF,f),_o,m) scl =
+  let dist_k = (mF - mC) `mod` sz
+      dgr = fromMaybe (error "kbm_mC_freq") (m !! dist_k)
+      c = Scala.scale_cents scl !! dgr
+  in Tuning.cps_shift_cents f (- c)
+
+-- | Given Kbm and SCL calculate fractional midi note-numbers for each key.
+kbm_fmidi_tbl :: Kbm -> Scala.Scale -> [(Int, Double)]
+kbm_fmidi_tbl kbm scl =
+  let (_sz,(_m0,_mN),_mC,(_mF,_f),o,m) = kbm
+      mC_freq = kbm_mC_freq kbm scl
+      mC_fmidi = Pitch.cps_to_fmidi mC_freq
+      key_seq = kbm_oct_key_seq kbm
+      c = Scala.scale_cents scl
+      oct_cents = c !! o
+      oct_key_to_cents (oct,key) = maybe 0 (c !!) (m !! key) + (fromIntegral oct * oct_cents)
+  in map (\(mnn,oct_key) -> (mnn,mC_fmidi + (oct_key_to_cents oct_key / 100.0))) key_seq
+
+-- | Given Kbm and SCL calculate frequencies for each key.
+kbm_cps_tbl :: Kbm -> Scala.Scale -> [(Int, Double)]
+kbm_cps_tbl kbm = let f (k,n) = (k,Tuning.fmidi_to_cps n) in map f . kbm_fmidi_tbl kbm
+
+{-
+
+scl <- Scala.scl_load "young-lm_piano"
+scl <- Scala.scl_load "meanquar"
+scl <- Scala.scl_load "et12"
+kbm <- kbm_load "example" -- d12_a440 -- kbm_d12_a440 kbm_d12_c256
+
+kbm_fmidi_tbl kbm scl
+kbm_cps_tbl kbm scl
+
+-}
diff --git a/Music/Theory/Tuning/Scala/Meta.hs b/Music/Theory/Tuning/Scala/Meta.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Scala/Meta.hs
@@ -0,0 +1,196 @@
+-- | Scala DB meta-data.
+module Music.Theory.Tuning.Scala.Meta where
+
+-- | Just-intonation (ie. all rational) scales, collected by author.
+scl_ji_au :: [(String,[String])]
+scl_ji_au =
+  [("Alves, Bill",words "alves_12 alves_22 alves_pelog alves alves_slendro")
+  ,("Archytas"
+   ,["arch_chrom","arch_chromc2" -- "archchro" NON-JI
+    ,"arch_dor"
+    ,"arch_enh","arch_enh2","arch_enh3","arch_enhp"
+    ,"arch_enht","arch_enht2","arch_enht3","arch_enht4","arch_enht5","arch_enht6","arch_enht7"
+    ,"arch_mult"
+    ,"arch_ptol","arch_ptol2"
+    ,"arch_sept"
+    -- "archytas7" "archytas12","archytas12sync" NON-JI
+    ])
+  ,("Barlow, Clarence",words "barlow_13 barlow_17")
+  ,("Boethius",words "boeth_chrom boeth_enh")
+  ,("Burt, Warren",
+     concat [map (\n -> "burt" ++ show n) [1::Int .. 20]
+            ,words "burt_fibo burt_fibo23 burt_forks burt_primes"])
+  ,("Chalmers, John"
+   ,["chalmers"
+    ,"chalmers_17"
+    ,"chalmers_19"
+    ,"chalmers_ji1"
+    ,"chalmers_ji2"
+    ,"chalmers_ji3"
+    ,"chalmers_ji4"
+    ,"corner7"
+    ,"corner11"
+    ,"corner13"
+    ,"corners7"
+    ,"corners11"
+    ,"corners13"
+    ,"finnamore_jc"
+    ,"hamilton_jc"
+    ,"major_clus"
+    ,"major_wing"
+    ,"minor_clus"
+    ,"minor_wing"
+    ,"pelog_jc"
+    ,"prod7d"
+    ,"prodq13"
+    ,"slen_pel_jc"])
+  ,("Didymus", words "didy_chrom didy_chrom1 didy_chrom2 didy_chrom3 didy_diat didy_enh didy_enh2")
+  ,("Eratosthenes",words "eratos_chrom eratos_diat eratos_enh")
+  ,("Euler, Leonhard",words "euler euler_diat euler_enh euler_gm")
+  ,("Gann, Kyle",words "gann_arcana gann_charingcross gann_cinderella gann_custer gann_fractured gann_fugitive gann_ghost gann_love gann_new_aunts gann_revisited gann_sitting gann_solitaire gann_suntune gann_super gann_things gann_wolfe hulen_33")
+  ,("Grady, Kraig"
+   ,["dekany-cs"
+    ,"grady11"
+    ,"grady_14"
+    ,"grady_centaur"
+    ,"grady_centaur17"
+    ,"grady_centaur19"])
+  ,("Hahn, Paul",words "duohex hahn_7 hahn9 hahnmaxr indian-hahn") -- hahn_g mean14a
+  ,("Harrison, Lou"
+   ,["dudon_slendro_matrix" -- NON-UNIQ
+    ,"harrison_5"
+    ,"harrison_5_1"
+    ,"harrison_5_3" -- NON-STEP
+    ,"harrison_5_4" -- NON-STEP
+    ,"harrison_8" -- NON-STEP
+    ,"harrison_15"
+    ,"harrison_16"
+    ,"harrison_bill"
+    ,"harrison_cinna"
+    ,"harrison_diat"
+    ,"harrison_handel"
+    ,"harrison_kyai" -- NON-STEP
+    ,"harrison_mid"
+    ,"harrison_mid2"
+    ,"harrison_mix2"
+    ,"harrison_mix3" -- NON-STEP
+    ,"harrison_mix4"
+    ,"harrison_slye"
+    ,"harrison_songs"
+    ,"hexany10"
+    ,"hirajoshi2"
+    ,"korea_5"
+    ,"olympos"
+    ,"pelog_jc" -- STRICT SONGS
+    ,"pelog_laras" -- NON-STEP
+    ,"prime_5"
+    ,"slendro5_1","slendro5_2"
+    ,"slendro_7_1","slendro_7_2","slendro_7_3","slendro_7_4"
+    -- "slendro_laras" -- NON-OCT
+    ,"tranh"])
+  ,("Johnston, Ben"
+   ,["johnston"
+    ,"johnston_21"
+    ,"johnston_22"
+    ,"johnston_25"
+    ,"johnston_81"
+    ,"johnston_6-qt"
+    ,"johnston_6-qt_row"])
+  ,("Kepler, Johannes",words "kepler1 kepler2 kepler3")
+  ,("Partch, Harry"
+   ,["kring1"
+    ,"diamond7"
+    ,"diamond9"
+    ,"diamond17b"
+    ,"novaro15"
+    ,"partch_29-av"
+    ,"partch_29"
+    ,"partch_37"
+    ,"partch_39"
+    ,"partch_41"
+    ,"partch_43"
+    ,"partch-barstow"])
+  ,("Ptolemy"
+   ,["ptolemy_chrom"
+    ,"ptolemy_ddiat"
+    ,"ptolemy_diat","ptolemy_diat2","ptolemy_diat3","ptolemy_diat4","ptolemy_diat5"
+    ,"ptolemy_diff"
+    ,"ptolemy_enh"
+    ,"ptolemy_exp"
+    ,"ptolemy_ext"
+    ,"ptolemy_hominv","ptolemy_hominv2"
+    ,"ptolemy_hom"
+    ,"ptolemy_iastaiol","ptolemy_iast"
+    ,"ptolemy_ichrom"
+    ,"ptolemy_idiat"
+    ,"ptolemy_imix"
+    ,"ptolemy_malak","ptolemy_malak2"
+    ,"ptolemy_mdiat","ptolemy_mdiat2","ptolemy_mdiat3"
+    ,"ptolemy_meta"
+    ,"ptolemy_mix"
+    ,"ptolemy_perm"
+    ,"ptolemy_prod"
+    ,"ptolemy"
+    ,"ptolemy_tree"])
+  ,("Pythagoras"
+   ,["pyth_7a","pyth_12","pyth_12s","pyth_17","pyth_17s","pyth_22","pyth_27","pyth_chrom"
+    -- "pyth_31" "pyth_sev" "pyth_third" NOT-JI
+    ])
+  ,("Riley, Terry",words "riley_albion riley_rosary")
+  ,("Smith, Gene Ward",["smithgw_15highschool1","smithgw_15highschool2","smithgw_18","smithgw_19highschool1","smithgw_19highschool2","smithgw_21","smithgw_22highschool","smithgw_58","smithgw_9","smithgw_ball","smithgw_ball2","smithgw_circu","smithgw_decab","smithgw_decac","smithgw_decad","smithgw_diff13","smithgw_dwarf6_7","smithgw_ennon13","smithgw_ennon15","smithgw_ennon28","smithgw_ennon43","smithgw_euclid3","smithgw_glamma","smithgw_glumma","smithgw_gm","smithgw_hahn12","smithgw_hahn15","smithgw_hahn16","smithgw_hahn19","smithgw_hahn22","smithgw_indianred","smithgw_majraj1","smithgw_majraj2","smithgw_majraj3","smithgw_majsyn1","smithgw_majsyn2","smithgw_majsyn3","smithgw_meandin","smithgw_meanred","smithgw_mir22","smithgw_monzoblock37","smithgw_orw18r","smithgw_pel1","smithgw_pel3","smithgw_pris","smithgw_prisa","smithgw_ragasyn1","smithgw_ratwell","smithgw_rectoo","smithgw_red72_11geo","smithgw_red72_11pro","smithgw_sc19","smithgw_scj22a","smithgw_scj22b","smithgw_scj22c","smithgw_smalldi11","smithgw_smalldi19a","smithgw_smalldi19b","smithgw_smalldi19c","smithgw_star","smithgw_star2","smithgw_syndia2","smithgw_syndia3","smithgw_syndia4","smithgw_syndia6","smithgw_well1","smithgw_wiz28","smithgw_wiz34","smithgw_wiz38"])
+  ,("Tenney, James",words "mund45 tenney_8 tenney_11 tenn41a tenn41b tenn41c")
+  ,("Wilson, Erv"
+   ,["chin_7"
+    ,"ckring9"
+    ,"diamond7-13"
+    ,"dodeceny","dorian_diat2inv","hypol_diatinv"
+    ,"dkring3"
+    ,"efg33357","efg3335711","efg35711"
+    ,"eikosany"
+    ,"erlich9"
+    ,"harm6","harm8","harm9","harm14","harm15"
+    ,"hexany_union"
+    ,"indian-magrama"
+    ,"malkauns"
+    ,"malcolme"
+    ,"novaro15"
+    ,"partch_29"
+    ,"ptolemy","ptolemy_diat2","ptolemy_idiat"
+    ,"slendro5_1","slendro5_2","slendro_7_4"
+    ,"steldek1","steldek1s","steldek2","steldek2s"
+    ,"steldia"
+    ,"steleik1","steleik1s","steleik2","steleik2s"
+    ,"stelhex1","stelhex2","stelhex5","stelhex6" -- stelhex3 stelhex4
+    ,"stelpd1","stelpd1s"
+    ,"stelpent1","stelpent1s"
+    ,"steltet1","steltet1s","steltet2"
+    ,"steltri1","steltri2"
+    ,"tritriad14"
+    ,"wilson1","wilson2","wilson3","wilson5","wilson7","wilson11"
+    ,"wilson7_2","wilson7_3","wilson7_4"
+    ,"wilson_17","wilson_31","wilson_41"
+    ,"wilcent17"
+    ,"wilson_alessandro"
+    ,"wilson_bag"
+    ,"wilson_class"
+    ,"wilson_dia1","wilson_dia2","wilson_dia3","wilson_dia4"
+    ,"wilson_duo"
+    ,"wilson_enh","wilson_enh2"
+    ,"wilson_facet"
+    -- ,"wilson_gh1","wilson_gh2","wilson_gh11","wilson_gh50" -- NON-JI
+    ,"wilson_hebdome1"
+    ,"wilson_hexflank"
+    ,"wilson_hypenh"
+    ,"wilson-rastbayyati24"
+    ,"wilson_l1","wilson_l2","wilson_l3","wilson_l4","wilson_l5","wilson_l6"])
+  ,("Young, La Monte",["young-lm_guitar","young-lm_piano"])
+  ]
+
+{-
+import Music.Theory.Tuning.Scala
+db <- scl_load_db
+nm = concatMap snd scl_ji_au
+scl = filter (\x -> scale_name x `elem` nm) db
+non_ji = filter (not . scl_is_ji) scl
+map scale_name non_ji
+-}
diff --git a/Music/Theory/Tuning/Scala/Mode.hs b/Music/Theory/Tuning/Scala/Mode.hs
--- a/Music/Theory/Tuning/Scala/Mode.hs
+++ b/Music/Theory/Tuning/Scala/Mode.hs
@@ -1,37 +1,69 @@
--- | Parser for the @modename.par@ file.
+{- | Parser for the @modename.par@ file.
+
+The terminology here is:
+
+- a mode is a subset of the notes of a tuning system (which in scala is called a scale)
+
+- the length (or degree) of the mode is the number of tones in the mode
+
+- the universe (or scale) of the mode is the number of tones in the
+  tuning system (or scale) the mode is a subset of
+
+-}
 module Music.Theory.Tuning.Scala.Mode where
 
 import Data.Char {- base -}
 import Data.List {- base -}
 import Data.Maybe {- base -}
 
-import qualified Music.Theory.Function as T
-import qualified Music.Theory.List as T
-import qualified Music.Theory.Tuning.Scala as T
+import qualified Music.Theory.Function as Function {- hmt -}
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
 
--- | (start-degree,intervals,description)
-type MODE = (Int,[Int],String)
+-- | (mode-start-degree,mode-intervals,mode-description)
+type Mode = (Int,[Int],String)
 
-mode_starting_degree :: MODE -> Int
+-- | Starting degree of mode in underlying scale.  If non-zero the
+-- mode will not lie within an ordinary octave of the tuning.
+mode_starting_degree :: Mode -> Int
 mode_starting_degree (d,_,_) = d
 
-mode_intervals :: MODE -> [Int]
+-- | Intervals (in steps) between adjacent elements of the mode.
+mode_intervals :: Mode -> [Int]
 mode_intervals (_,i,_) = i
 
-mode_description :: MODE -> String
+-- | Interval set of mode (ie. 'nub' of 'sort' of 'mode_intervals')
+mode_iset :: Mode -> [Int]
+mode_iset = nub . sort . mode_intervals
+
+-- | Histogram ('List.histogram') of 'mode_intervals'
+mode_histogram :: Mode -> [(Int, Int)]
+mode_histogram = List.histogram . mode_intervals
+
+-- | The text description of the mode, ordinarily a comma separated list of names.
+mode_description :: Mode -> String
 mode_description (_,_,d) = d
 
-mode_degree :: MODE -> Int
-mode_degree = sum . mode_intervals
+-- | 'length' (or degree) of 'mode_intervals' (ie. number of notes in mode)
+mode_length :: Mode -> Int
+mode_length = length . mode_intervals
 
--- | (mode-count,_,mode-list)
-type MODENAM = (Int,Int,[MODE])
+-- | 'sum' of 'mode_intervals' (ie. number of notes in tuning system)
+mode_univ :: Mode -> Int
+mode_univ = sum . mode_intervals
 
-modenam_modes :: MODENAM -> [MODE]
+-- | 'List.dx_d' of 'mode_intervals'.  This seqence includes the octave.
+mode_degree_seq :: Mode -> [Int]
+mode_degree_seq = List.dx_d 0 . mode_intervals
+
+-- | (mode-count,mode-length-maxima,mode-list)
+type ModeNam = (Int,Int,[Mode])
+
+modenam_modes :: ModeNam -> [Mode]
 modenam_modes (_,_,m) = m
 
 -- | Search for mode by interval list.
-modenam_search_seq :: MODENAM -> [Int] -> [MODE]
+modenam_search_seq :: ModeNam -> [Int] -> [Mode]
 modenam_search_seq (_,_,m) x = filter ((== x) . mode_intervals) m
 
 -- | Expect /one/ result.
@@ -45,23 +77,49 @@
 -- > sq [1,2,1,2,1,2,1,2]
 -- > sq [2,1,2,1,2,1,2,1]
 -- > sq (replicate 12 1)
-modenam_search_seq1 :: MODENAM -> [Int] -> Maybe MODE
-modenam_search_seq1 mn = T.unlist1 . modenam_search_seq mn
+modenam_search_seq1 :: ModeNam -> [Int] -> Maybe Mode
+modenam_search_seq1 mn = List.unlist1 . modenam_search_seq mn
 
 -- | Search for mode by description text.
 --
 -- > map (modenam_search_description mn) ["Messiaen","Xenakis","Raga"]
-modenam_search_description :: MODENAM -> String -> [MODE]
+modenam_search_description :: ModeNam -> String -> [Mode]
 modenam_search_description (_,_,m) x = filter (isInfixOf x . mode_description) m
 
--- | Pretty printer.
-mode_stat :: MODE -> [String]
-mode_stat (d,i,s) =
-    ["mode-start-degree : " ++ show d
-    ,"mode-intervals    : " ++ intercalate "," (map show i)
-    ,"mode-degree       : " ++ show (sum i)
-    ,"mode-description  : " ++ s]
+-- | Is /p/ an element of the set of rotations of /q/.
+mode_rot_eqv :: Mode -> Mode -> Bool
+mode_rot_eqv p q =
+  (mode_length p == mode_length q) &&
+  (mode_univ p == mode_univ q) &&
+  (mode_intervals p `elem` List.rotations (mode_intervals q))
 
+{- | Pretty printer.
+
+> mn <- load_modenam
+
+> let r = filter ((/=) 0 . mode_starting_degree) (modenam_modes mn) -- non-zero starting degrees
+> let r = filter ((== [(1,2),(2,5)]) . mode_histogram) (modenam_modes mn) -- 2×1 and 5×2
+> let r = filter ((== 22) . mode_univ) (modenam_search_description mn "Raga") -- raga of 22 shruti univ
+
+> [(p,q) | p <- r, q <- r, p < q, mode_rot_eqv p q] -- rotationally equivalent elements of r
+
+> length r
+> putStrLn $ unlines $ intercalate ["\n"] $ map mode_stat r
+-}
+mode_stat :: Mode -> [String]
+mode_stat m =
+  let hst = mode_histogram m
+      comma_map f = intercalate "," . map f
+  in ["mode-start-degree : " ++ show (mode_starting_degree m)
+     ,"mode-intervals    : " ++ comma_map show (mode_intervals m)
+     ,"mode-description  : " ++ mode_description m
+     ,"mode-length       : " ++ show (mode_length m)
+     ,"mode-univ         : " ++ show (mode_univ m)
+     ,"mode-interval-set : " ++ intercalate "," (map show (mode_iset m))
+     ,"mode-histogram    : " ++ intercalate "," (map (\(e,n) -> concat [show n,"×",show e]) hst)
+     ,"mode-degree-seq   : " ++ comma_map show (mode_degree_seq m)
+     ]
+
 -- * Parser
 
 -- | Bracketed integers are a non-implicit starting degree.
@@ -69,49 +127,53 @@
 -- > map non_implicit_degree ["4","[4]"] == [Nothing,Just 4]
 non_implicit_degree :: String -> Maybe Int
 non_implicit_degree s =
-    case T.unbracket s of
-      Just ('[',s',']') -> Just (read s')
+    case List.unbracket s of
+      Just ('[',x,']') -> Just (read x)
       _ -> Nothing
 
+-- | Predicate form
 is_non_implicit_degree :: String -> Bool
 is_non_implicit_degree = isJust . non_implicit_degree
 
 is_integer :: String -> Bool
 is_integer = all isDigit
 
-parse_modenam_entry :: [String] -> MODE
+parse_modenam_entry :: [String] -> Mode
 parse_modenam_entry w =
-    let (n0:n,c) = span (T.predicate_or is_non_implicit_degree is_integer) w
-    in case non_implicit_degree n0 of
-         Nothing -> (0,map read (n0:n),unwords c)
-         Just d -> (d,map read n,unwords c)
+    let (n,c) = span (Function.predicate_or is_non_implicit_degree is_integer) w
+    in case non_implicit_degree (n !! 0) of
+         Nothing -> (0,map read n,unwords c)
+         Just d -> (d,map read (tail n),unwords c)
 
 -- | Lines ending with @\@ continue to next line.
 join_long_lines :: [String] -> [String]
 join_long_lines l =
     case l of
-      p:q:l' -> case T.separate_last' p of
+      p:q:l' -> case List.separate_last' p of
                   (p',Just '\\') -> join_long_lines ((p' ++ q) : l')
                   _ -> p : join_long_lines (q : l')
       _ -> l
 
-parse_modenam :: [String] -> MODENAM
+-- | Parse joined non-comment lines of modenam file.
+parse_modenam :: [String] -> ModeNam
 parse_modenam l =
     case l of
-      n:x:m -> let n' = read n :: Int
-                   x' = read x :: Int
-                   m' = map (parse_modenam_entry . words) m
-               in if n' == length m' then (n',x',m') else error "parse_modenam"
+      n_str:x_str:m_str ->
+        let n = read n_str :: Int
+            x = read x_str :: Int
+            m = map (parse_modenam_entry . words) m_str
+        in if n == length m then (n,x,m) else error "parse_modenam"
       _ -> error "parse_modenam"
 
--- * IO
+-- * Io
 
--- | 'parse_modenam' of 'T.load_dist_file' of @modenam.par@.
---
--- > mn <- load_modenam
--- > let (n,x,m) = mn
--- > n == 2125 && x == 15 && length m == n
-load_modenam :: IO MODENAM
+{- | 'parse_modenam' of 'Scala.load_dist_file' of @modenam.par@.
+
+> mn <- load_modenam
+> let (n,x,m) = mn
+> (n, x, length m) == (3087,15,3087) -- Scala 2.64p
+-}
+load_modenam :: IO ModeNam
 load_modenam = do
-  l <- T.load_dist_file "modenam.par"
-  return (parse_modenam (T.filter_comments (join_long_lines l)))
+  l <- Scala.load_dist_file_ln "modenam.par"
+  return (parse_modenam (Scala.filter_comments (join_long_lines l)))
diff --git a/Music/Theory/Tuning/Sethares_1994.hs b/Music/Theory/Tuning/Sethares_1994.hs
--- a/Music/Theory/Tuning/Sethares_1994.hs
+++ b/Music/Theory/Tuning/Sethares_1994.hs
@@ -1,16 +1,26 @@
 -- | William A. Sethares.
 -- "Adaptive Tunings for Musical Scales".
 -- /Journal of the Acoustical Society of America/, 96(1), July 1994.
---
--- <http://sethares.engr.wisc.edu/consemi.html>
 module Music.Theory.Tuning.Sethares_1994 where
 
-import qualified Music.Theory.Tuning as T
+import Data.Maybe {- base -}
 
--- > import Sound.SC3.Plot
--- > plotTable1 (map (\f -> d (220,1) (f,1)) [220 .. 440])
-d :: (Floating n, Ord n) => (n,n) -> (n,n) -> n
-d (f1,v1) (f2,v2) =
+import qualified Music.Theory.Tuning as T {- hmt -}
+
+{- | Plomp-Levelt consonance curve.
+
+R. Plomp and W. J. M. Levelt,
+"Tonal Consonance and Critical Bandwidth,"
+Journal of the Acoustical Society of America.38, 548-560 (1965).
+
+"Relating Tuning and Timbre" <http://sethares.engr.wisc.edu/consemi.html>
+MATLAB: <https://sethares.engr.wisc.edu/comprog.html>
+
+> import Sound.SC3.Plot {- hsc3-plot -}
+> plot_p1_ln [map (\f -> pl_dissonance (220,1) (f,1)) [220 .. 440]]
+-}
+pl_dissonance :: (Floating n, Ord n) => (n,n) -> (n,n) -> n
+pl_dissonance (f1,v1) (f2,v2) =
     let d_star = 0.24
         s1 = 0.0207
         s2 = 18.96
@@ -24,16 +34,52 @@
         e2 = c2 * exp (a2 * s * f_dif)
     in v1 * v2 * (e1 + e2)
 
--- > plotTable fig_1
-fig_1 :: (Floating n,Enum n,Ord n) => [[n]]
-fig_1 =
+-- | Sum of 'pl_dissonance' for all p in s1 and all q in s2.
+pl_dissonance_h :: (Floating n, Ord n) => [(n,n)] -> [(n,n)] -> n
+pl_dissonance_h s1 s2 = sum [pl_dissonance p q | p <- s1, q <- s2]
+
+-- | Return local minima of sequence with index.
+local_minima :: Ord t => [t] -> [(Int,t)]
+local_minima =
+  let f (ix,i,j,k) = if j <= i && j <= k then Just (ix,j) else Nothing
+      triples ix l = case l of
+                       i:j:k:_ -> (ix,i,j,k) : triples (ix + 1) (tail l)
+                       _ -> []
+  in mapMaybe f . triples 1
+
+-- | William A. Sethares "Adaptive Tunings for Musical Scales".
+--
+-- > plot_p1_ln atms_fig_1
+atms_fig_1 :: (Floating n,Enum n,Ord n) => [[n]]
+atms_fig_1 =
     let f0 = [125,250,500,1000,2000]
-        r_seq = map T.cents_to_ratio [0 .. 1200]
-    in map (\f -> map (\r -> d (f,1) (f * r,1)) r_seq) f0
+        r_seq = map T.cents_to_fratio [0 .. 1200]
+    in map (\f -> map (\r -> pl_dissonance (f,1) (f * r,1)) r_seq) f0
 
--- > let a_seq = take 7 (iterate (* 0.88) 1.0)
--- > let gen f0 = zipWith (\r a -> (f0 * r,a)) [1 .. 7] a_seq
--- > let r_seq = map T.cents_to_ratio [0,1 .. 1200]
--- > plotTable1 (let f0 = 880 in map (\r -> d_h (gen f0) (gen (f0 * r))) r_seq)
-d_h :: (Floating n, Ord n) => [(n,n)] -> [(n,n)] -> n
-d_h s1 s2 = sum [d p q | p <- s1, q <- s2]
+-- > plot_p1_ln [atms_fig_2 880]
+-- > map fst (local_minima (atms_fig_2 880)) == [204,231,267,316,386,435,498,583,702,814,884,969,1018]
+atms_fig_2 :: (Ord t, Floating t, Enum t) => t -> [t]
+atms_fig_2 f0 =
+  let gen fq = map (\r -> (fq * r,1)) [1 .. 9]
+      r_seq = map T.cents_to_fratio [0,1 .. 1200]
+  in map (\r -> pl_dissonance_h (gen f0) (gen (f0 * r))) r_seq
+
+-- > Sound.SC3.Plot.plot_p1_ln [atms_fig_3 880]
+-- > map fst (local_minima (atms_fig_3 880)) == [267,400,533,667,800,933,1043]
+atms_fig_3 :: (Ord t, Floating t, Enum t) => t -> [t]
+atms_fig_3 f0 =
+  let b = 2 ** (1/9)
+      gen fq = map (\r -> (fq * r,1)) (1 : map (b **) [9,14,18,21,25,27,30])
+      r_seq = map T.cents_to_fratio [0,1 .. 1200]
+  in map (\r -> pl_dissonance_h (gen f0) (gen (f0 * r))) r_seq
+
+-- | "Relating Tuning and Timbre" <http://sethares.engr.wisc.edu/consemi.html>
+--
+-- > plot_p1_ln [rtt_fig_2 880]
+-- > map fst (local_minima (rtt_fig_2 880)) == [267,316,386,498,582,702,884,969]
+rtt_fig_2 :: (Ord t, Floating t, Enum t) => t -> [t]
+rtt_fig_2 f0 =
+  let a_seq = take 7 (iterate (* 0.88) 1.0)
+      gen fq = zipWith (\r a -> (fq * r,a)) [1 .. 7] a_seq
+      r_seq = map T.cents_to_fratio [0,1 .. 1200]
+  in map (\r -> pl_dissonance_h (gen f0) (gen (f0 * r))) r_seq
diff --git a/Music/Theory/Tuning/Syntonic.hs b/Music/Theory/Tuning/Syntonic.hs
--- a/Music/Theory/Tuning/Syntonic.hs
+++ b/Music/Theory/Tuning/Syntonic.hs
@@ -3,10 +3,18 @@
 
 import Data.List {- base -}
 
-import Music.Theory.Tuning {- hmt -}
+import qualified Music.Theory.Tuning as T {- hmt -}
+import qualified Music.Theory.Tuning.Type as T {- hmt -}
 
--- | Construct an isomorphic layout of /r/ rows and /c/ columns with
--- an upper left value of /(i,j)/.
+{- | Construct an isomorphic layout of /r/ rows and /c/ columns with an upper left value of /(i,j)/.
+
+> r = [[(0,0),(-1,2),(-2,4)],[(-1,1),(-2,3),(-3,5)],[(-2,2),(-3,4),(-4,6)]]
+> mk_isomorphic_layout 3 3 (0,0) == r
+> map (map fst) r == [[0,-1,-2],[-1,-2,-3],[-2,-3,-4]]
+> map (map snd) r == [[0,2,4],[1,3,5],[2,4,6]]
+> map (map fst) r == map (map fst) (transpose r)
+> map (map snd) (transpose r) == [[0,1,2],[2,3,4],[4,5,6]]
+-}
 mk_isomorphic_layout :: Integral a => a -> a -> (a,a) -> [[(a,a)]]
 mk_isomorphic_layout n_row n_col top_left =
     let (a,b) `plus` (c,d) = (a+c,b+d)
@@ -18,12 +26,12 @@
 -- | A minimal isomorphic note layout.
 --
 -- > let [i,j,k] = mk_isomorphic_layout 3 5 (3,-4)
--- > in [i,take 4 j,(2,-4):take 4 k] == minimal_isomorphic_note_layout
+-- > [i,take 4 j,(2,-4):take 4 k] == minimal_isomorphic_note_layout
 minimal_isomorphic_note_layout :: [[(Int,Int)]]
 minimal_isomorphic_note_layout =
-    [[(3,-4),(2,-2),(1,0),(0,2),(-1,4)]
-       ,[(2,-3),(1,-1),(0,1),(-1,3)]
-    ,[(2,-4),(1,-2),(0,0),(-1,2),(-2,4)]]
+  [[(3,-4),(2,-2),(1,0),(0,2),(-1,4)]
+  ,[(2,-3),(1,-1),(0,1),(-1,3)]
+  ,[(2,-4),(1,-2),(0,0),(-1,2),(-2,4)]]
 
 -- | Make a rank two regular temperament from a list of /(i,j)/
 -- positions by applying the scalars /a/ and /b/.
@@ -34,27 +42,27 @@
 -- rows and @7@ columns starting at @(3,-4)@ and a
 -- 'rank_two_regular_temperament' with /a/ of @1200@ and indicated
 -- /b/.
-mk_syntonic_tuning :: Int -> [Cents]
+mk_syntonic_tuning :: Int -> [T.Cents]
 mk_syntonic_tuning b =
   let l = mk_isomorphic_layout 5 7 (3,-4)
       t = map (rank_two_regular_temperament 1200 b) l
   in nub (sort (map (\x -> fromIntegral (x `mod` 1200)) (concat t)))
 
--- | 'mk_syntonic_tuning' of @697@.
---
--- > divisions syntonic_697 == 17
---
--- > let c = [0,79,194,273,309,388,467,503,582,697,776,812,891,970,1006,1085,1164]
--- > in cents_i syntonic_697 == c
-syntonic_697 :: Tuning
-syntonic_697 = Tuning (Right (mk_syntonic_tuning 697)) 2
+{- | 'mk_syntonic_tuning' of @697@.
 
+> tn_divisions syntonic_697 == 17
+
+> let c = [0,79,194,273,309,388,467,503,582,697,776,812,891,970,1006,1085,1164]
+> tn_cents_i syntonic_697 == c
+-}
+syntonic_697 :: T.Tuning
+syntonic_697 = T.Tuning (Right (mk_syntonic_tuning 697)) Nothing
+
 -- | 'mk_syntonic_tuning' of @702@.
 --
--- > divisions syntonic_702 == 17
+-- > tn_divisions syntonic_702 == 17
 --
 -- > let c = [0,24,114,204,294,318,408,498,522,612,702,792,816,906,996,1020,1110]
--- > in cents_i syntonic_702 == c
-syntonic_702 :: Tuning
-syntonic_702 = Tuning (Right (mk_syntonic_tuning 702)) 2
-
+-- > tn_cents_i syntonic_702 == c
+syntonic_702 :: T.Tuning
+syntonic_702 = T.Tuning (Right (mk_syntonic_tuning 702)) Nothing
diff --git a/Music/Theory/Tuning/Type.hs b/Music/Theory/Tuning/Type.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Type.hs
@@ -0,0 +1,166 @@
+-- | Tuning type
+module Music.Theory.Tuning.Type where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Music.Theory.Either as T {- hmt -}
+import qualified Music.Theory.Math.Prime as T {- hmt -}
+import qualified Music.Theory.Tuning as T {- hmt -}
+
+-- * Tuning
+
+-- | A tuning specified 'Either' as a sequence of exact ratios, or as
+-- a sequence of possibly inexact 'Cents', and an octave if not 2:1 or 1200.
+--
+-- In both cases, the values are given in relation to the first degree
+-- of the scale, which for ratios is 1 and for cents 0.
+data Tuning = Tuning {tn_ratios_or_cents :: Either [Rational] [T.Cents]
+                     ,tn_octave :: Maybe (Either Rational T.Cents)}
+              deriving (Eq,Show)
+
+-- | Default epsilon for recovering ratios from cents.
+tn_epsilon :: Double
+tn_epsilon = 0.001
+
+-- | Tuning value as rational, reconstructed if required.
+tn_as_ratio :: Double -> Either Rational T.Cents -> Rational
+tn_as_ratio epsilon = either id (T.reconstructed_ratio epsilon)
+
+-- | Tuning value as cents.
+tn_as_cents :: Either Rational T.Cents -> T.Cents
+tn_as_cents = either T.ratio_to_cents id
+
+-- | Tuning octave, defaulting to 2:1.
+tn_octave_def :: Tuning -> Either Rational T.Cents
+tn_octave_def = fromMaybe (Left 2) . tn_octave
+
+-- | Tuning octave in cents.
+tn_octave_cents :: Tuning -> T.Cents
+tn_octave_cents = tn_as_cents . tn_octave_def
+
+-- | Tuning octave as ratio cents.
+tn_octave_ratio :: Double -> Tuning -> Rational
+tn_octave_ratio epsilon = tn_as_ratio epsilon . tn_octave_def
+
+-- | Divisions of octave.
+--
+-- > tn_divisions (tn_equal_temperament 12) == 12
+tn_divisions :: Tuning -> Int
+tn_divisions = either length length . tn_ratios_or_cents
+
+-- | 'Maybe' exact ratios of 'Tuning', NOT including the octave.
+tn_ratios :: Tuning -> Maybe [Rational]
+tn_ratios = T.from_left . tn_ratios_or_cents
+
+-- | Limit of JI tuning.
+tn_limit :: Tuning -> Maybe Integer
+tn_limit = fmap (maximum . map T.rational_prime_limit) . tn_ratios
+
+-- | 'error'ing variant.
+tn_ratios_err :: Tuning -> [Rational]
+tn_ratios_err = fromMaybe (error "ratios") . tn_ratios
+
+-- | Possibly inexact 'Cents' of tuning, NOT including the octave.
+tn_cents :: Tuning -> [T.Cents]
+tn_cents = either (map T.ratio_to_cents) id . tn_ratios_or_cents
+
+-- | 'map' 'round' '.' 'cents'.
+tn_cents_i :: Integral i => Tuning -> [i]
+tn_cents_i = map round . tn_cents
+
+-- | Variant of 'tn_cents' that includes octave at right.
+tn_cents_octave :: Tuning -> [T.Cents]
+tn_cents_octave t = tn_cents t ++ [tn_octave_cents t]
+
+-- | 'tn_cents' / 100
+tn_fmidi :: Tuning -> [Double]
+tn_fmidi = map (* 0.01) . tn_cents
+
+-- | Possibly inexact 'Approximate_Ratio's of tuning.
+tn_approximate_ratios :: Tuning -> [T.Approximate_Ratio]
+tn_approximate_ratios =
+    either (map T.approximate_ratio) (map T.cents_to_fratio) .
+    tn_ratios_or_cents
+
+-- | Cyclic form, taking into consideration 'octave_ratio'.
+tn_approximate_ratios_cyclic :: Tuning -> [T.Approximate_Ratio]
+tn_approximate_ratios_cyclic t =
+    let r = tn_approximate_ratios t
+        m = T.cents_to_fratio (tn_octave_cents t)
+        g = iterate (* m) 1
+        f n = map (* n) r
+    in concatMap f g
+
+-- | Lookup function that allows both negative & multiple octave indices.
+--
+-- > :l Music.Theory.Tuning.DB.Werckmeister
+-- > let map_zip f l = zip l (map f l)
+-- > map_zip (tn_ratios_lookup werckmeister_vi) [-24 .. 24]
+tn_ratios_lookup :: Tuning -> Int -> Maybe Rational
+tn_ratios_lookup t n =
+    let (o,pc) = n `divMod` tn_divisions t
+        o_ratio = T.oct_diff_to_ratio (tn_octave_ratio tn_epsilon t) o
+    in fmap (\r -> o_ratio * (r !! pc)) (tn_ratios t)
+
+-- | Lookup function that allows both negative & multiple octave indices.
+--
+-- > map_zip (tn_approximate_ratios_lookup werckmeister_v) [-24 .. 24]
+tn_approximate_ratios_lookup :: Tuning -> Int -> T.Approximate_Ratio
+tn_approximate_ratios_lookup t n =
+    let (o,pc) = n `divMod` tn_divisions t
+        o_ratio = fromRational (T.oct_diff_to_ratio (tn_octave_ratio tn_epsilon t) o)
+    in o_ratio * (tn_approximate_ratios t !! pc)
+
+-- | 'Maybe' exact ratios reconstructed from possibly inexact 'Cents'
+-- of 'Tuning'.
+--
+-- > :l Music.Theory.Tuning.DB.Werckmeister
+-- > let r = [1,17/16,9/8,13/11,5/4,4/3,7/5,3/2,11/7,5/3,16/9,15/8]
+-- > tn_reconstructed_ratios 1e-2 werckmeister_iii == Just r
+tn_reconstructed_ratios :: Double -> Tuning -> Maybe [Rational]
+tn_reconstructed_ratios epsilon =
+    fmap (map (T.reconstructed_ratio epsilon)) .
+    T.from_right .
+    tn_ratios_or_cents
+
+-- * Equal temperaments
+
+-- | Make /n/ division equal temperament.
+tn_equal_temperament :: Integral n => n -> Tuning
+tn_equal_temperament n =
+    let c = genericTake n [0,1200 / fromIntegral n ..]
+    in Tuning (Right c) Nothing
+
+-- | 12-tone equal temperament.
+--
+-- > tn_cents tn_equal_temperament_12 == [0,100..1100]
+tn_equal_temperament_12 :: Tuning
+tn_equal_temperament_12 = tn_equal_temperament (12::Int)
+
+-- | 19-tone equal temperament.
+--
+-- > let c = [0,63,126,189,253,316,379,442,505,568,632,695,758,821,884,947,1011,1074,1137]
+-- > tn_cents_i tn_equal_temperament_19 == c
+tn_equal_temperament_19 :: Tuning
+tn_equal_temperament_19 = tn_equal_temperament (19::Int)
+
+-- | 31-tone equal temperament.
+tn_equal_temperament_31 :: Tuning
+tn_equal_temperament_31 = tn_equal_temperament (31::Int)
+
+-- | 53-tone equal temperament.
+tn_equal_temperament_53 :: Tuning
+tn_equal_temperament_53 = tn_equal_temperament (53::Int)
+
+-- | 72-tone equal temperament.
+--
+-- > let r = [0,17,33,50,67,83,100]
+-- > take 7 (map round (tn_cents tn_equal_temperament_72)) == r
+tn_equal_temperament_72 :: Tuning
+tn_equal_temperament_72 = tn_equal_temperament (72::Int)
+
+-- | 96-tone equal temperament.
+tn_equal_temperament_96 :: Tuning
+tn_equal_temperament_96 = tn_equal_temperament (96::Int)
+
diff --git a/Music/Theory/Tuning/Wilson.hs b/Music/Theory/Tuning/Wilson.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuning/Wilson.hs
@@ -0,0 +1,936 @@
+-- | Erv Wilson, archives <http://anaphoria.com/wilson.html>
+module Music.Theory.Tuning.Wilson where
+
+import Control.Monad {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ord {- base -}
+import Data.Ratio {- base -}
+import Text.Printf {- base -}
+
+import qualified Safe {- safe -}
+
+import qualified Music.Theory.Array.Text as Text {- hmt-base -}
+import qualified Music.Theory.Function as Function {- hmt-base -}
+import qualified Music.Theory.Graph.Type as Graph {- hmt-base -}
+import qualified Music.Theory.List as List {- hmt-base -}
+import qualified Music.Theory.Math as Math {- hmt-base -}
+import qualified Music.Theory.Math.Convert as Convert {- hmt-base -}
+import qualified Music.Theory.Show as Show {- hmt-base -}
+import qualified Music.Theory.Tuple as Tuple {- hmt-base -}
+
+import qualified Music.Theory.Graph.Dot as Dot {- hmt -}
+import qualified Music.Theory.Interval.Barlow_1987 as Barlow {- hmt -}
+import qualified Music.Theory.Math.Oeis as OEIS {- hmt -}
+import qualified Music.Theory.Math.Prime as Prime {- hmt -}
+import qualified Music.Theory.Set.List as Set {- hmt -}
+import qualified Music.Theory.Tuning as Tuning {- hmt -}
+import qualified Music.Theory.Tuning.Scala as Scala {- hmt -}
+
+-- * Geom (see "Data.CG.Minus.Plain")
+
+type V2 n = (n,n)
+v2_map :: (t -> u) -> V2 t -> V2 u
+v2_map f (a,b) = (f a,f b)
+v2_zip :: (a -> b -> c) -> V2 a -> V2 b -> V2 c
+v2_zip f (i,j) (p,q) = (f i p,f j q)
+v2_add :: Num n => V2 n -> V2 n -> V2 n
+v2_add = v2_zip (+)
+v2_sum :: Num n => [V2 n] -> V2 n
+v2_sum = foldl v2_add (0,0)
+v2_scale :: Num n => n -> V2 n -> V2 n
+v2_scale n = v2_map (* n)
+
+-- * Pt Set
+
+{- | Normalise set of points to lie in (-1,-1) - (1,1), scaling symetrically about (0,0)
+
+> pt_set_normalise_sym [(40,0),(0,40),(13,11),(-8,4)] == [(1,0),(0,1),(0.325,0.275),(-0.2,0.1)]
+> pt_set_normalise_sym [(-10,0),(1,10)] == [(-1,0),(0.1,1)]
+-}
+pt_set_normalise_sym :: (Fractional n,Ord n) => [V2 n] -> [V2 n]
+pt_set_normalise_sym x =
+  let z = maximum (map (uncurry max . Function.bimap1 abs) x)
+  in map (v2_scale (recip z)) x
+
+-- * Lattice Design
+
+-- | /k/-unit co-ordinates for /k/-lattice.
+type Lattice_Design n = (Int,[V2 n])
+
+-- | Erv Wilson standard lattice, unit co-ordinates for 5-dimensions, ie. [3,5,7,11,13]
+--
+-- <http://anaphoria.com/wilsontreasure.html>
+ew_lc_std :: Num n => Lattice_Design n
+ew_lc_std = (5,[(20,0),(0,20),(4,3),(-3,4),(-1,2)])
+
+-- | Kraig Grady standard lattice, unit co-ordinates for 5-dimensions, ie. [3,5,7,11,13]
+--
+-- <http://anaphoria.com/wilsontreasure.html>
+kg_lc_std :: Num n => Lattice_Design n
+kg_lc_std = (5,[(40,0),(0,40),(13,11),(-14,18),(-8,4)])
+
+-- | Erv Wilson tetradic lattice (3-lattice), used especially when working with hexanies or 7 limit tunings
+--
+-- <http://anaphoria.com/wilsontreasure.html>
+ew_lc_tetradic :: Num n => Lattice_Design n
+ew_lc_tetradic = (3,[(-4,-2),(6,1),(5,-2)])
+
+-- * Lattice_Factors
+
+-- | A discrete /k/-lattice is described by a sequence of /k/-factors.
+--   Values are ordinarily though not necessarily primes beginning at three.
+type Lattice_Factors i = (Int,[i])
+
+-- | Positions in a /k/-lattice are given as a /k/-list of steps.
+type Lattice_Position = (Int,[Int])
+
+-- | Delete entry at index.
+lc_pos_del :: Int -> Lattice_Position -> Lattice_Position
+lc_pos_del ix (k,x) = (k - 1,List.remove_ix ix x)
+
+-- | Resolve Lattice_Position against Lattice_Design to V2
+lc_pos_to_pt :: (Fractional n, Ord n) => Lattice_Design n -> Lattice_Position -> V2 n
+lc_pos_to_pt (_,lc) (_,x) = v2_sum (zipWith (v2_scale . fromIntegral) x (pt_set_normalise_sym lc))
+
+-- | White-space pretty printer for Lattice_Position.
+--
+-- > pos_pp_ws (3,[0,-2,1]) == "  0 -2  1"
+pos_pp_ws :: Lattice_Position -> String
+pos_pp_ws = let f x = printf "%3d" x in concatMap f . snd
+
+-- | Given Lattice_Factors [X,Y,Z..] and Lattice_Position [x,y,z..], calculate the indicated ratio.
+--
+-- > lat_res (2,[3,5]) (2,[-5,2]) == (5 * 5) / (3 * 3 * 3 * 3 * 3)
+lat_res :: Integral i => Lattice_Factors i -> Lattice_Position -> Ratio i
+lat_res (_,p) (_,q) =
+  let f i j = case compare j 0 of
+                GT -> (i ^ Convert.int_to_integer j) % 1
+                EQ -> 1
+                LT -> 1 % (i ^ abs (Convert.int_to_integer j))
+  in product (zipWith f p q)
+
+-- * Rat (n,d)
+
+-- | Ratio given as (/n/,/d/)
+type Rat = (Integer,Integer)
+
+-- | Remove all octaves from /n/ and /d/.
+rat_rem_oct :: Rat -> Rat
+rat_rem_oct = Function.bimap1 (product . filter (/= 2)) . Prime.rat_prime_factors
+
+-- | Lift 'Rat' function to 'Rational'.
+rat_lift_1 :: (Rat -> Rat) -> Rational -> Rational
+rat_lift_1 f = uncurry (%) . f . Math.rational_nd
+
+-- | Convert 'Rat' to 'Rational'
+rat_to_ratio :: Rat -> Rational
+rat_to_ratio (n,d) = n % d
+
+-- | Mediant, ie. n1+n2/d1+d2
+--
+-- > rat_mediant (0,1) (1,2) == (1,3)
+rat_mediant :: Rat -> Rat -> Rat
+rat_mediant (n1,d1) (n2,d2) = (n1 + n2,d1 + d2)
+
+-- | Rat written as n/d
+rat_pp :: Rat -> String
+rat_pp (n,d) = concat [show n,"/",show d]
+
+-- * Rational
+
+-- | Lifted 'rat_rem_oct'.
+--
+-- > map ew_r_rem_oct [256/243,7/5,1/7] == [1/243,7/5,1/7]
+r_rem_oct :: Rational -> Rational
+r_rem_oct = rat_lift_1 rat_rem_oct
+
+-- | Assert that /n/ is in [1,2).
+r_verify_oct :: Rational -> Rational
+r_verify_oct i = if i >= 1 && i < 2 then i else error (show ("r_verify_oct?",i))
+
+-- | Find limit of set of ratios, ie. largest factor in either numerator or denominator.
+--
+-- > r_seq_limit [1] == 1
+r_seq_limit :: [Rational] -> Integer
+r_seq_limit = maximum . map Prime.rational_prime_limit
+
+-- | Find factors of set of ratios, ie. the union of all factor in both numerator & denominator.
+--
+-- > r_seq_factors [1/3,5/7,9/8,13,27,31] == [2,3,5,7,13,31]
+r_seq_factors :: [Rational] -> [Integer]
+r_seq_factors = nub . sort . concatMap (uncurry (++) . Prime.rational_prime_factors)
+
+-- * Table
+
+-- | Vector of prime-factors up to /limit/.
+--
+-- > map (rat_fact_lm 11) [3,5,7,2/11] == [(5,[0,1,0,0,0]),(5,[0,0,1,0,0]),(5,[0,0,0,1,0]),(5,[1,0,0,0,-1])]
+rat_fact_lm :: Integer -> Rational -> Lattice_Position
+rat_fact_lm lm =
+  let k = fromMaybe 1 (Prime.prime_k lm) + 1
+  in (\c -> (k,c)) .
+     Prime.rat_prime_factors_t k .
+     Math.rational_nd
+
+tbl_txt :: Bool -> Integer -> [Rational] -> [[String]]
+tbl_txt del lm_z rs =
+  let lm = r_seq_limit rs
+      scl = map ((if del then lc_pos_del 0 else id) . rat_fact_lm lm) rs
+      cs = map (Tuning.ratio_to_cents . Tuning.fold_ratio_to_octave_err) rs
+      hs = map (Barlow.harmonicity_r Barlow.barlow) rs :: [Double]
+      f (k,x,r,c,h) = [show k
+                      ,if lm <= lm_z then pos_pp_ws x else "..."
+                      ,Show.ratio_pp r
+                      ,Show.real_pp 2 c
+                      ,Show.real_pp_unicode 2 h]
+  in map (intersperse "=" . f) (zip5 [0::Int ..] scl rs cs hs)
+
+-- > tbl_wr False [1,7/6,5/4,4/3,3/2]
+-- > tbl_wr True [1,3,1/5,15/31]
+tbl_wr :: Bool -> [Rational] -> IO ()
+tbl_wr del = putStr . unlines . Text.table_pp (False,True,False," ",False) . tbl_txt del 31
+
+-- * Graph
+
+-- | (maybe (maybe lattice-design, maybe primes),gr-attr,vertex-pp)
+type Ew_Gr_Opt = (Maybe (Lattice_Design Rational,Maybe [Integer]),[Dot.Dot_Meta_Attr],Rational -> String)
+
+ew_gr_opt_pos :: Ew_Gr_Opt -> Bool
+ew_gr_opt_pos (lc_m,_,_) = isJust lc_m
+
+-- > map (ew_gr_r_pos ew_lc_std (Just [3,5,31])) [3,5,31]
+ew_gr_r_pos :: Lattice_Design Rational -> Maybe [Integer] -> Rational -> Dot.Dot_Attr
+ew_gr_r_pos (k,lc) primes_l =
+  let f m (x,y) = (m * x,m * y)
+  in Dot.node_pos_attr .
+     f 160 .
+     lc_pos_to_pt (k,lc) .
+     (\c -> (k,c)) .
+     -- this is a little subtle, tail removes the '2' slot from rational_prime_factors_t
+     maybe (tail . Prime.rational_prime_factors_t (k + 1)) Prime.rational_prime_factors_c primes_l
+
+-- | 'Dot.lbl_to_udot' add position attribute if a 'Lattice_Design' is given.
+ew_gr_udot :: Ew_Gr_Opt -> Graph.Lbl Rational () -> [String]
+ew_gr_udot (lc_m,attr,v_pp) =
+  let (e,p_f) = case lc_m of
+                  Nothing -> ("sfdp",const Nothing)
+                  Just (lc,primes_l) -> ("neato",Just . ew_gr_r_pos lc primes_l)
+  in Dot.lbl_to_udot
+     ([("graph:layout",e),("node:shape","plain")] ++ attr) -- ("graph:K","0.6") ("edge:len","1.0")
+     (\(_,v) -> List.mcons (p_f v) [("label",v_pp v)]
+     ,const [])
+
+-- | 'writeFile' of 'ew_gr_udot'
+ew_gr_udot_wr :: Ew_Gr_Opt -> FilePath -> Graph.Lbl Rational () -> IO ()
+ew_gr_udot_wr opt fn = writeFile fn . unlines . ew_gr_udot opt
+
+ew_gr_udot_wr_svg :: Ew_Gr_Opt -> FilePath -> Graph.Lbl Rational () -> IO ()
+ew_gr_udot_wr_svg opt fn gr = do
+  ew_gr_udot_wr opt fn gr
+  void (Dot.dot_to_svg (if ew_gr_opt_pos opt then ["-n"] else []) fn)
+
+-- * Zig-Zag
+
+zz_seq_1 :: (Eq n,Num n) => Int -> (n,n) -> (n,n) -> [(n,n)]
+zz_seq_1 k (p,q) (n,d) = if k == 0 then [(n,d)] else (n,d) : zz_seq_1 (k - 1) (p,q) (n+p,d+q)
+
+-- > zz_next 3 [(0,1),(1,1)] == [(1,1),(1,2),(1,3),(1,4)]
+zz_next :: (Eq n, Num n) => Int -> [(n,n)] -> [(n,n)]
+zz_next k p =
+  case reverse p of
+    i:j:_ -> zz_seq_1 k j i
+    _ -> error "zz_next?"
+
+zz_recur :: (Eq n, Num n) => [Int] -> [(n,n)] -> [[(n,n)]]
+zz_recur k_seq p =
+  case k_seq of
+    [] -> []
+    k:k_rem -> let r = zz_next k p in r : zz_recur k_rem r
+
+-- > zz_seq [3,9,2,2,4,6,2,1,1,3]
+-- > zz_seq [2,4,2,158]
+-- > zz_seq [1,1,4,2,1,3,1,6,2]
+zz_seq :: (Eq n, Num n) => [Int] -> [[(n, n)]]
+zz_seq k_seq = zz_recur k_seq [(0,1),(1,1)]
+
+-- * Mos
+
+-- > gen_coprime 12 == [1,5]
+-- > gen_coprime 49 == [1..24] \\ [7,14,21]
+gen_coprime :: Integral a => a -> [a]
+gen_coprime x = filter (\y -> gcd y x == 1) [1 .. (x `div` 2)]
+
+-- > mos_2 12 5 == (5,7)
+mos_2 :: Num n => n -> n -> (n,n)
+mos_2 p g = (g,p - g)
+
+-- | Divide MOS, keeps retained value on same side
+--
+-- > mos_step (5,7) == (5,2)
+-- > mos_step (5,2) == (3,2)
+-- > mos_step (3,2) == (1,2)
+mos_step :: (Ord a, Num a) => (a, a) -> (a, a)
+mos_step (i,j) = if i < j then (i,j - i) else (i - j,j)
+
+-- > mos_unfold (5,7)  == [(5,7),(5,2),(3,2),(1,2)]
+-- > mos_unfold (41,17) == [(41,17),(24,17),(7,17),(7,10),(7,3),(4,3),(1,3),(1,2)]
+mos_unfold :: (Ord b, Num b) => (b, b) -> [(b, b)]
+mos_unfold x =
+  let y = mos_step x
+  in if Tuple.t2_sum y == 3 then [x,y] else x : mos_unfold y
+
+mos_verify :: Integral a => a -> a -> Bool
+mos_verify p g =
+  let x = if g > (p `div` 2) then p `mod` g else g
+  in x `elem` gen_coprime p
+
+-- > mos 12 5 == [(5,7),(5,2),(3,2),(1,2)]
+mos :: (Ord b, Integral b) => b -> b -> [(b, b)]
+mos p g = if mos_verify p g then mos_unfold (mos_2 p g) else error "mos?"
+
+-- > mos_seq 12 5 == [[5,7],[5,5,2],[3,2,3,2,2],[1,2,2,1,2,2,2]]
+-- > mos_seq 41 17 !! 4 == [3,3,4,3,4,3,3,4,3,4,3,4]
+-- > map length (mos_seq 49 27) == [2,3,5,7,9,11,20,29]
+mos_seq :: (Ord b, Integral b) => b -> b -> [[b]]
+mos_seq p g =
+  let step_f (i,j) = concatMap (\x -> if x == i + j then [i,j] else [x])
+      recur_f x l = if null x then [l] else l : recur_f (tail x) (step_f (head x) l)
+      ((i0,j0), r) = List.headTail (mos p g)
+  in recur_f r [i0,j0]
+
+mos_cell_pp :: (Integral i,Show i) => i -> String
+mos_cell_pp x = let s = show x in s ++ genericReplicate (x - genericLength s) '-'
+
+mos_row_pp :: (Integral i,Show i) => [i] -> String
+mos_row_pp = concatMap mos_cell_pp
+
+mos_tbl_pp :: (Integral i,Show i) => [[i]] -> [String]
+mos_tbl_pp = map mos_row_pp
+
+-- > mos_tbl_wr (mos_seq 49 27)
+mos_tbl_wr :: (Integral i,Show i) => [[i]] -> IO ()
+mos_tbl_wr = putStrLn . unlines . mos_tbl_pp
+
+-- * Mos/Log
+
+mos_recip_seq :: Double -> [(Int,Double)]
+mos_recip_seq x = let y = truncate x in (y,x) : mos_recip_seq (recip (x - fromIntegral y))
+
+-- > take 3 (mos_log (5/4)) == [(3,3.10628371950539),(9,9.408778735385603),(2,2.4463112031908785)]
+mos_log :: Double -> [(Int,Double)]
+mos_log r = mos_recip_seq (recip (logBase 2 r))
+
+-- > take 9 (mos_log_kseq 1.465571232) == [1,1,4,2,1,3,1,6,2]
+mos_log_kseq :: Double -> [Int]
+mos_log_kseq = map fst . mos_log
+
+-- * Stern-Brocot Tree
+
+data SBT_DIV = NIL | LHS | RHS deriving (Show)
+type Sbt_Node = (SBT_DIV,Rat,Rat,Rat)
+
+sbt_step :: Sbt_Node -> [Sbt_Node]
+sbt_step (_,l,m,r) = [(LHS,l,rat_mediant l m, m),(RHS,m,rat_mediant m r,r)]
+
+-- sbt = stern-brocot tree
+sbt_root :: Sbt_Node
+sbt_root = (NIL,(0,1),(1,1),(1,0))
+
+sbt_half :: Sbt_Node
+sbt_half = (NIL,(0,1),(1,2),(1,1))
+
+-- > sbt_from sbt_root
+sbt_from :: Sbt_Node -> [[Sbt_Node]]
+sbt_from = iterate (concatMap sbt_step) . return
+
+sbt_k_from :: Int -> Sbt_Node -> [[Sbt_Node]]
+sbt_k_from k = take k . sbt_from
+
+sbt_node_to_edge :: Sbt_Node -> String
+sbt_node_to_edge (dv,l,m,r) =
+  let edge_pp p q = printf "\"%s\" -- \"%s\"" (rat_pp p) (rat_pp q)
+  in case dv of
+       NIL -> ""
+       LHS -> edge_pp r m
+       RHS -> edge_pp l m
+
+sbt_node_elem :: Sbt_Node -> [Rat]
+sbt_node_elem (dv,l,m,r) =
+  case dv of
+    NIL -> [l,m,r]
+    _ -> [m]
+
+sbt_dot :: [Sbt_Node] -> [String]
+sbt_dot n =
+  let e = map sbt_node_to_edge n
+  in concat [["graph {","node [shape=plain]"],e,["}"]]
+
+-- * M-Gen
+
+(^.) :: Rational -> Int -> Rational
+(^.) = (^)
+
+r_normalise :: [Rational] -> [Rational]
+r_normalise = nub . sortOn Tuning.fold_ratio_to_octave_err
+
+-- | (ratio,multiplier,steps)
+type M_Gen = (Rational,Rational,Int)
+
+m_gen_unfold :: M_Gen -> [Rational]
+m_gen_unfold (r,m,n) = take n (iterate (* m) r)
+
+m_gen_to_r :: [M_Gen] -> [Rational]
+m_gen_to_r = r_normalise . concatMap m_gen_unfold
+
+-- * M3-Gen
+
+-- | (ratio,M3-steps)
+type M3_Gen = (Rational,Int)
+
+m3_to_m :: M3_Gen -> M_Gen
+m3_to_m (r,n) = (r,3,n)
+
+-- > map m3_gen_unfold [(3,4),(21/9,4),(15/9,4),(35/9,3),(21/5,4),(27/5,3)]
+m3_gen_unfold :: M3_Gen -> [Rational]
+m3_gen_unfold = m_gen_unfold . m3_to_m
+
+m3_gen_to_r :: [M3_Gen] -> [Rational]
+m3_gen_to_r = r_normalise . concatMap m3_gen_unfold
+
+-- * Scala
+
+r_to_scale :: String -> String -> [Rational] -> Scala.Scale
+r_to_scale nm dsc r =
+  let r' = map Tuning.fold_ratio_to_octave_err (tail r) ++ [2]
+  in if r !! 0 /= 1 || not (List.is_ascending r')
+     then error "r_to_scale?"
+     else (nm,dsc,length r,map Right r')
+
+ew_scl_find_r :: [Rational] -> [Scala.Scale] -> [String]
+ew_scl_find_r r =
+  let set_eq x y = sort x == sort y
+      r' = map Tuning.fold_ratio_to_octave_err r
+  in if head r' /= 1
+     then error "ew_scl_find_r?: r'0 /= 1"
+     else map Scala.scale_name . Scala.scl_find_ji set_eq (r' ++ [2])
+
+-- * <http://anaphoria.com/1-3-5-7-9Genus.pdf>
+
+ew_1357_3_gen :: [M3_Gen]
+ew_1357_3_gen = [(3,4),(21/9,4),(15/9,4),(35/9,3),(21/5,4),(27/5,3)]
+
+{- | P.3 7-limit {Scala=nil}
+
+> db <- Scala.scl_load_db
+> ew_scl_find_r (1 : ew_1357_3_r) db
+-}
+ew_1357_3_r :: [Rational]
+ew_1357_3_r = r_normalise (concatMap m3_gen_unfold ew_1357_3_gen)
+
+ew_1357_3_scl :: Scala.Scale
+ew_1357_3_scl = r_to_scale "ew_1357_3" "EW, 1-3-5-7-9Genus.pdf, P.3" (1 : ew_1357_3_r)
+
+-- * <http://anaphoria.com/earlylattices12.pdf>
+
+{- | P.7 11-limit {Scala=nil}
+
+> ew_scl_find_r ew_el12_7_r db
+-}
+ew_el12_7_r :: [Rational]
+ew_el12_7_r = [1,5/(7*11),1/7,7*11,7*11*11/5,11,5/7,1/11,7*11*11,1/(7*11),11*11,7*11/5]
+
+ew_el12_7_scl :: Scala.Scale
+ew_el12_7_scl = r_to_scale "ew_el12_7" "EW, earlylattices12.pdf, P.7" ew_el12_7_r
+
+{- | P.9 7-limit {Scala=wilson_class}
+
+> ew_scl_find_r ew_el12_9_r db
+-}
+ew_el12_9_r :: [Rational]
+ew_el12_9_r = [1,5*5/3,7/(5*5),7/3,5,1/3,7/5,5*7/3,1/5,5/3,7,7/(3*5)]
+
+--ew_el12_9_scl :: Scala.Scale
+--ew_el12_9_scl = r_to_scale "ew_el12_9" "EW, earlylattices12.pdf, P.9" ew_el12_9_r
+
+{- | P.12 11-limit {Scala=nil}
+
+> ew_scl_find_r ew_el12_12_r db
+-}
+ew_el12_12_r :: [Rational]
+ew_el12_12_r = [1,3*3*5/11,3/11,7/3,5,7/11,3*5/11,5*7/3,7/(3*3),5*7/11,7/(3*11),3*5]
+
+ew_el12_12_scl :: Scala.Scale
+ew_el12_12_scl = r_to_scale "ew_el12_12" "EW, earlylattices12.pdf, P.12" ew_el12_12_r
+
+-- * <http://anaphoria.com/earlylattices22.pdf>
+
+{- | P.2 11-limit {Scala=wilson_l4}
+
+> ew_scl_find_r ew_el22_2_r db
+-}
+ew_el22_2_r :: [Rational]
+ew_el22_2_r =
+  [1,7*7/3,3*7/5,5/(3*3),1/7,7/3,3/5,5,5*7/(3*3*3),1/3,7*7/(3*3)
+  ,7/5,5*7/3,3,7/(3*3),1/5,5/3,3/7,7,3*3/5,7/(3*5),5*7/(3*3)]
+
+{- | P.3 11-limit {Scala=wilson_l5}
+
+> ew_scl_find_r ew_el22_3_r db
+-}
+ew_el22_3_r :: [Rational]
+ew_el22_3_r =
+  [1,7*7/3,7*11/(3*3),3/11,1/7,7/3,3/5,5,7/11,1/3,7*7/(3*3)
+  ,7/5,5*7/3,3,7/(3*3),1/5,5/3,3/7,7,11/3,7/(3*5),5*7/(3*3)]
+
+{- | P.4 11-limit {Scala=wilson_l3}
+
+> ew_scl_find_r ew_el22_4_r db
+-}
+ew_el22_4_r :: [Rational]
+ew_el22_4_r =
+  [1,3*11,3*7/5,5*7,3*3,7/3,3/5,5,7/11,3*7,11
+  ,7/5,5*7/3,3,7/(3*3),1/5,3*5*7,3*3*3,7,3*3/5,3*5,3*7/11]
+
+{- | P.5 11-limit {Scala=wilson_l1}
+
+> ew_scl_find_r ew_el22_5_r db
+-}
+ew_el22_5_r :: [Rational]
+ew_el22_5_r =
+  [1,3*11,3*7/5,5*7,3*3,7/3,7*11,5,3*5*11,3*7,11
+  ,7/5,3*7*11/5,3,3*3*11,7*11/3,3*11/5,5*11,7,3*7*11,3*5,7*11/5]
+
+{- | P.6 11-limit {Scala=wilson_l2}
+
+> ew_scl_find_r ew_el22_6_r db
+-}
+ew_el22_6_r :: [Rational]
+ew_el22_6_r =
+  [1,7*7/3,7*11/(3*3),11/5,3*3,7/3,7*11,5,7*11/(3*5),1/3,11
+  ,7*11/(3*3*3),5*7/3,3,11/7,7*11/3,5/3,7*11/(3*3*5),7,11/3,3*5,7*11/5]
+
+-- * <http://anaphoria.com/diamond.pdf>
+
+ew_diamond_mk :: [Integer] -> [Rational]
+ew_diamond_mk u = r_normalise [x % y | x <- u, y <- u]
+
+-- > m3_gen_to_r ew_diamond_12_gen == ew_diamond_12_r
+ew_diamond_12_gen :: [M3_Gen]
+ew_diamond_12_gen =
+  [(1/(3^.2),5),(5/(3^.2),3),(7/(3^.2),3),(11/(3^.2),3)
+  ,(1/5,3),(1/7,3),(1/11,3)
+  ,(5/7,1),(5/11,1),(7/5,1),(7/11,1),(11/5,1),(11/7,1)]
+
+{- | P.7 & P.12 11-limit {Scala=partch_29}
+
+1,3,5,7,9,11 diamond
+
+> ew_scl_find_r ew_diamond_12_r db -- partch_29
+-}
+ew_diamond_12_r :: [Rational]
+ew_diamond_12_r = ew_diamond_mk [1,3,5,7,9,11]
+
+{- | P.10 & P.13 13-limit {Scala=novaro15}
+
+1,3,5,7,9,11,13,15 diamond
+
+> ew_scl_find_r ew_diamond_13_r db -- novaro15
+-}
+ew_diamond_13_r :: [Rational]
+ew_diamond_13_r = ew_diamond_mk [1,3,5,7,9,11,13,15]
+
+-- * <http://anaphoria.com/hel.pdf>
+
+hel_r_asc :: (Integer,Integer) -> [Rational]
+hel_r_asc (n,d) = n%d : hel_r_asc (n+1,d+1)
+
+type HEL = ([Rational],[Rational])
+
+-- | P.6
+hel_1_i :: HEL
+hel_1_i =
+  let i = take 6 (hel_r_asc (7,6))
+  in (take 5 i,take 5 (List.rotate_left 2 i))
+
+-- | P.6
+hel_2_i :: HEL
+hel_2_i =
+  let i = take 10 (hel_r_asc (9,8))
+  in (take 8 (List.rotate_left 3 (tail i))
+     ,take 7 i)
+
+-- | P.10
+hel_3_i :: HEL
+hel_3_i =
+  let i = take 16 (hel_r_asc (15,14))
+  in (take 13 (List.rotate_left 6 (take 14 i)),take 14 (tail i))
+
+hel_r :: HEL -> [[Rational]]
+hel_r (p,q) =
+  let i_to_r = scanl (*) 1
+  in [i_to_r p,i_to_r q,r_normalise (concat [i_to_r p,i_to_r q])]
+
+{- | P.12 {Scala=nil}
+
+22-tone 23-limit Evangalina tuning (2001)
+
+> ew_scl_find_r ew_hel_12_r db
+-}
+ew_hel_12_r :: [Rational]
+ew_hel_12_r =
+  [1,3*3*3*5,13/3,5/(3*3),3*3,7/3,11/(3*3),5,3*3*3*3,1/3,11
+  ,3*3*5,17/3,3,3*3*3*3*5,13,5/3,3*3*3,7,11/3,3*5,23/3]
+
+ew_hel_12_scl :: Scala.Scale
+ew_hel_12_scl = r_to_scale "ew_hel_12" "EW, hel.pdf, P.12" ew_hel_12_r
+
+-- * <http://anaphoria.com/HexanyStellatesExpansions.pdf>
+
+-- > she_div "ABCD" == [["BCD","A"],["ACD","B"],["ABD","C"],["ABC","D"]]
+she_div :: Eq a => [a] -> [[[a]]]
+she_div x =
+  let f = (== [1,length x - 1]) . sort . map length
+  in map (sortOn (Down . length)) (filter f (Set.partitions x))
+
+-- > she_div_r [1,3,5,7] == [105,35/3,21/5,15/7]
+she_div_r :: [Rational] -> [Rational]
+she_div_r =
+  let f x =
+        case x of
+          [[a,b,c],[d]] -> (a * b * c) / d
+          _ -> error "she_div?"
+  in map f . she_div
+
+-- > she_mul_r [1,3,5,7] == [1,3,5,7,9,15,21,25,35,49]
+she_mul_r :: [Rational] -> [Rational]
+she_mul_r r = [x * y | x <- r,y <- r,x <= y]
+
+{- | she = Stellate Hexany Expansions, P.10 {Scala=stelhex1,stelhex2,stelhex5,stelhex6}
+
+> she [1,3,5,7] == [1,21/20,15/14,35/32,9/8,5/4,21/16,35/24,3/2,49/32,25/16,105/64,7/4,15/8]
+> mapM (flip ew_scl_find_r db . she) [[1,3,5,7],[1,3,5,9],[1,3,7,9],[1,3,5,11]]
+> ew_scl_find_r (she [1,(5*7)/(3*3),1/(3 * 5),1/3]) db -- NIL
+-}
+she :: [Rational] -> [Rational]
+she r = nub (sort (map Tuning.fold_ratio_to_octave_err (she_mul_r r ++ she_div_r r)))
+
+-- * <http://anaphoria.com/meru.pdf>
+
+-- > map (every_nth "abcdef") [1..3] == ["abcdef","ace","ad"]
+every_nth :: [t] -> Int -> [t]
+every_nth l k =
+  case l of
+    [] -> []
+    x:_ -> x : every_nth (drop k l) k
+
+meru :: Num n => [[n]]
+meru =
+  let f xs = zipWith (+) (0 : xs) (xs ++ [0])
+  in iterate f [1]
+
+-- > meru_k 13
+meru_k :: Num n => Int -> [[n]]
+meru_k k = take k meru
+
+-- > map (sum . meru_1) [1 .. 13] == [1,1,2,3,5,8,13,21,34,55,89,144,233]
+meru_1 :: Num n => Int -> [n]
+meru_1 k = zipWith (flip (Safe.atDef 0)) [0..] (reverse (meru_k k))
+
+-- > take 13 meru_1_direct == [1,1,2,3,5,8,13,21,34,55,89,144,233]
+meru_1_direct :: Num n => [n]
+meru_1_direct = tail OEIS.a000045
+
+-- | Meru 2 = META-PELOG
+--
+-- > map (sum . meru_2) [1 .. 14] == [1,1,1,2,3,4,6,9,13,19,28,41,60,88]
+meru_2 :: Num n => Int -> [n]
+meru_2 k = zipWith (flip (Safe.atDef 0)) [0..] (every_nth (reverse (meru_k k)) 2)
+
+-- > take 14 meru_2_direct == [1,1,1,2,3,4,6,9,13,19,28,41,60,88]
+meru_2_direct :: Num n => [n]
+meru_2_direct = OEIS.a000930
+
+-- | meru_3 = META-SLENDRO
+meru_3 :: Num n => Int -> [[n]]
+meru_3 k =
+  let f t = zipWith (flip (Safe.atDef 0)) [0,2..] t
+      t0 = reverse (meru_k k)
+      t1 = map tail t0
+  in [f t0,f t1]
+
+-- > map sum (meru_3_seq 13) == [1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465]
+meru_3_seq :: Num n => Int -> [[n]]
+meru_3_seq k = concatMap meru_3 [1 .. k]
+
+-- > take 26 meru_3_direct == [1,0,1,1,1,2,2,3,4,5,7,9,12,16,21,28,37,49,65,86,114,151,200,265,351,465]
+meru_3_direct :: Num n => [n]
+meru_3_direct = drop 3 OEIS.a000931
+
+-- > map (sum . meru_4) [1 .. 13] == [1,1,1,1,2,3,4,5,7,10,14,19,26]
+meru_4 :: Num n => Int -> [n]
+meru_4 k = zipWith (flip (Safe.atDef 0)) [0..] (every_nth (reverse (meru_k k)) 3)
+
+-- > take 31 meru_4_direct == map (sum . meru_4) [1 .. 31]
+meru_4_direct :: Num n => [n]
+meru_4_direct = tail OEIS.a003269
+
+-- > map meru_5 [1..4]
+meru_5 :: Num n => Int -> [[n]]
+meru_5 k =
+  let f t = zipWith (flip (Safe.atDef 0)) [0,3..] t
+      t0 = reverse (meru_k k)
+  in map (\n -> f (map (drop n) t0)) [0 .. 2]
+
+-- > map sum (meru_5_seq 13)
+meru_5_seq :: Num n => Int -> [[n]]
+meru_5_seq k = concatMap meru_5 [1 .. k]
+
+-- > take 39 meru_5_direct == map sum (meru_5_seq 13)
+meru_5_direct :: Num n => [n]
+meru_5_direct = OEIS.a017817
+
+-- > map (sum . meru_6) [1 .. 21] == [1,1,1,1,1,2,3,4,5,6,8,11,15,20,26,34,45,60,80,106,140]
+meru_6 :: Num n => Int -> [n]
+meru_6 k = zipWith (flip (Safe.atDef 0)) [0..] (every_nth (reverse (meru_k k)) 4)
+
+-- > take 21 meru_6_direct == map (sum . meru_6) [1 .. 21]
+meru_6_direct :: Num n => [n]
+meru_6_direct = OEIS.a003520
+
+-- > take 26 meru_7_direct == [0,1,0,1,0,1,1,1,2,1,3,2,4,4,5,7,7,11,11,16,18,23,29,34,45,52]
+meru_7_direct :: Num n => [n]
+meru_7_direct = OEIS.a001687
+
+-- * <http://anaphoria.com/mos.pdf>
+
+{- | P.13, tanabe {Scala=chin_7}
+
+> ew_scl_find_r ew_mos_13_tanabe_r db
+-}
+ew_mos_13_tanabe_r :: [Rational]
+ew_mos_13_tanabe_r = [1,9/8,81/64,4/3,3/2,27/16,243/128]
+
+-- * <http://anaphoria.com/novavotreediamond.pdf> (Novaro)
+
+ew_novarotreediamond_1 :: ([[Rational]],[[Rational]])
+ew_novarotreediamond_1 =
+  let rem_oct x = if last x /= 2 then error "rem_oct?" else List.drop_last x
+      add_oct x = if last x >= 2 then error "add_oct?" else x ++ [2]
+      r_to_i = List.d_dx_by (/) . add_oct
+      i_to_r = rem_oct . scanl (*) 1
+      r_0 = [1,5/4,4/3,3/2,5/3,7/4]
+      i_0 = r_to_i r_0
+      i = List.rotations i_0
+  in (i,map i_to_r i)
+
+{- | P.1 {Scala=nil}
+
+23-tone 7-limit (2004)
+
+> ew_scl_find_r ew_novarotreediamond_1_r db
+-}
+ew_novarotreediamond_1_r :: [Rational]
+ew_novarotreediamond_1_r = r_normalise (concat (snd ew_novarotreediamond_1))
+
+ew_novarotreediamond_1_scl :: Scala.Scale
+ew_novarotreediamond_1_scl = r_to_scale "ew_novarotreediamond_1" "EW, novavotreediamond.pdf, P.1" ew_novarotreediamond_1_r
+
+-- * <http://anaphoria.com/Pelogflute.pdf>
+
+{- | P.2 {Scala=nil}
+
+9-tone Pelog cycle (1988)
+
+> ew_scl_find_r ew_Pelogflute_2_r db
+-}
+ew_Pelogflute_2_r :: Fractional n => [n]
+ew_Pelogflute_2_r = [1,16/15,64/55,5/4,4/3,16/11,8/5,128/75,20/11]
+
+ew_Pelogflute_2_scl :: Scala.Scale
+ew_Pelogflute_2_scl = r_to_scale "ew_Pelogflute_2" "EW, Pelogflute.pdf, P.2" ew_Pelogflute_2_r
+
+
+-- * <http://anaphoria.com/xen1.pdf>
+
+-- | P.9, Fig. 3
+xen1_fig3 :: (Sbt_Node,Int)
+xen1_fig3 = ((NIL,(1,3),(2,5),(1,2)),5)
+
+-- | P.9, Fig. 4
+xen1_fig4 :: (Sbt_Node,Int)
+xen1_fig4 = ((NIL,(2,5),(5,12),(3,7)),5)
+
+-- * <http://anaphoria.com/xen3b.pdf>
+
+-- | P.3 Turkisk Baglama Scale {11-limit, Scala=nil}
+ew_xen3b_3_gen :: [(Rational,Int)]
+ew_xen3b_3_gen = [(1/(3^.6),12),(1/11,2),(5/3,3)]
+
+ew_xen3b_3_r :: [Rational]
+ew_xen3b_3_r = m3_gen_to_r ew_xen3b_3_gen
+
+ew_xen3b_3_scl :: Scala.Scale
+ew_xen3b_3_scl = r_to_scale "ew_xen3b_3" "EW, xen3b.pdf, P.3" ew_xen3b_3_r
+
+-- > map length xen3b_9_i == [5,7,12,19,31]
+xen3b_9_i :: [[Rational]]
+xen3b_9_i =
+  [[6/5,                                             10/9,                          9/8,                           6/5,                                             10/9]
+  ,[16/15,9/8,                                       10/9,                          9/8,                           16/15,9/8,                                       10/9]
+  ,[16/15,135/128,16/15,                             25/24,16/15,                   16/15,135/128,                 16/15,135/128,16/15,                             25/24,16/15]
+  ,[28/27,36/35,135/128,28/27,36/35,                 25/24,28/27,36/35,             28/27,36/35,135/128,           28/27,36/35,135/128,28/27,36/35,                 25/24,28/27,36/35]
+  ,[64/63,49/48,36/35,45/44,33/32,64/63,49/48,36/35, 45/44,55/54,64/63,49/48,36/35, 64/63,49/48,36/35,45/44,33/32, 64/63,49/48,36/35,45/44,33/32,64/63,49/48,36/35, 45/44,55/54,64/63,49/48,36/35]]
+
+{- | P.9 {SCALA 5=nil 7=ptolemy_idiat 12=nil 19=wilson2 31=wilson_31}
+
+> mapM ew_scl_find_r xen3b_9_r db
+-}
+xen3b_9_r :: [[Rational]]
+xen3b_9_r = map (List.drop_last . scanl (*) 1) xen3b_9_i
+
+-- > map length xen3b_13_i == [5,7,12,17,22]
+xen3b_13_i :: [[Rational]]
+xen3b_13_i =
+  [[7/6,                           8/7,                     9/8,                     7/6,                           8/7]
+  ,[28/27,9/8,                     8/7,                     9/8,                     28/27,9/8,                     8/7]
+  ,[28/27,243/224,28/27,           10/9,36/35,              28/27,243/224,           28/27,243/224,28/27,           10/9,36/35]
+  ,[28/27,36/35,135/128,28/27,     36/35,175/162,36/35,     28/27,36/35,135/128,     28/27,36/35,135/128,28/27,     36/35,175/162,36/35]
+  ,[28/27,36/35,25/24,81/80,28/27, 36/35,25/24,28/27,36/35, 28/27,36/35,25/24,81/80, 28/27,36/35,25/24,81/80,28/27, 36/35,25/24,28/27,36/35]]
+
+-- | P.13 {SCALA 5=slendro5_2 7=ptolemy_diat2 12=nil 17=nil 22=wilson7_4}
+xen3b_13_r :: [[Rational]]
+xen3b_13_r = map (List.drop_last . scanl (*) 1) xen3b_13_i
+
+-- * <http://anaphoria.com/xen3bappendix.pdf>
+
+{- | PP.1-2 {SCALA: 22=wilson7_4}
+
+17,31,41 lattices from XEN3B (1975)
+-}
+ew_xen3b_apx_gen :: [(Int,[M3_Gen])]
+ew_xen3b_apx_gen =
+  [(17,[(1/729,12)
+       ,(5/3,3)
+       ,(11,2)])
+  ,(31,[(1/3,5)
+       ,(5,2),(1/(5*(3^.2)),5)
+       ,(7/(3^.4),5),(1/(7*(3^.4)),5)
+       ,(1/11,5)
+       ,((1/3)*(1/7)*5,2)
+       ,((1/(7*(3^.3))) * 5,2)])
+  ,(41,[(1/(3^.6),12)
+       ,(5/(3^.3),5),(1/(5*(3^.2)),5)
+       ,(7/(3^.4),7),(1/(7*(3^.3)),7)
+       ,(11,5)])
+  ,(22,[(1/3,5)
+       ,(5/(3^.3),5),(1/(5*(3^.2)),5)
+       ,(7/(3^.4),5)
+       ,(7/(3^.3)*5,2)])]
+
+ew_xen3b_apx_r :: [(Int,[Rational])]
+ew_xen3b_apx_r =
+  let f (k,g) = (k,r_normalise (concatMap m3_gen_unfold g))
+  in map f ew_xen3b_apx_gen
+
+-- * <http://anaphoria.com/xen456.pdf>
+
+ew_xen456_7_gen :: [M3_Gen]
+ew_xen456_7_gen = [(25/24,4),(5/3,4),(4/3,4),(16/15,4),(32/25,3)]
+
+{- P.7 {Scala=wilson1}
+
+19-tone "A Scale for Scott" (1976)
+
+> ew_scl_find_r ew_xen456_7_r db -- wilson1
+-}
+ew_xen456_7_r :: [Rational]
+ew_xen456_7_r = m3_gen_to_r ew_xen456_7_gen
+
+ew_xen456_9_gen :: [M3_Gen]
+ew_xen456_9_gen =
+  [(1/(3^.3),4)
+  ,(1/(5*(3^.2)),3)
+  ,(1/(7*3),3)
+  ,(1/11,3)
+  ,(5/(11*3),4)
+  ,(7/11,2)]
+
+{- | P.9 {Scala=nil ; Scala:Rot=wilson11}
+
+19-tone scale for the Clavichord-19 (1976)
+
+> ew_scl_find_r ew_xen456_9_r db
+
+> import qualified Music.Theory.List as List {- hmt -}
+> Scala.scl_find_ji List.is_subset ew_xen456_9_r db -- NIL
+-}
+ew_xen456_9_r :: [Rational]
+ew_xen456_9_r = m3_gen_to_r ew_xen456_9_gen
+
+ew_xen456_9_scl :: Scala.Scale
+ew_xen456_9_scl = r_to_scale "ew_xen456_9" "EW, xen456.pdf, P.9" ew_xen456_9_r
+
+-- * Gems
+
+{- | <http://wilsonarchives.blogspot.com/2010/10/scale-for-rod-poole.html>
+
+13-limit 22-tone scale {Scala=nil}
+
+> ew_scl_find_r ew_poole_r db
+-}
+ew_poole_r :: [Rational]
+ew_poole_r =
+  [1,11*3,7*3/5,13/3,3*3,7/3,11/(3*3),5,7/11,1/3
+  ,11,7/5,13/(3*3),3,7/(3*3),11/(3*3*3),5/3,3*3*3,7,11/3,5*3,7*3/11]
+
+ew_poole_scl :: Scala.Scale
+ew_poole_scl = r_to_scale "ew_poole" "EW, 2010/10/scale-for-rod-poole.html" ew_poole_r
+
+{- | <http://wilsonarchives.blogspot.com/2014/05/an-11-limit-centaur-implied-in-wilson.html>
+
+11-limit 17-tone scale {Scala=wilcent17}
+
+> ew_scl_find_r ew_centaur17_r db
+-}
+ew_centaur17_r :: [Rational]
+ew_centaur17_r = [1,11/(3*7),11/5,3*3,7/3,11/(3*3),5,1/3,11,11/(3*5),3,11/7,11/(3*3*3),5/3,7,11/3,3*5]
+
+{- | <http://wilsonarchives.blogspot.com/2018/03/an-unusual-22-tone-7-limit-tuning.html>
+
+7-limit 22-tone scale {Scala=nil}
+
+> ew_scl_find_r ew_two_22_7_r db
+-}
+ew_two_22_7_r :: [Rational]
+ew_two_22_7_r =
+  [1,9/35,1/15,35,9,7/3,3/5,315,245/3,21,27/5
+  ,7/5,735,189,49,63/5,5/3,3/7,1/9,1/35,15,35/9]
+
+ew_two_22_7_scl :: Scala.Scale
+ew_two_22_7_scl = r_to_scale "ew_two_22_7" "EW, 2018/03/an-unusual-22-tone-7-limit-tuning.html" ew_two_22_7_r
+
+-- * Db
+
+{- | Scales /not/ present in the standard scala file set.
+
+> mapM_ (Scala.scale_wr_dir "/home/rohan/sw/hmt/data/scl/") ew_scl_db
+> map Scala.scale_name ew_scl_db
+-}
+ew_scl_db :: [Scala.Scale]
+ew_scl_db =
+  [ew_1357_3_scl
+  ,ew_el12_7_scl
+  ,ew_el12_12_scl
+  ,ew_hel_12_scl
+  ,ew_novarotreediamond_1_scl
+  ,ew_Pelogflute_2_scl
+  ,ew_xen3b_3_scl
+  ,ew_xen456_9_scl
+  ,ew_poole_scl
+  ,ew_two_22_7_scl
+  ]
+
+-- Local Variables:
+-- truncate-lines:t
+-- End:
diff --git a/Music/Theory/Tuple.hs b/Music/Theory/Tuple.hs
deleted file mode 100644
--- a/Music/Theory/Tuple.hs
+++ /dev/null
@@ -1,319 +0,0 @@
--- | Tuple functions.
---
--- Uniform tuples have types 'T2', 'T3' etc. and functions names are
--- prefixed @t2_@ etc.
---
--- Heterogenous tuples (products) are prefixed @p2_@ etc.
-module Music.Theory.Tuple where
-
--- * P2 (2-product)
-
-p2_swap :: (s,t) -> (t,s)
-p2_swap (i,j) = (j,i)
-
--- * T2 (2-tuple, regular)
-
--- | Uniform two-tuple.
-type T2 a = (a,a)
-
-t2_from_list :: [t] -> T2 t
-t2_from_list l = case l of {[p,q] -> (p,q);_ -> error "t2_from_list"}
-
-t2_to_list :: T2 a -> [a]
-t2_to_list (i,j) = [i,j]
-
-t2_swap :: T2 t -> T2 t
-t2_swap = p2_swap
-
-t2_map :: (p -> q) -> T2 p -> T2 q
-t2_map f (p,q) = (f p,f q)
-
-t2_zipWith :: (p -> q -> r) -> T2 p -> T2 q -> T2 r
-t2_zipWith f (p,q) (p',q') = (f p p',f q q')
-
-t2_infix :: (a -> a -> b) -> T2 a -> b
-t2_infix f (i,j) = i `f` j
-
--- | Infix 'mappend'.
---
--- > t2_join ([1,2],[3,4]) == [1,2,3,4]
-t2_join :: Monoid m => T2 m -> m
-t2_join = t2_infix mappend
-
-t2_concat :: [T2 [a]] -> T2 [a]
-t2_concat = t2_map mconcat . unzip
-
-t2_sort :: Ord t => (t,t) -> (t,t)
-t2_sort (p,q) = (min p q,max p q)
-
--- * P3 (3-product)
-
--- | Left rotation.
---
--- > p3_rotate_left (1,2,3) == (2,3,1)
-p3_rotate_left :: (s,t,u) -> (t,u,s)
-p3_rotate_left (i,j,k) = (j,k,i)
-
-p3_fst :: (a,b,c) -> a
-p3_fst (a,_,_) = a
-
-p3_snd :: (a,b,c) -> b
-p3_snd (_,b,_) = b
-
-p3_third :: (a,b,c) -> c
-p3_third (_,_,c) = c
-
--- * T3 (3 triple, regular)
-
-type T3 a = (a,a,a)
-
-t3_from_list :: [t] -> T3 t
-t3_from_list l = case l of {[p,q,r] -> (p,q,r);_ -> error "t3_from_list"}
-
-t3_to_list :: T3 a -> [a]
-t3_to_list (i,j,k) = [i,j,k]
-
-t3_rotate_left :: T3 t -> T3 t
-t3_rotate_left = p3_rotate_left
-
-t3_fst :: T3 t -> t
-t3_fst = p3_fst
-
-t3_snd :: T3 t -> t
-t3_snd = p3_snd
-
-t3_third :: T3 t -> t
-t3_third = p3_third
-
-t3_map :: (p -> q) -> T3 p -> T3 q
-t3_map f (p,q,r) = (f p,f q,f r)
-
-t3_zipWith :: (p -> q -> r) -> T3 p -> T3 q -> T3 r
-t3_zipWith f (p,q,r) (p',q',r') = (f p p',f q q',f r r')
-
-t3_infix :: (a -> a -> a) -> T3 a -> a
-t3_infix f (i,j,k) = (i `f` j) `f` k
-
-t3_join :: T3 [a] -> [a]
-t3_join = t3_infix (++)
-
--- * P4 (4-product)
-
-p4_fst :: (a,b,c,d) -> a
-p4_fst (a,_,_,_) = a
-
-p4_snd :: (a,b,c,d) -> b
-p4_snd (_,b,_,_) = b
-
-p4_third :: (a,b,c,d) -> c
-p4_third (_,_,c,_) = c
-
-p4_fourth :: (a,b,c,d) -> d
-p4_fourth (_,_,_,d) = d
-
--- * T4 (4-tuple, regular)
-
-type T4 a = (a,a,a,a)
-
-t4_from_list :: [t] -> T4 t
-t4_from_list l = case l of {[p,q,r,s] -> (p,q,r,s); _ -> error "t4_from_list"}
-
-t4_to_list :: T4 t -> [t]
-t4_to_list (p,q,r,s) = [p,q,r,s]
-
-t4_fst :: T4 t -> t
-t4_fst = p4_fst
-
-t4_snd :: T4 t -> t
-t4_snd = p4_snd
-
-t4_third :: T4 t -> t
-t4_third = p4_third
-
-t4_fourth :: T4 t -> t
-t4_fourth = p4_fourth
-
-t4_map :: (p -> q) -> T4 p -> T4 q
-t4_map f (p,q,r,s) = (f p,f q,f r,f s)
-
-t4_zipWith :: (p -> q -> r) -> T4 p -> T4 q -> T4 r
-t4_zipWith f (p,q,r,s) (p',q',r',s') = (f p p',f q q',f r r',f s s')
-
-t4_infix :: (a -> a -> a) -> T4 a -> a
-t4_infix f (i,j,k,l) = ((i `f` j) `f` k) `f` l
-
-t4_join :: T4 [a] -> [a]
-t4_join = t4_infix (++)
-
--- * P5 (5-product)
-
-p5_fst :: (a,b,c,d,e) -> a
-p5_fst (a,_,_,_,_) = a
-
-p5_snd :: (a,b,c,d,e) -> b
-p5_snd (_,b,_,_,_) = b
-
-p5_third :: (a,b,c,d,e) -> c
-p5_third (_,_,c,_,_) = c
-
-p5_fourth :: (a,b,c,d,e) -> d
-p5_fourth (_,_,_,d,_) = d
-
-p5_fifth :: (a,b,c,d,e) -> e
-p5_fifth (_,_,_,_,e) = e
-
-p5_from_list :: (t -> t1, t -> t2, t -> t3, t -> t4, t -> t5) -> [t] -> (t1,t2,t3,t4,t5)
-p5_from_list (f1,f2,f3,f4,f5) l =
-  case l of
-    [c1,c2,c3,c4,c5] -> (f1 c1,f2 c2,f3 c3,f4 c4,f5 c5)
-    _ -> error "p5_from_list"
-
-
-p5_to_list :: (t1 -> t, t2 -> t, t3 -> t, t4 -> t, t5 -> t) -> (t1, t2, t3, t4, t5) -> [t]
-p5_to_list (f1,f2,f3,f4,f5) (c1,c2,c3,c4,c5) = [f1 c1,f2 c2,f3 c3,f4 c4,f5 c5]
-
--- * T5 (5-tuple, regular)
-
-type T5 a = (a,a,a,a,a)
-
-t5_from_list :: [t] -> T5 t
-t5_from_list l = case l of {[p,q,r,s,t] -> (p,q,r,s,t); _ -> error "t5_from_list"}
-
-t5_to_list :: T5 t -> [t]
-t5_to_list (p,q,r,s,t) = [p,q,r,s,t]
-
-t5_map :: (p -> q) -> T5 p -> T5 q
-t5_map f (p,q,r,s,t) = (f p,f q,f r,f s,f t)
-
-t5_fst :: T5 t -> t
-t5_fst (p,_,_,_,_) = p
-
-t5_snd :: T5 t -> t
-t5_snd (_,q,_,_,_) = q
-
-t5_fourth :: T5 t -> t
-t5_fourth (_,_,_,t,_) = t
-
-t5_fifth :: T5 t -> t
-t5_fifth (_,_,_,_,u) = u
-
-t5_infix :: (a -> a -> a) -> T5 a -> a
-t5_infix f (i,j,k,l,m) = (((i `f` j) `f` k) `f` l) `f` m
-
-t5_join :: T5 [a] -> [a]
-t5_join = t5_infix (++)
-
--- * P6 (6-product)
-
-p6_fst :: (a,b,c,d,e,f) -> a
-p6_fst (a,_,_,_,_,_) = a
-
-p6_snd :: (a,b,c,d,e,f) -> b
-p6_snd (_,b,_,_,_,_) = b
-
-p6_third :: (a,b,c,d,e,f) -> c
-p6_third (_,_,c,_,_,_) = c
-
-p6_fourth :: (a,b,c,d,e,f) -> d
-p6_fourth (_,_,_,d,_,_) = d
-
-p6_fifth :: (a,b,c,d,e,f) -> e
-p6_fifth (_,_,_,_,e,_) = e
-
-p6_sixth :: (a,b,c,d,e,f) -> f
-p6_sixth (_,_,_,_,_,f) = f
-
--- * T6 (6-tuple, regular)
-
-type T6 a = (a,a,a,a,a,a)
-
-t6_from_list :: [t] -> T6 t
-t6_from_list l = case l of {[p,q,r,s,t,u] -> (p,q,r,s,t,u);_ -> error "t6_from_list"}
-
-t6_to_list :: T6 t -> [t]
-t6_to_list (p,q,r,s,t,u) = [p,q,r,s,t,u]
-
-t6_map :: (p -> q) -> T6 p -> T6 q
-t6_map f (p,q,r,s,t,u) = (f p,f q,f r,f s,f t,f u)
-
--- * T7 (7-tuple, regular)
-
-type T7 a = (a,a,a,a,a,a,a)
-
-t7_to_list :: T7 t -> [t]
-t7_to_list (p,q,r,s,t,u,v) = [p,q,r,s,t,u,v]
-
-t7_map :: (p -> q) -> T7 p -> T7 q
-t7_map f (p,q,r,s,t,u,v) = (f p,f q,f r,f s,f t,f u,f v)
-
--- * T8 (8-tuple, regular)
-
-type T8 a = (a,a,a,a,a,a,a,a)
-
-t8_to_list :: T8 t -> [t]
-t8_to_list (p,q,r,s,t,u,v,w) = [p,q,r,s,t,u,v,w]
-
-t8_map :: (p -> q) -> T8 p -> T8 q
-t8_map f (p,q,r,s,t,u,v,w) = (f p,f q,f r,f s,f t,f u,f v,f w)
-
--- * P8 (8-product)
-
-p8_third :: (a,b,c,d,e,f,g,h) -> c
-p8_third (_,_,c,_,_,_,_,_) = c
-
--- * T9 (9-tuple, regular)
-
-type T9 a = (a,a,a,a,a,a,a,a,a)
-
-t9_to_list :: T9 t -> [t]
-t9_to_list (p,q,r,s,t,u,v,w,x) = [p,q,r,s,t,u,v,w,x]
-
-t9_map :: (p -> q) -> T9 p -> T9 q
-t9_map f (p,q,r,s,t,u,v,w,x) = (f p,f q,f r,f s,f t,f u,f v,f w,f x)
-
--- * T10 (10-tuple, regular)
-
-type T10 a = (a,a,a,a,a,a,a,a,a,a)
-
-t10_to_list :: T10 t -> [t]
-t10_to_list (p,q,r,s,t,u,v,w,x,y) = [p,q,r,s,t,u,v,w,x,y]
-
-t10_map :: (p -> q) -> T10 p -> T10 q
-t10_map f (p,q,r,s,t,u,v,w,x,y) = (f p,f q,f r,f s,f t,f u,f v,f w,f x,f y)
-
--- * T11 (11-tuple, regular)
-
-type T11 a = (a,a,a,a,a,a,a,a,a,a,a)
-
-t11_to_list :: T11 t -> [t]
-t11_to_list (p,q,r,s,t,u,v,w,x,y,z) = [p,q,r,s,t,u,v,w,x,y,z]
-
-t11_map :: (p -> q) -> T11 p -> T11 q
-t11_map f (p,q,r,s,t,u,v,w,x,y,z) = (f p,f q,f r,f s,f t,f u,f v,f w,f x,f y,f z)
-
--- * T12 (12-tuple, regular)
-
-type T12 t = (t,t,t,t,t,t,t,t,t,t,t,t)
-
-t12_to_list :: T12 t -> [t]
-t12_to_list (p,q,r,s,t,u,v,w,x,y,z,a) = [p,q,r,s,t,u,v,w,x,y,z,a]
-
-t12_from_list :: [t] -> T12 t
-t12_from_list l =
-    case l of
-      [p,q,r,s,t,u,v,w,x,y,z,a] -> (p,q,r,s,t,u,v,w,x,y,z,a)
-      _ -> error "t12_from_list"
-
--- | 'foldr1' of 't12_to_list'.
---
--- > t12_foldr1 (+) (1,2,3,4,5,6,7,8,9,10,11,12) == 78
-t12_foldr1 :: (t -> t -> t) -> T12 t -> t
-t12_foldr1 f = foldr1 f . t12_to_list
-
--- | 'sum' of 't12_to_list'.
---
--- > t12_sum (1,2,3,4,5,6,7,8,9,10,11,12) == 78
-t12_sum :: Num n => T12 n -> n
-t12_sum t =
-    let (n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12) = t
-    in n1 + n2 + n3 + n4 + n5 + n6 + n7 + n8 + n9 + n10 + n11 + n12
diff --git a/Music/Theory/Unicode.hs b/Music/Theory/Unicode.hs
deleted file mode 100644
--- a/Music/Theory/Unicode.hs
+++ /dev/null
@@ -1,239 +0,0 @@
--- | <http://www.unicode.org/charts/PDF/U1D100.pdf>
---
--- These symbols are in <http://www.gnu.org/software/freefont/>,
--- debian=ttf-freefont.
-module Music.Theory.Unicode where
-
-import Data.List {- base -}
-import Numeric {- base -}
-
-import qualified Text.CSV.Lazy.String as C {- lazy-csv -}
-
-import qualified Music.Theory.IO as T {- hmt -}
-import qualified Music.Theory.List as T {- hmt -}
-import qualified Music.Theory.Read as T {- hmt -}
-
--- * Non-music
-
--- | Unicode non breaking hypen character.
---
--- > non_breaking_hypen == '‑'
-non_breaking_hypen :: Char
-non_breaking_hypen = toEnum 0x2011
-
--- | Unicode non breaking space character.
---
--- > non_breaking_space == ' '
-non_breaking_space :: Char
-non_breaking_space = toEnum 0x00A0
-
--- * Music
-
-type Unicode_Index = Int
-type Unicode_Range = (Unicode_Index,Unicode_Index)
-type Unicode_Point = (Unicode_Index,String)
-type Unicode_Table = [Unicode_Point]
-
--- > putStrLn$ map (toEnum . fst) (concat unicode)
-unicode :: [Unicode_Table]
-unicode = [accidentals,notes,rests,clefs]
-
--- > putStrLn$ concatMap (unicode_table_hs . flip unicode_table_block tbl) accidentals_rng_set
-accidentals_rng_set :: [Unicode_Range]
-accidentals_rng_set = [(0x266D,0x266F),(0x1D12A,0x1D133)]
-
--- | UNICODE accidental symbols.
---
--- > let r = "♭♮♯𝄪𝄫𝄬𝄭𝄮𝄯𝄰𝄱𝄲𝄳" in map (toEnum . fst) accidentals == r
-accidentals :: Unicode_Table
-accidentals =
-    [(0x266D,"MUSIC FLAT SIGN")
-    ,(0x266E,"MUSIC NATURAL SIGN")
-    ,(0x266F,"MUSIC SHARP SIGN")
-    ,(0x1D12A,"MUSICAL SYMBOL DOUBLE SHARP")
-    ,(0x1D12B,"MUSICAL SYMBOL DOUBLE FLAT")
-    ,(0x1D12C,"MUSICAL SYMBOL FLAT UP")
-    ,(0x1D12D,"MUSICAL SYMBOL FLAT DOWN")
-    ,(0x1D12E,"MUSICAL SYMBOL NATURAL UP")
-    ,(0x1D12F,"MUSICAL SYMBOL NATURAL DOWN")
-    ,(0x1D130,"MUSICAL SYMBOL SHARP UP")
-    ,(0x1D131,"MUSICAL SYMBOL SHARP DOWN")
-    ,(0x1D132,"MUSICAL SYMBOL QUARTER TONE SHARP")
-    ,(0x1D133,"MUSICAL SYMBOL QUARTER TONE FLAT")]
-
--- > putStrLn$ unicode_table_hs (unicode_table_block notes_rng tbl)
-notes_rng :: Unicode_Range
-notes_rng = (0x1D15C,0x1D164)
-
--- | UNICODE note duration symbols.
---
--- > let r = "𝅜𝅝𝅗𝅥𝅘𝅥𝅘𝅥𝅮𝅘𝅥𝅯𝅘𝅥𝅰𝅘𝅥𝅱𝅘𝅥𝅲" in map (toEnum . fst) notes == r
-notes :: Unicode_Table
-notes =
-    [(0x1D15C,"MUSICAL SYMBOL BREVE")
-    ,(0x1D15D,"MUSICAL SYMBOL WHOLE NOTE")
-    ,(0x1D15E,"MUSICAL SYMBOL HALF NOTE")
-    ,(0x1D15F,"MUSICAL SYMBOL QUARTER NOTE")
-    ,(0x1D160,"MUSICAL SYMBOL EIGHTH NOTE")
-    ,(0x1D161,"MUSICAL SYMBOL SIXTEENTH NOTE")
-    ,(0x1D162,"MUSICAL SYMBOL THIRTY-SECOND NOTE")
-    ,(0x1D163,"MUSICAL SYMBOL SIXTY-FOURTH NOTE")
-    ,(0x1D164,"MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH NOTE")]
-
--- > putStrLn$ unicode_table_hs (unicode_table_block rests_rng tbl)
-rests_rng :: Unicode_Range
-rests_rng = (0x1D13B,0x1D142)
-
--- | UNICODE rest symbols.
---
--- > let r = "𝄻𝄼𝄽𝄾𝄿𝅀𝅁𝅂" in map (toEnum . fst) rests == r
-rests :: Unicode_Table
-rests =
-    [(0x1D13B,"MUSICAL SYMBOL WHOLE REST")
-    ,(0x1D13C,"MUSICAL SYMBOL HALF REST")
-    ,(0x1D13D,"MUSICAL SYMBOL QUARTER REST")
-    ,(0x1D13E,"MUSICAL SYMBOL EIGHTH REST")
-    ,(0x1D13F,"MUSICAL SYMBOL SIXTEENTH REST")
-    ,(0x1D140,"MUSICAL SYMBOL THIRTY-SECOND REST")
-    ,(0x1D141,"MUSICAL SYMBOL SIXTY-FOURTH REST")
-    ,(0x1D142,"MUSICAL SYMBOL ONE HUNDRED TWENTY-EIGHTH REST")]
-
--- > map toEnum [0x1D15E,0x1D16D,0x1D16D] == "𝅗𝅥𝅭𝅭"
-augmentation_dot :: Unicode_Point
-augmentation_dot = (0x1D16D, "MUSICAL SYMBOL COMBINING AUGMENTATION DOT")
-
--- > putStrLn$ unicode_table_hs (unicode_table_block clefs_rng tbl)
-clefs_rng :: Unicode_Range
-clefs_rng = (0x1D11E,0x1D126)
-
--- | UNICODE clef symbols.
---
--- > let r = "𝄞𝄟𝄠𝄡𝄢𝄣𝄤𝄥𝄦" in map (toEnum . fst) clefs == r
-clefs :: Unicode_Table
-clefs =
-    [(0x1D11E,"MUSICAL SYMBOL G CLEF")
-    ,(0x1D11F,"MUSICAL SYMBOL G CLEF OTTAVA ALTA")
-    ,(0x1D120,"MUSICAL SYMBOL G CLEF OTTAVA BASSA")
-    ,(0x1D121,"MUSICAL SYMBOL C CLEF")
-    ,(0x1D122,"MUSICAL SYMBOL F CLEF")
-    ,(0x1D123,"MUSICAL SYMBOL F CLEF OTTAVA ALTA")
-    ,(0x1D124,"MUSICAL SYMBOL F CLEF OTTAVA BASSA")
-    ,(0x1D125,"MUSICAL SYMBOL DRUM CLEF-1")
-    ,(0x1D126,"MUSICAL SYMBOL DRUM CLEF-2")]
-
--- > putStrLn$ unicode_table_hs (unicode_table_block tbl notehead_rng)
-notehead_rng :: Unicode_Range
-notehead_rng = (0x1D143,0x1D15B)
-
--- | UNICODE notehead symbols.
---
--- > let r = "𝅃𝅄𝅅𝅆𝅇𝅈𝅉𝅊𝅋𝅌𝅍𝅎𝅏𝅐𝅑𝅒𝅓𝅔𝅕𝅖𝅗𝅘𝅙𝅚𝅛" in map (toEnum . fst) noteheads == r
-noteheads :: Unicode_Table
-noteheads =
-    [(0x1d143,"MUSICAL SYMBOL X NOTEHEAD")
-    ,(0x1d144,"MUSICAL SYMBOL PLUS NOTEHEAD")
-    ,(0x1d145,"MUSICAL SYMBOL CIRCLE X NOTEHEAD")
-    ,(0x1d146,"MUSICAL SYMBOL SQUARE NOTEHEAD WHITE")
-    ,(0x1d147,"MUSICAL SYMBOL SQUARE NOTEHEAD BLACK")
-    ,(0x1d148,"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP WHITE")
-    ,(0x1d149,"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP BLACK")
-    ,(0x1d14a,"MUSICAL SYMBOL TRIANGLE NOTEHEAD LEFT WHITE")
-    ,(0x1d14b,"MUSICAL SYMBOL TRIANGLE NOTEHEAD LEFT BLACK")
-    ,(0x1d14c,"MUSICAL SYMBOL TRIANGLE NOTEHEAD RIGHT WHITE")
-    ,(0x1d14d,"MUSICAL SYMBOL TRIANGLE NOTEHEAD RIGHT BLACK")
-    ,(0x1d14e,"MUSICAL SYMBOL TRIANGLE NOTEHEAD DOWN WHITE")
-    ,(0x1d14f,"MUSICAL SYMBOL TRIANGLE NOTEHEAD DOWN BLACK")
-    ,(0x1d150,"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP RIGHT WHITE")
-    ,(0x1d151,"MUSICAL SYMBOL TRIANGLE NOTEHEAD UP RIGHT BLACK")
-    ,(0x1d152,"MUSICAL SYMBOL MOON NOTEHEAD WHITE")
-    ,(0x1d153,"MUSICAL SYMBOL MOON NOTEHEAD BLACK")
-    ,(0x1d154,"MUSICAL SYMBOL TRIANGLE-ROUND NOTEHEAD DOWN WHITE")
-    ,(0x1d155,"MUSICAL SYMBOL TRIANGLE-ROUND NOTEHEAD DOWN BLACK")
-    ,(0x1d156,"MUSICAL SYMBOL PARENTHESIS NOTEHEAD")
-    ,(0x1d157,"MUSICAL SYMBOL VOID NOTEHEAD")
-    ,(0x1d158,"MUSICAL SYMBOL NOTEHEAD BLACK")
-    ,(0x1d159,"MUSICAL SYMBOL NULL NOTEHEAD")
-    ,(0x1d15a,"MUSICAL SYMBOL CLUSTER NOTEHEAD WHITE")
-    ,(0x1d15b,"MUSICAL SYMBOL CLUSTER NOTEHEAD BLACK")]
-
--- > map toEnum [0x1D143,0x1D165] == "𝅃𝅥"
-stem :: Unicode_Point
-stem = (0x1D165, "MUSICAL SYMBOL COMBINING STEM")
-
--- > putStrLn$ unicode_table_hs (unicode_table_block dynamics_rng tbl)
-dynamics_rng :: Unicode_Range
-dynamics_rng = (0x1D18C,0x1D193)
-
--- > map (toEnum . fst) dynamics == "𝆌𝆍𝆎𝆏𝆐𝆑𝆒𝆓"
-dynamics :: Unicode_Table
-dynamics =
-    [(0x1d18c,"MUSICAL SYMBOL RINFORZANDO")
-    ,(0x1d18d,"MUSICAL SYMBOL SUBITO")
-    ,(0x1d18e,"MUSICAL SYMBOL Z")
-    ,(0x1d18f,"MUSICAL SYMBOL PIANO")
-    ,(0x1d190,"MUSICAL SYMBOL MEZZO")
-    ,(0x1d191,"MUSICAL SYMBOL FORTE")
-    ,(0x1d192,"MUSICAL SYMBOL CRESCENDO")
-    ,(0x1d193,"MUSICAL SYMBOL DECRESCENDO")]
-
--- > putStrLn$ unicode_table_hs (unicode_table_block articulations_rng tbl)
-articulations_rng :: Unicode_Range
-articulations_rng = (0x1D17B,0x1D18B)
-
--- > putStrLn (map (toEnum . fst) articulations :: String)
-articulations :: Unicode_Table
-articulations =
-    [(0x1d17b,"MUSICAL SYMBOL COMBINING ACCENT")
-    ,(0x1d17c,"MUSICAL SYMBOL COMBINING STACCATO")
-    ,(0x1d17d,"MUSICAL SYMBOL COMBINING TENUTO")
-    ,(0x1d17e,"MUSICAL SYMBOL COMBINING STACCATISSIMO")
-    ,(0x1d17f,"MUSICAL SYMBOL COMBINING MARCATO")
-    ,(0x1d180,"MUSICAL SYMBOL COMBINING MARCATO-STACCATO")
-    ,(0x1d181,"MUSICAL SYMBOL COMBINING ACCENT-STACCATO")
-    ,(0x1d182,"MUSICAL SYMBOL COMBINING LOURE")
-    ,(0x1d183,"MUSICAL SYMBOL ARPEGGIATO UP")
-    ,(0x1d184,"MUSICAL SYMBOL ARPEGGIATO DOWN")
-    ,(0x1d185,"MUSICAL SYMBOL COMBINING DOIT")
-    ,(0x1d186,"MUSICAL SYMBOL COMBINING RIP")
-    ,(0x1d187,"MUSICAL SYMBOL COMBINING FLIP")
-    ,(0x1d188,"MUSICAL SYMBOL COMBINING SMEAR")
-    ,(0x1d189,"MUSICAL SYMBOL COMBINING BEND")
-    ,(0x1d18a,"MUSICAL SYMBOL COMBINING DOUBLE TONGUE")
-    ,(0x1d18b,"MUSICAL SYMBOL COMBINING TRIPLE TONGUE")]
-
--- * Blocks
-
-type Unicode_Block = (Unicode_Range,String)
-
--- > putStrLn$ unicode_table_hs (concatMap (flip unicode_table_block tbl . fst) unicode_blocks)
-unicode_blocks :: [Unicode_Block]
-unicode_blocks =
-    [((0x1B00,0x1B7F),"Balinese")
-    ,((0x2200,0x22FF),"Mathematical Operators")
-    ,((0x25A0,0x25FF),"Geometric Shapes")
-    ,((0x1D000,0x1D0FF),"Byzantine Musical Symbols")
-    ,((0x1D100,0x1D1FF),"Musical Symbols")
-    ,((0x1D200,0x1D24F),"Ancient Greek Musical Notation")]
-
--- * Table
-
--- | <http://unicode.org/Public/8.0.0/ucd/UnicodeData.txt>
---
--- > let fn = "/home/rohan/data/unicode.org/Public/8.0.0/ucd/UnicodeData.txt"
--- > tbl <- unicode_data_table_read fn
--- > length tbl == 29215
-unicode_data_table_read :: FilePath -> IO Unicode_Table
-unicode_data_table_read fn = do
-  s <- T.read_file_utf8 fn
-  let t = C.fromCSVTable (C.csvTable (C.parseDSV False ';' s))
-      f x = (T.read_hex_err (x !! 0),x !! 1)
-  return (map f t)
-
-unicode_table_block :: (Int,Int) -> Unicode_Table -> Unicode_Table
-unicode_table_block (l,r) = takeWhile ((<= r) . fst) . dropWhile ((< l) . fst)
-
-unicode_point_hs :: Unicode_Point -> String
-unicode_point_hs (n,s) = concat ["(0x",showHex n "",",\"",s,"\")"]
-
-unicode_table_hs :: Unicode_Table -> String
-unicode_table_hs = T.bracket ('[',']') . intercalate "," . map unicode_point_hs
diff --git a/Music/Theory/Wyschnegradsky.hs b/Music/Theory/Wyschnegradsky.hs
--- a/Music/Theory/Wyschnegradsky.hs
+++ b/Music/Theory/Wyschnegradsky.hs
@@ -3,13 +3,14 @@
 
 import Data.Char {- base -}
 import Data.List {- list -}
-import Data.List.Split {- split -}
 import Data.Maybe {- base -}
 
-import Music.Theory.List {- hmt -}
-import Music.Theory.Pitch {- hmt -}
-import Music.Theory.Pitch.Spelling.Table {- hmt -}
+import qualified Data.List.Split as Split {- split -}
 
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Pitch as Pitch {- hmt -}
+import qualified Music.Theory.Pitch.Spelling.Table as Spelling {- hmt -}
+
 -- | In a modulo /m/ system, normalise step increments to be either -1
 -- or 1.  Non steps raise an error.
 --
@@ -27,7 +28,7 @@
 -- > map parse_num_sign ["2+","4-"] == [2,-4]
 parse_num_sign :: (Num n, Read n) => String -> n
 parse_num_sign s =
-    case separate_last s of
+    case List.separate_last s of
       (n,'+') -> read n
       (n,'-') -> negate (read n)
       _ -> error "parse_num_sign"
@@ -46,9 +47,9 @@
 parse_vec :: Num n => Maybe Int -> n -> String -> [n]
 parse_vec n m =
     let f = case n of
-              Just i -> dx_d m . take i . cycle
-              Nothing -> dx_d m
-    in dropRight 1 . f . concatMap (vec_expand . parse_num_sign) . splitOn ","
+              Just i -> List.dx_d m . take i . cycle
+              Nothing -> List.dx_d m
+    in List.dropRight 1 . f . concatMap (vec_expand . parse_num_sign) . Split.splitOn ","
 
 -- | Modulo addition.
 add_m :: Integral a => a -> a -> a -> a
@@ -82,13 +83,13 @@
 seq_group :: Int -> Int -> Seq a -> [[a]]
 seq_group c_div r_div s =
     case s of
-      Circumferential c -> chunksOf c_div c
-      Radial r -> transpose (chunksOf r_div r)
+      Circumferential c -> Split.chunksOf c_div c
+      Radial r -> transpose (Split.chunksOf r_div r)
 
 -- | Printer for pitch-class segments.
 iw_pc_pp :: Integral n => String -> [[n]] -> IO ()
 iw_pc_pp sep =
-    let f = pitch_pp_opt (False,False) . octpc_to_pitch pc_spell_ks . (,) 4
+    let f = Pitch.pitch_pp_opt (False,False) . Pitch.octpc_to_pitch Spelling.pc_spell_ks . (,) 4
     in putStrLn . intercalate sep . map (unwords . map f)
 
 -- * U3
@@ -133,7 +134,7 @@
 -- > let f = parse_vec Nothing 0 in map (\(p,q) -> (f p,f q)) u3_vec_text_rw
 --
 -- > let f (c,r) = putStrLn (unlines ["C: " ++ c,"R: " ++ r])
--- > in mapM_ f (interleave u3_vec_text_iw u3_vec_text_rw)
+-- > mapM_ f (List.interleave u3_vec_text_iw u3_vec_text_rw)
 u3_vec_text_rw :: [(String, String)]
 u3_vec_text_rw =
     [("4+,3-,5+,3-,3+"
@@ -160,7 +161,7 @@
 u3_vec_ix :: Num n => ([[n]],[[n]])
 u3_vec_ix =
     let f (p,q) = [parse_vec Nothing 0 p,parse_vec Nothing 0 q]
-        [c,r] = transpose (map f u3_vec_text_rw)
+        (c,r) = List.firstSecond (transpose (map f u3_vec_text_rw))
     in (c,r)
 
 -- | Radial indices (ie. each /ray/ as an index sequence).
@@ -170,7 +171,7 @@
 u3_ix_radial =
     let (c,r) = u3_vec_ix
         r' = zipWith replicate (map length c) r
-    in zipWith (\p q -> map (add_m 6 p) q) (concat c) (concat r')
+    in zipWith (map . add_m 6) (concat c) (concat r')
 
 -- | Colour names in index sequence.
 u3_clr_nm :: [String]
@@ -207,7 +208,7 @@
     map length .
     group .
     map (normalise_step 6) .
-    d_dx .
+    List.d_dx .
     map u3_ch_ix .
     filter (not . isSpace)
 
@@ -263,7 +264,7 @@
             ,"#c2ba3d","#a2a367"
             ,"#537a77","#203342"
             ,"#84525e","#bc6460"]
-        n = interleave [6,4,2,0,10,8] [5,3,1,11,9,7] :: [Int]
+        n = List.interleave [6,4,2,0,10,8] [5,3,1,11,9,7] :: [Int]
     in map snd (sort (zip n c))
 
 -- | RGB form of colours.
@@ -302,7 +303,7 @@
 
 -- > iw_pc_pp "|" [u11_gen_seq 7 18 [5]]
 u11_gen_seq :: Integral i => i -> Int -> [i] -> [i]
-u11_gen_seq z n = map (`mod` 12) . take n . dx_d z . cycle
+u11_gen_seq z n = map (`mod` 12) . take n . List.dx_d z . cycle
 
 u11_seq_rule :: Integral i => Maybe Int -> [i]
 u11_seq_rule n = u11_gen_seq 0 18 (maybe [-1] (\x -> replicate x (-1) ++ [5]) n)
diff --git a/Music/Theory/Xenakis/S4.hs b/Music/Theory/Xenakis/S4.hs
--- a/Music/Theory/Xenakis/S4.hs
+++ b/Music/Theory/Xenakis/S4.hs
@@ -5,8 +5,8 @@
 
 import Data.List {- base -}
 import Data.Maybe {- base -}
-import qualified Data.Permute as P {- permutation -}
 
+import qualified Music.Theory.List as T
 import qualified Music.Theory.Permutations as T
 
 -- * S4 notation
@@ -76,30 +76,29 @@
 > import qualified Music.Theory.List as T
 
 > let r = [D,Q12,Q4, E,Q8,Q2, E2,Q7,Q4, D2,Q3,Q11, L2,Q7,Q2, L,Q8,Q11]
-> in (take 18 (fib_proc l_on D Q12) == r,T.duplicates r == [Q2,Q4,Q7,Q8,Q11])
+> (take 18 (fib_proc l_on D Q12) == r,T.duplicates r == [Q2,Q4,Q7,Q8,Q11])
 
 Beginning E then G2 no Q nodes are visited.
 
 > let r = [E,G2,L2,C,G,D,E,B,D2,L,G,C,L2,E2,D2,B]
-> in (take 16 (fib_proc l_on E G2) == r,T.duplicates r == [B,C,D2,E,G,L2])
+> (take 16 (fib_proc l_on E G2) == r,T.duplicates r == [B,C,D2,E,G,L2])
 
-> import Music.Theory.List
-> let [a,b] = take 2 (segments 18 18 (fib_proc l_on D Q12)) in a == b
+> let [a,b] = take 2 (T.segments 18 18 (fib_proc l_on D Q12)) in a == b
 
 The prime numbers that are not factors of 18 are {1,5,7,11,13,17}.
 They form a closed group under modulo 18 multiplication.
 
-> let {n = [5,7,11,13,17]
->     ;r = [(5,7,17),(5,11,1),(5,13,11),(5,17,13)
->          ,(7,11,5),(7,13,1),(7,17,11)
->          ,(11,13,17),(11,17,7)
->          ,(13,17,5)]}
-> in [(p,q,(p * q) `mod` 18) | p <- n, q <- n, p < q] == r
+> let n = [5,7,11,13,17]
+> let r0 = [(5,7,17),(5,11,1),(5,13,11),(5,17,13)]
+> let r1 = [(7,11,5),(7,13,1),(7,17,11)]
+> let r2 = [(11,13,17),(11,17,7)]
+> let r3 = [(13,17,5)]
+> [(p,q,(p * q) `mod` 18) | p <- n, q <- n, p < q] == concat [r0,r1,r2,r3]
 
 The article also omits the 5 after 5,1 in the sequence below.
 
 > let r = [11,13,17,5,13,11,17,7,11,5,1,5,5,7,17,11,7,5,17,13,5,11,1,11]
-> in take 24 (fib_proc (\p q -> (p * q) `mod` 18) 11 13) == r
+> take 24 (fib_proc (\p q -> (p * q) `mod` 18) 11 13) == r
 
 -}
 fib_proc :: (a -> a -> a) -> a -> a -> [a]
@@ -123,15 +122,6 @@
 half_seq :: Seq -> Half_Seq
 half_seq = take 4
 
--- | Reverse table 'lookup'.
---
--- > reverse_lookup 'b' (zip [1..] ['a'..]) == Just 2
--- > lookup 2 (zip [1..] ['a'..]) == Just 'b'
-reverse_lookup :: (Eq a) => a -> [(b,a)] -> Maybe b
-reverse_lookup i =
-    let f (p,q) = (q,p)
-    in lookup i . map f
-
 -- | 'Label' of 'Seq', inverse of 'seq_of'.
 --
 -- > label_of [8,7,5,6,4,3,1,2] == Q1
@@ -139,7 +129,7 @@
 label_of :: Seq -> Label
 label_of i =
     let err = error ("label_of: " ++ show i)
-    in fromMaybe err (reverse_lookup i viii_6b)
+    in fromMaybe err (T.reverse_lookup i viii_6b)
 
 -- | 'True' if two 'Half_Seq's are complementary, ie. form a 'Seq'.
 --
@@ -153,12 +143,12 @@
 
 -- | Relation between to 'Half_Seq' values as a
 -- /(complementary,permutation)/ pair.
-type Rel = (Bool,P.Permute)
+type Rel = (Bool,T.Permutation)
 
 -- | Determine 'Rel' of 'Half_Seq's.
 --
--- > relate [1,4,2,3] [1,3,4,2] == (False,P.listPermute 4 [0,3,1,2])
--- > relate [1,4,2,3] [8,5,6,7] == (True,P.listPermute 4 [1,0,2,3])
+-- > relate [1,4,2,3] [1,3,4,2] == (False,[0,3,1,2])
+-- > relate [1,4,2,3] [8,5,6,7] == (True,[1,0,2,3])
 relate :: Half_Seq -> Half_Seq -> Rel
 relate p q =
     if complementary p q
@@ -167,7 +157,7 @@
 
 -- | 'Rel' from 'Label' /p/ to /q/.
 --
--- > relate_l L L2 == (False,P.listPermute 4 [0,3,1,2])
+-- > relate_l L L2 == (False,[0,3,1,2])
 relate_l :: Label -> Label -> Rel
 relate_l p q = relate (half_seq_of p) (half_seq_of q)
 
@@ -177,14 +167,13 @@
 
 -- | 'relate' adjacent 'Label's.
 --
--- > relations_l [L2,L,A] == [(False,P.listPermute 4 [0,2,3,1])
--- >                         ,(False,P.listPermute 4 [2,0,1,3])]
+-- > relations_l [L2,L,A] == [(False,[0,2,3,1]),(False,[2,0,1,3])]
 relations_l :: [Label] -> [Rel]
 relations_l p = zipWith relate_l p (tail p)
 
 -- | Apply 'Rel' to 'Half_Seq'.
 --
--- > apply_relation (False,P.listPermute 4 [0,3,1,2]) [1,4,2,3] == [1,3,4,2]
+-- > apply_relation (False,[0,3,1,2]) [1,4,2,3] == [1,3,4,2]
 apply_relation :: Rel -> Half_Seq -> Half_Seq
 apply_relation (c,p) i =
     let j = T.apply_permutation p i
@@ -212,11 +201,10 @@
 data Face = F_Back | F_Front | F_Right | F_Left | F_Bottom | F_Top
           deriving (Eq,Enum,Bounded,Ord,Show)
 
--- | Table indicating set of faces of cubes as drawn in Fig. VIII-6
--- (p.220).
+-- | Table indicating set of faces of cubes as drawn in Fig. VIII-6 (p.220).
 --
 -- > lookup [1,4,6,7] faces == Just F_Left
--- > reverse_lookup F_Right faces == Just [2,3,5,8]
+-- > T.reverse_lookup F_Right faces == Just [2,3,5,8]
 faces :: [([Int],Face)]
 faces =
     [([1,3,6,8],F_Back) -- (I in viii-6)
diff --git a/Music/Theory/Xenakis/Sieve.hs b/Music/Theory/Xenakis/Sieve.hs
--- a/Music/Theory/Xenakis/Sieve.hs
+++ b/Music/Theory/Xenakis/Sieve.hs
@@ -6,12 +6,9 @@
 import qualified Data.List as L
 import Music.Theory.List
 
--- | Synonym for 'Integer'
-type I = Integer
-
 -- | A Sieve.
 data Sieve = Empty -- ^ 'Empty' 'Sieve'
-           | L (I,I) -- ^ Primitive 'Sieve' of /modulo/ and /index/
+           | L (Integer, Integer) -- ^ Primitive 'Sieve' of /modulo/ and /index/
            | Union Sieve Sieve -- ^ 'Union' of two 'Sieve's
            | Intersection Sieve Sieve -- ^ 'Intersection' of two 'Sieve's
            | Complement Sieve -- ^ 'Complement' of a 'Sieve'
@@ -50,21 +47,22 @@
 -- | Variant of 'L', ie. 'curry' 'L'.
 --
 -- > l 15 19 == L (15,19)
-l :: I -> I -> Sieve
+l :: Integer -> Integer -> Sieve
 l = curry L
 
 -- | unicode synonym for 'l'.
-(⋄) :: I -> I -> Sieve
+(⋄) :: Integer -> Integer -> Sieve
 (⋄) = l
 
 infixl 3 ∪
 infixl 4 ∩
 infixl 5 ⋄
 
--- | In a /normal/ 'Sieve' /m/ is '>' /i/.
---
--- > normalise (L (15,19)) == L (15,4)
--- > normalise (L (11,13)) == L (11,2)
+{- | In a /normal/ 'Sieve' /m/ is '>' /i/.
+
+> normalise (L (15,19)) == L (15,4)
+> normalise (L (11,13)) == L (11,2)
+-}
 normalise :: Sieve -> Sieve
 normalise s =
     case s of
@@ -74,18 +72,20 @@
       Intersection s0 s1 -> Intersection (normalise s0) (normalise s1)
       Complement s' -> Complement (normalise s')
 
--- | Predicate to test if a 'Sieve' is /normal/.
---
--- > is_normal (L (15,4)) == True
--- > is_normal (L (11,13)) == False
+{- | Predicate to test if a 'Sieve' is /normal/.
+
+> is_normal (L (15,4)) == True
+> is_normal (L (11,13)) == False
+-}
 is_normal :: Sieve -> Bool
 is_normal s = s == normalise s
 
--- | Predicate to determine if an 'I' is an element of the 'Sieve'.
---
--- > map (element (L (3,1))) [1..4] == [True,False,False,True]
--- > map (element (L (15,4))) [4,19 .. 49] == [True,True,True,True]
-element :: Sieve -> I -> Bool
+{- | Predicate to determine if an 'I' is an element of the 'Sieve'.
+
+> map (element (L (3,1))) [1..4] == [True,False,False,True]
+> map (element (L (15,4))) [4,19 .. 49] == [True,True,True,True]
+-}
+element :: Sieve -> Integer -> Bool
 element s n =
     case s of
       Empty -> False
@@ -94,8 +94,11 @@
       Intersection s0 s1 -> element s0 n && element s1 n
       Complement s' -> not (element s' n)
 
--- > take 9 (i_complement [1,3..]) == [0,2..16]
-i_complement :: [I] -> [I]
+{- | 'I' not in set.
+
+> take 9 (i_complement [1,3..]) == [0,2..16]
+-}
+i_complement :: [Integer] -> [Integer]
 i_complement =
     let f x s = case s of
                 [] -> [x ..]
@@ -105,14 +108,15 @@
                           GT -> error "i_complement"
     in f 0
 
--- | Construct the sequence defined by a 'Sieve'.  Note that building
--- a sieve that contains an intersection clause that has no elements
--- gives @_|_@.
---
--- > let {d = [0,2,4,5,7,9,11]
--- >     ;r = d ++ map (+ 12) d}
--- > in take 14 (build (union (map (l 12) d))) == r
-build :: Sieve -> [I]
+{- | Construct the sequence defined by a 'Sieve'.  Note that building
+     a sieve that contains an intersection clause that has no elements
+     gives @_|_@.
+
+> let d = [0,2,4,5,7,9,11]
+> let r = d ++ map (+ 12) d
+> take 14 (build (union (map (l 12) d))) == r
+-}
+build :: Sieve -> [Integer]
 build s =
     let u_f = map head . L.group
         i_f = let g [x,_] = [x]
@@ -125,8 +129,7 @@
          Intersection s0 s1 -> i_f (merge (build s0) (build s1))
          Complement s' -> i_complement (build s')
 
-{- | Variant of 'build' that gives the first /n/ places of the
-  'reduce' of 'Sieve'.
+{- | Variant of 'build' that gives the first /n/ places of the 'reduce' of 'Sieve'.
 
 > buildn 6 (union (map (l 8) [0,3,6])) == [0,3,6,8,11,14]
 > buildn 12 (L (3,2)) == [2,5,8,11,14,17,20,23,26,29,32,35]
@@ -137,117 +140,105 @@
 > buildn 6 (3⋄0 ∪ 4⋄0) == [0,3,4,6,8,9]
 > buildn 8 (5⋄2 ∩ 2⋄0 ∪ 7⋄3) == [2,3,10,12,17,22,24,31]
 > buildn 12 (5⋄1 ∪ 7⋄2) == [1,2,6,9,11,16,21,23,26,30,31,36]
+> buildn 19 (L (3,2) ∪ L (7, 1)) == [1, 2, 5, 8, 11, 14, 15, 17, 20, 22, 23, 26, 29, 32, 35, 36, 38, 41, 43]
+> buildn 19 (3⋄0 ∪ 7⋄0) == [0, 3, 6, 7, 9, 12, 14, 15, 18, 21, 24, 27, 28, 30, 33, 35, 36, 39, 42]
 
 > buildn 10 (3⋄2 ∩ 4⋄7 ∪ 6⋄9 ∩ 15⋄18) == [3,11,23,33,35,47,59,63,71,83]
 
-> let {s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
->     ;s' = 24⋄23 ∪ 30⋄3 ∪ 104⋄70}
-> in buildn 16 s == buildn 16 s'
+> let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
+> let s' = 24⋄23 ∪ 30⋄3 ∪ 104⋄70
+> buildn 16 s == buildn 16 s'
 
 > buildn 10 (24⋄23 ∪ 30⋄3 ∪ 104⋄70) == [3,23,33,47,63,70,71,93,95,119]
 
 > let r = [2,3,4,5,8,9,10,11,14,17,19,20,23,24,26,29,31]
-> in buildn 17 (5⋄4 ∪ 3⋄2 ∪ 7⋄3) == r
+> buildn 17 (5⋄4 ∪ 3⋄2 ∪ 7⋄3) == r
 
 > let r = [0,1,3,6,9,10,11,12,15,16,17,18,21,24,26,27,30]
-> in buildn 17 (5⋄1 ∪ 3⋄0 ∪ 7⋄3) == r
+> buildn 17 (5⋄1 ∪ 3⋄0 ∪ 7⋄3) == r
 
 > let r = [0,2,3,4,6,7,9,11,12,15,17,18,21,22,24,25,27,30,32]
-> in buildn 19 (5⋄2 ∪ 3⋄0 ∪ 7⋄4) == r
+> buildn 19 (5⋄2 ∪ 3⋄0 ∪ 7⋄4) == r
 
 Agon et. al. p.155
 
-> let {a = c (13⋄3 ∪ 13⋄5 ∪ 13⋄7 ∪ 13⋄9)
->     ;b = 11⋄2
->     ;c' = c (11⋄4 ∪ 11⋄8)
->     ;d = 13⋄9
->     ;e = 13⋄0 ∪ 13⋄1 ∪ 13⋄6
->     ;f = (a ∩ b) ∪ (c' ∩ d) ∪ e}
-> in buildn 13 f == [0,1,2,6,9,13,14,19,22,24,26,27,32]
+> let a = c (13⋄3 ∪ 13⋄5 ∪ 13⋄7 ∪ 13⋄9)
+> let b = 11⋄2
+> let c' = c (11⋄4 ∪ 11⋄8)
+> let d = 13⋄9
+> let e = 13⋄0 ∪ 13⋄1 ∪ 13⋄6
+> let f = (a ∩ b) ∪ (c' ∩ d) ∪ e
+> buildn 13 f == [0,1,2,6,9,13,14,19,22,24,26,27,32]
 
 > differentiate [0,1,2,6,9,13,14,19,22,24,26,27,32] == [1,1,4,3,4,1,5,3,2,2,1,5]
 
-> import Music.Theory.Pitch
+> import Music.Theory.Pitch {- hmt -}
 
-> let {n = [0,1,2,6,9,13,14,19,22,24,26,27,32]
->     ;r = "C C𝄲 C♯ D♯ E𝄲 F𝄰 G A𝄲 B C C♯ C𝄰 E"}
-> in unwords (map (pitch_class_pp . pc24et_to_pitch . (`mod` 24)) n) == r
+> let n = [0,1,2,6,9,13,14,19,22,24,26,27,32]
+> let r = "C C𝄲 C♯ D♯ E𝄲 F𝄰 G A𝄲 B C C♯ C𝄰 E"
+> unwords (map (pitch_class_pp . pc24et_to_pitch . (`mod` 24)) n) == r
 
 Jonchaies
 
 > let s = map (17⋄) [0,1,4,5,7,11,12,16]
-> in differentiate (buildn 25 (union s))
+> let r = [1,3,1,2,4,1,4,1,1,3,1,2,4,1,4,1,1,3,1,2,4,1,4,1]
+> differentiate (buildn 25 (union s)) == r
+> let a2 = octpc_to_midi (2,9)
+> let m = scanl (+) a2 r
+> import Music.Theory.Pitch.Spelling.Table {- hmt -}
+> let p = "A2 A#2 C#3 D3 E3 G#3 A3 C#4 D4 D#4 F#4 G4 A4 C#5 D5 F#5 G5 G#5 B5 C6 D6 F#6 G6 B6 C7"
+> unwords (map (pitch_pp_iso . midi_to_pitch pc_spell_sharp) m) == p
 
 Nekuïa
 
-> let s = [24⋄0,14⋄2,22⋄3,31⋄4,28⋄7,29⋄9,19⋄10,25⋄13,24⋄14,26⋄17,23⋄21
->         ,24⋄10,30⋄9,35⋄17,29⋄24,32⋄25,30⋄29,26⋄21,30⋄17,31⋄16]
-> in differentiate (buildn 24 (union s))
+> let s = [24⋄0,14⋄2,22⋄3,31⋄4,28⋄7,29⋄9,19⋄10,25⋄13,24⋄14,26⋄17,23⋄21,24⋄10,30⋄9,35⋄17,29⋄24,32⋄25,30⋄29,26⋄21,30⋄17,31⋄16]
+> let r = [2,1,1,3,2,1,3,1,2,1,4,3,1,4,1,4,1,3,1,4,1,3,1,4,1,4,1,1,3,1,3,1,2,3,1,4,1,4,4,1]
+> differentiate (buildn 41 (union s)) == r
+> let a0 = octpc_to_midi (0,9)
+> let m = scanl (+) a0 r
+> import Music.Theory.Pitch.Spelling.Table {- hmt -}
+> let p = "A0 B0 C1 C#1 E1 F#1 G1 A#1 B1 C#2 D2 F#2 A2 A#2 D3 D#3 G3 G#3 B3 C4 E4 F4 G#4 A4 C#5 D5 F#5 G5 G#5 B5 C6 D#6 E6 F#6 A6 A#6 D7 D#7 G7 B7 C8"
+> unwords (map (pitch_pp_iso . midi_to_pitch pc_spell_sharp) m) == p
 
+> let s = [8⋄0∩3⋄0,2⋄0∩7⋄2,2⋄1∩11⋄3,31⋄4,4⋄3∩7⋄0,29⋄9,19⋄10,25⋄13,8⋄6∩3⋄2,2⋄1∩13⋄4,23⋄21,8⋄2∩3⋄1,2⋄1∩3⋄0∩5⋄4,5⋄2∩7⋄3,29⋄24,32⋄25,2⋄1∩3⋄2∩5⋄4,2⋄1∩13⋄8,2⋄1∩3⋄2∩5⋄2,31⋄16]
+> differentiate (buildn 41 (union s)) == r
+
 Major scale:
 
 > let s = (c(3⋄2) ∩ 4⋄0) ∪ (c(3⋄1) ∩ 4⋄1) ∪ (3⋄2 ∩ 4⋄2) ∪ (c(3⋄0) ∩ 4⋄3)
-> in buildn 7 s == [0,2,4,5,7,9,11]
+> buildn 7 s == [0,2,4,5,7,9,11]
 
 Nomos Alpha:
 
-let {s = (c (13⋄3 ∪ 13⋄5 ∪ 13⋄7 ∪ 13⋄9) ∩ 11⋄2) ∪ (c (11⋄4 ∪ 11⋄8) ∩ 13⋄9) ∪ (13⋄0 ∪ 13⋄1 ∪ 13⋄6)
-    ;r = [0,1,2,6,9,13,14,19,22,24,26,27,32,35,39,40,45,52,53,58,61,65,66,71,78,79,84,87,90,91,92,97]}
-in buildn 32 s == r
-
-/Psappha/ (Flint):
-
-> let {s = union [(8⋄0∪8⋄1∪8⋄7)∩(5⋄1∪5⋄3)
->                ,(8⋄0∪8⋄1∪8⋄2)∩5⋄0
->                ,8⋄3∩(5⋄0∪5⋄1∪5⋄2∪5⋄3∪5⋄4)
->                ,8⋄4∩(5⋄0∪5⋄1∪5⋄2∪5⋄3∪5⋄4)
->                ,(8⋄5∪8⋄6)∩(5⋄2∪5⋄3∪5⋄4)
->                ,8⋄1∩5⋄2
->                ,8⋄6∩5⋄1]
->     ;r = [0,1,3,4,6,8,10,11,12
->          ,13,14,16,17,19,20,22,23,25
->          ,27,28,29,31,33,35,36,37,38]}
-> in buildn 27 s == r
-
-À R. (Hommage à Maurice Ravel) (Squibbs, 1996)
-
-> let {s = union [8⋄0∩(11⋄0∪11⋄4∪11⋄5∪11⋄6∪11⋄10)
->                ,8⋄1∩(11⋄2∪11⋄3∪11⋄6∪11⋄7∪11⋄9)
->                ,8⋄2∩(11⋄0∪11⋄1∪11⋄2∪11⋄3∪11⋄5∪11⋄10)
->                ,8⋄3∩(11⋄1∪11⋄2∪11⋄3∪11⋄4∪11⋄10)
->                ,8⋄4∩(11⋄0∪11⋄4∪11⋄8)
->                ,8⋄5∩(11⋄0∪11⋄2∪11⋄3∪11⋄7∪11⋄9∪11⋄10)
->                ,8⋄6∩(11⋄1∪11⋄3∪11⋄5∪11⋄7∪11⋄8∪11⋄9)
->                ,8⋄7∩(11⋄1∪11⋄3∪11⋄6∪11⋄7∪11⋄8∪11⋄10)]
->     ;r = [0,2,3,4,7,9,10,13,14,16
->          ,17,21,23,25,29,30,32,34,35,38
->          ,39,43,44,47,48,52,53,57,58,59
->          ,62,63,66,67,69,72,73,77,78,82
->          ,86,87]}
-> in buildn 42 s == r
+let s = (c (13⋄3 ∪ 13⋄5 ∪ 13⋄7 ∪ 13⋄9) ∩ 11⋄2) ∪ (c (11⋄4 ∪ 11⋄8) ∩ 13⋄9) ∪ (13⋄0 ∪ 13⋄1 ∪ 13⋄6)
+let r = [0,1,2,6,9,13,14,19,22,24,26,27,32,35,39,40,45,52,53,58,61,65,66,71,78,79,84,87,90,91,92,97]
+buildn 32 s == r
 
 -}
-buildn :: Int -> Sieve -> [I]
+buildn :: Int -> Sieve -> [Integer]
 buildn n = take n . build . reduce
 
--- | Standard differentiation function.
---
--- > differentiate [1,3,6,10] == [2,3,4]
--- > differentiate [0,2,4,5,7,9,11,12] == [2,2,1,2,2,2,1]
+{- | Standard differentiation function.
+
+> differentiate [1,3,6,10] == [2,3,4]
+> differentiate [0,2,4,5,7,9,11,12] == [2,2,1,2,2,2,1]
+-}
 differentiate :: (Num a) => [a] -> [a]
 differentiate x = zipWith (-) (tail x) x
 
--- | Euclid's algorithm for computing the greatest common divisor.
---
--- > euclid 1989 867 == 51
+{- | Euclid's algorithm for computing the greatest common divisor.
+
+> euclid 1989 867 == 51
+-}
 euclid :: (Integral a) => a -> a -> a
 euclid i j =
     let k = i `mod` j
     in if k == 0 then j else euclid j k
 
--- | Bachet De Méziriac's algorithm.
---
--- > de_meziriac 15 4 == 3 && euclid 15 4 == 1
+{- | Bachet De Méziriac's algorithm.
+
+> de_meziriac 15 4 == 3 && euclid 15 4 == 1
+-}
 de_meziriac :: (Integral a) => a -> a -> a
 de_meziriac i j =
     let f t = if (t * i) `mod` j /= 1
@@ -255,12 +246,12 @@
               else t
     in if j == 1 then 1 else f 1
 
--- | Attempt to reduce the 'Intersection' of two 'L' nodes to a
--- singular 'L' node.
---
--- > reduce_intersection (3,2) (4,7) == Just (12,11)
--- > reduce_intersection (12,11) (6,11) == Just (12,11)
--- > reduce_intersection (12,11) (8,7) == Just (24,23)
+{- | Attempt to reduce the 'Intersection' of two 'L' nodes to a singular 'L' node.
+
+> reduce_intersection (3,2) (4,7) == Just (12,11)
+> reduce_intersection (12,11) (6,11) == Just (12,11)
+> reduce_intersection (12,11) (8,7) == Just (24,23)
+-}
 reduce_intersection :: (Integral t) => (t,t) -> (t,t) -> Maybe (t,t)
 reduce_intersection (m1,i1) (m2,i2) =
     let d = euclid m1 m2
@@ -275,20 +266,21 @@
        then Nothing
        else Just (m3,i3)
 
--- | Reduce the number of nodes at a 'Sieve'.
---
--- > reduce (L (3,2) ∪ Empty) == L (3,2)
--- > reduce (L (3,2) ∩ Empty) == L (3,2)
--- > reduce (L (3,2) ∩ L (4,7)) == L (12,11)
--- > reduce (L (6,9) ∩ L (15,18)) == L (30,3)
---
--- > let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
--- > in reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
---
--- > putStrLn $ sieve_pp (reduce s)
---
--- > let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
--- > in reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
+{- | Reduce the number of nodes at a 'Sieve'.
+
+> reduce (L (3,2) ∪ Empty) == L (3,2)
+> reduce (L (3,2) ∩ Empty) == L (3,2)
+> reduce (L (3,2) ∩ L (4,7)) == L (12,11)
+> reduce (L (6,9) ∩ L (15,18)) == L (30,3)
+
+> let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
+> reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
+
+> putStrLn $ sieve_pp (reduce s)
+
+> let s = 3⋄2∩4⋄7∩6⋄11∩8⋄7 ∪ 6⋄9∩15⋄18 ∪ 13⋄5∩8⋄6∩4⋄2 ∪ 6⋄9∩15⋄19
+> reduce s == (24⋄23 ∪ 30⋄3 ∪ 104⋄70)
+-}
 reduce :: Sieve -> Sieve
 reduce s =
     let f g s1 s2 =
@@ -307,3 +299,43 @@
          Intersection (L p) (L q) -> maybe Empty L (reduce_intersection p q)
          Intersection s1 s2 -> f Intersection s1 s2
          Complement s' -> Complement (reduce s')
+
+-- * Literature
+
+psappha_flint_c :: [Sieve]
+psappha_flint_c =
+  let s0 = (8⋄0∪8⋄1∪8⋄7)∩(5⋄1∪5⋄3)
+      s1 = (8⋄0∪8⋄1∪8⋄2)∩5⋄0
+      s2 = 8⋄3∩(5⋄0∪5⋄1∪5⋄2∪5⋄3∪5⋄4)
+      s3 = 8⋄4∩(5⋄0∪5⋄1∪5⋄2∪5⋄3∪5⋄4)
+      s4 = (8⋄5∪8⋄6)∩(5⋄2∪5⋄3∪5⋄4)
+      s5 = 8⋄1∩5⋄2
+      s6 = 8⋄6∩5⋄1
+  in [s0, s1, s2, s3, s4, s5, s6]
+
+{- | /Psappha/ (Flint)
+
+> let r = [0,1,3,4,6,8,10,11,12,13,14,16,17,19,20,22,23,25,27,28,29,31,33,35,36,37,38]
+> buildn 27 psappha_flint == r
+-}
+psappha_flint :: Sieve
+psappha_flint = union psappha_flint_c
+
+a_r_squibbs_c :: [Sieve]
+a_r_squibbs_c =
+  [8⋄0∩(11⋄0∪11⋄4∪11⋄5∪11⋄6∪11⋄10)
+  ,8⋄1∩(11⋄2∪11⋄3∪11⋄6∪11⋄7∪11⋄9)
+  ,8⋄2∩(11⋄0∪11⋄1∪11⋄2∪11⋄3∪11⋄5∪11⋄10)
+  ,8⋄3∩(11⋄1∪11⋄2∪11⋄3∪11⋄4∪11⋄10)
+  ,8⋄4∩(11⋄0∪11⋄4∪11⋄8)
+  ,8⋄5∩(11⋄0∪11⋄2∪11⋄3∪11⋄7∪11⋄9∪11⋄10)
+  ,8⋄6∩(11⋄1∪11⋄3∪11⋄5∪11⋄7∪11⋄8∪11⋄9)
+  ,8⋄7∩(11⋄1∪11⋄3∪11⋄6∪11⋄7∪11⋄8∪11⋄10)]
+
+{- | À R. (Hommage à Maurice Ravel) (Squibbs, 1996)
+
+let r = [0,2,3,4,7,9,10,13,14,16,17,21,23,25,29,30,32,34,35,38,39,43,44,47,48,52,53,57,58,59,62,63,66,67,69,72,73,77,78,82,86,87]
+buildn 42 a_r_squibbs == r
+-}
+a_r_squibbs :: Sieve
+a_r_squibbs = union a_r_squibbs_c
diff --git a/Music/Theory/Z.hs b/Music/Theory/Z.hs
--- a/Music/Theory/Z.hs
+++ b/Music/Theory/Z.hs
@@ -1,4 +1,4 @@
--- | Z-/n/ functions with modulo function as parameter.
+-- | Z-/n/ functions
 module Music.Theory.Z where
 
 import Data.Char {- base -}
@@ -6,65 +6,69 @@
 
 import qualified Music.Theory.List as T {- hmt -}
 
--- | The modulo function for Z.
-type Z t = (t -> t)
+-- | Z type.
+--
+-- > map z_modulus [z7,z12] == [7,12]
+newtype Z i = Z {z_modulus :: i}
 
+-- | 'mod' of 'Z'.
+--
+-- > map (z_mod z12) [-1,0,1,11,12,13] == [11,0,1,11,0,1]
+z_mod :: Integral i => Z i -> i -> i
+z_mod (Z i) n = mod n i
+
+-- | Common moduli in music theory.
+z5,z7,z12,z16 :: Num i => Z i
+z5 = Z 5
+z7 = Z 7
+z12 = Z 12
+z16 = Z 16
+
 -- | Is /n/ in (0,/m/-1).
 is_z_n :: (Num a, Ord a) => a -> a -> Bool
 is_z_n m n = n >= 0 && n < m
 
-mod5 :: Integral i => Z i
-mod5 n = n `mod` 5
-
-mod7 :: Integral i => Z i
-mod7 n = n `mod` 7
-
-mod12 :: Integral i => Z i
-mod12 n = n `mod` 12
-
-lift_unary_Z :: Z i -> (t -> i) -> t -> i
-lift_unary_Z z f n = z (f n)
+lift_unary_Z :: Integral i => Z i -> (t -> i) -> t -> i
+lift_unary_Z z f = z_mod z . f
 
-lift_binary_Z :: Z i -> (s -> t -> i) -> s -> t -> i
-lift_binary_Z z f n1 n2 = z (n1 `f` n2)
+lift_binary_Z :: Integral i => Z i -> (s -> t -> i) -> s -> t -> i
+lift_binary_Z z f n1 = z_mod z . f n1
 
--- > import Music.Theory.Z
--- > import qualified Music.Theory.Z12 as Z12
--- > z_add id (11::Z12.Z12) 5 == 4
--- > (11::Z12.Z12) + 5 == 4
--- > map (z_add mod12 4) [1,5,6] == [5,9,10]
+-- | Add two Z.
+--
+-- > map (z_add z12 4) [1,5,6,11] == [5,9,10,3]
 z_add :: Integral i => Z i -> i -> i -> i
 z_add z = lift_binary_Z z (+)
 
 -- | The underlying type /i/ is presumed to be signed...
 --
--- > z_sub mod12 0 8 == 4
+-- > z_sub z12 0 8 == 4
 --
--- > import Data.Word
--- > z_sub mod12 (0::Word8) 8 == 8
+-- > import Data.Word {- base -}
+-- > z_sub z12 (0::Word8) 8 == 8
 -- > ((0 - 8) :: Word8) == 248
 -- > 248 `mod` 12 == 8
 z_sub :: Integral i => Z i -> i -> i -> i
 z_sub z = lift_binary_Z z (-)
 
-{- | Allowing unsigned /i/ is rather inefficient...
-z_sub :: Integral i => Z i -> i -> i -> i
-z_sub z p q =
+-- | Allowing unsigned /i/ is rather inefficient...
+--
+-- > z_sub_unsigned z12 (0::Word8) 8 == 4
+z_sub_unsigned :: (Integral i,Ord i) => Z i -> i -> i -> i
+z_sub_unsigned z p q =
     if p > q
-    then z (p - q)
-    else let m = z_modulus z
-         in z (p + m - q)
--}
+    then z_mod z (p - q)
+    else z_mod z (p + z_modulus z - q)
 
 z_mul :: Integral i => Z i -> i -> i -> i
 z_mul z = lift_binary_Z z (*)
 
--- > z_negate mod12 7 == 5
+-- > z_negate z12 7 == 5
 z_negate :: Integral i => Z i -> i -> i
 z_negate z = z_sub z 0 -- error "Z numbers are not signed"
 
 z_fromInteger :: Integral i => Z i -> Integer -> i
-z_fromInteger z i = z (fromInteger i)
+z_fromInteger z i = z_mod z (fromInteger i)
 
 z_signum :: t -> u -> v
 z_signum _ _ = error "Z numbers are not signed"
@@ -72,29 +76,23 @@
 z_abs :: t -> u -> v
 z_abs _ _ = error "Z numbers are not signed"
 
--- > map (to_Z mod12) [-9,-3,0] == [3,9,0]
+-- > map (to_Z z12) [-9,-3,0] == [3,9,0]
 to_Z :: Integral i => Z i -> i -> i
 to_Z z = z_fromInteger z . fromIntegral
 
 from_Z :: (Integral i,Num n) => i -> n
 from_Z = fromIntegral
 
--- | Modulus of /z/.
---
--- > z_modulus mod12 == 12
-z_modulus :: Integral i => Z i -> i
-z_modulus z = maybe (error "z_modulus") (fromIntegral . (+ 1)) (findIndex ((== 0) . z) [1..])
-
 -- | Universe of 'Z'.
 --
--- > z_univ mod12 == [0..11]
+-- > z_univ z12 == [0..11]
 z_univ :: Integral i => Z i -> [i]
-z_univ z = 0 : takeWhile ((> 0) . z) [1..]
+z_univ (Z z) = [0 .. z - 1]
 
 -- | Z of 'z_univ' not in given set.
 --
--- > z_complement mod5 [0,2,3] == [1,4]
--- > z_complement mod12 [0,2,4,5,7,9,11] == [1,3,6,8,10]
+-- > z_complement z5 [0,2,3] == [1,4]
+-- > z_complement z12 [0,2,4,5,7,9,11] == [1,3,6,8,10]
 z_complement :: Integral i => Z i -> [i] -> [i]
 z_complement z = (\\) (z_univ z)
 
@@ -110,38 +108,39 @@
 z_div :: Integral i => Z i -> i -> i -> i
 z_div z p = to_Z z . div_err "z_div" p
 
--- > z_mod mod12 6 12 == 6
-z_mod :: Integral i => Z i -> i -> i -> i
-z_mod z p = to_Z z . mod p
-
 z_quotRem :: Integral i => Z i -> i -> i -> (i,i)
 z_quotRem z p q = (z_quot z p q,z_quot z p q)
 
 z_divMod :: Integral i => Z i -> i -> i -> (i,i)
-z_divMod z p q = (z_div z p q,z_mod z p q)
+z_divMod z p q = (z_div z p q,z_mod z (mod p q))
 
 z_toInteger :: Integral i => Z i -> i -> i
-z_toInteger z = to_Z z
+z_toInteger = to_Z
 
 -- * Z16
 
-mod16 :: Integral i => Z i
-mod16 n = n `mod` 16
-
+-- | Type generalised 'intToDigit'.
+--
+-- > map integral_to_digit [0 .. 15] == "0123456789abcdef"
 integral_to_digit :: Integral t => t -> Char
 integral_to_digit = intToDigit . fromIntegral
 
+-- | 'is_z_n' 16.
 is_z16 :: Integral t => t -> Bool
 is_z16 = is_z_n 16
 
+-- | Alias for 'integral_to_digit'.
 z16_to_char :: Integral t => t -> Char
 z16_to_char = integral_to_digit
 
+-- | 'z16_to_char' in braces, {1,2,3}.
 z16_set_pp :: Integral t => [t] -> String
 z16_set_pp = T.bracket ('{','}') . map z16_to_char
 
+-- | 'z16_to_char' in arrows, <1,2,3>.
 z16_seq_pp :: Integral t => [t] -> String
 z16_seq_pp = T.bracket ('<','>') . map z16_to_char
 
+-- | 'z16_to_char' in brackets, [1,2,3].
 z16_vec_pp :: Integral t => [t] -> String
 z16_vec_pp = T.bracket ('[',']') . map z16_to_char
diff --git a/Music/Theory/Z/Boros_1990.hs b/Music/Theory/Z/Boros_1990.hs
--- a/Music/Theory/Z/Boros_1990.hs
+++ b/Music/Theory/Z/Boros_1990.hs
@@ -12,18 +12,18 @@
 import qualified Data.Graph.Inductive.PatriciaTree as G {- fgl -}
 import qualified Data.Graph.Inductive.Query.BFS as G {- fgl -}
 
-import qualified Music.Theory.Array.MD as T
+import qualified Music.Theory.Array.Text as T
 import qualified Music.Theory.Combinations as T
 import qualified Music.Theory.Graph.Dot as T
-import qualified Music.Theory.Graph.FGL as T
+import qualified Music.Theory.Graph.Fgl as T
 import qualified Music.Theory.List as T
 import qualified Music.Theory.Set.List as T
 import qualified Music.Theory.Tuple as T
 import qualified Music.Theory.Z as T
 import qualified Music.Theory.Z.Forte_1973 as T
-import qualified Music.Theory.Z.TTO as T
+import qualified Music.Theory.Z.Tto as T
 
--- * UTIL
+-- * Util
 
 singular :: String -> [t] -> t
 singular err l =
@@ -37,80 +37,81 @@
 elem_by :: (t -> t -> Bool) -> t -> [t] -> Bool
 elem_by f e = any (f e)
 
--- * TTO
+-- * Tto
 
-tto_tni_univ :: Integral i => [T.TTO i]
-tto_tni_univ = filter (not . T.tto_M) (T.z_tto_univ T.mod12)
+tto_tni_univ :: Integral i => [T.Tto i]
+tto_tni_univ = filter ((== 1) . T.tto_M) (T.z_tto_univ 5 T.z12)
 
 all_tn :: Integral i => [i] -> [[i]]
-all_tn p = map (\n -> map (T.z_add T.mod12 n) p) [0..11]
+all_tn p = map (\n -> map (T.z_add T.z12 n) p) [0..11]
 
 all_tni :: Integral i => [i] -> [[i]]
-all_tni p = map (\f -> T.z_tto_apply 5 T.mod12 f p) tto_tni_univ
+all_tni p = map (\f -> T.z_tto_apply T.z12 f p) tto_tni_univ
 
 uniq_tni :: Integral i => [i] -> [[i]]
 uniq_tni = nub . all_tni
 
-type PC = Int
-type PCSET = [PC]
-type SC = PCSET
+type Pc = Int
+type Pcset = [Pc]
+type Sc = Pcset
 
-pcset_trs :: Int -> PCSET -> PCSET
-pcset_trs n p = sort (map (T.mod12 . (+ n)) p)
+-- > pcset_trs 3 [0,1,9] == [0,3,4]
+pcset_trs :: Int -> Pcset -> Pcset
+pcset_trs = T.z_tto_tn T.z12
 
 -- | Forte prime forms of the twelve trichordal set classes.
 --
 -- > length trichords == 12
-trichords :: [PCSET]
-trichords = filter ((== 3) . length) (T.sc_univ T.mod12)
+trichords :: [Pcset]
+trichords = filter ((== 3) . length) (T.z_sc_univ T.z12)
 
 -- | Is a pcset self-inversional, ie. is the inversion of /p/ a transposition of /p/.
 --
 -- > map (\p -> (p,self_inv p)) trichords
-self_inv :: PCSET -> Bool
-self_inv p = elem_by set_eq (map (T.z_negate T.mod12) p) (all_tn p)
+self_inv :: Pcset -> Bool
+self_inv p = elem_by set_eq (map (T.z_negate T.z12) p) (all_tn p)
 
 -- | Pretty printer, comma separated.
 --
 -- > pcset_pp [0,3,7,10] == "0,3,7,10"
-pcset_pp :: PCSET -> String
+pcset_pp :: Pcset -> String
 pcset_pp = intercalate "," . map show
 
 -- | Pretty printer, hexadecimal, no separator.
 --
 -- > pcset_pp_hex [0,3,7,10] == "037A"
-pcset_pp_hex :: PCSET -> String
-pcset_pp_hex = map toUpper . concat . map (flip showHex "")
+pcset_pp_hex :: Pcset -> String
+pcset_pp_hex = map toUpper . concatMap (`showHex` "")
 
--- * ATH
+-- * Ath
 
 -- | Forte prime form of the all-trichord hexachord.
 --
--- > T.sc_name T.mod12 ath == "6-Z17"
+-- > T.sc_name ath == "6-Z17"
 -- > T.sc "6-Z17" == ath
-ath :: PCSET
+ath :: Pcset
 ath = [0,1,2,4,7,8]
 
 -- | Is /p/ an instance of 'ath'.
-is_ath :: PCSET -> Bool
-is_ath p = T.forte_prime T.mod12 p == ath
+is_ath :: Pcset -> Bool
+is_ath p = T.z_forte_prime T.z12 p == ath
 
 -- | Table 1, p.20
 --
 -- > length ath_univ == 24
-ath_univ :: [PCSET]
+ath_univ :: [Pcset]
 ath_univ = uniq_tni ath
 
--- | Calculate 'T.TTO' of pcset, which must be an instance of 'ath'.
+-- | Calculate 'T.Tto' of pcset, which must be an instance of 'ath'.
 --
--- > ath_tni [1,2,3,7,8,11] == T.TTO 3 False True
-ath_tni :: PCSET -> T.TTO PC
-ath_tni = singular "ath_tni" . filter (not . T.tto_M) . T.z_tto_rel 5 T.mod12 ath
+-- > ath_tni [1,2,3,7,8,11] == T.Tto 3 1 True
+ath_tni :: Pcset -> T.Tto Pc
+ath_tni = singular "ath_tni" . filter ((== 1) . T.tto_M) . T.z_tto_rel 5 T.z12 ath
 
 -- | Give label for instance of 'ath', prime forms are written H and inversions h.
 --
 -- > ath_pp [1,2,3,7,8,11] == "h3"
-ath_pp :: PCSET -> String
+ath_pp :: Pcset -> String
 ath_pp p =
     let r = ath_tni p
         h = if T.tto_I r then 'h' else 'H'
@@ -119,60 +120,63 @@
 -- | The twenty three-element subsets of 'ath'.
 --
 -- > length ath_trichords == 20
-ath_trichords :: [PCSET]
+ath_trichords :: [Pcset]
 ath_trichords = T.combinations (3::Int) ath
 
 -- | '\\' of 'ath' and /p/, ie. the pitch classes that are in 'ath' and not in /p/.
 --
 -- > ath_complement [0,1,2] == [4,7,8]
-ath_complement :: PCSET -> PCSET
+ath_complement :: Pcset -> Pcset
 ath_complement p = ath \\ p
 
 -- | /p/ is a pcset, /q/ a sc, calculate pcsets in /q/ that with /p/ form 'ath'.
 --
 -- > ath_completions [0,1,2] (T.sc "3-3") == [[6,7,10],[4,7,8]]
 -- > ath_completions [6,7,10] (T.sc "3-5") == [[1,2,8]]
-ath_completions :: PCSET -> SC -> [PCSET]
+ath_completions :: Pcset -> Sc -> [Pcset]
 ath_completions p q =
     let f z = is_ath (p ++ z)
     in filter f (uniq_tni q)
 
-realise_ath_seq :: [PCSET] -> [[PCSET]]
+realise_ath_seq :: [Pcset] -> [[Pcset]]
 realise_ath_seq sq =
     case sq of
       p:q:sq' -> concatMap (\z -> map (p :) (realise_ath_seq (z : sq'))) (ath_completions p q)
       _ -> [sq]
 
 -- return edges that connect z to nodes at gr in an ATH relation
-ath_gr_extend :: T.GRAPH PCSET -> PCSET -> [T.EDGE PCSET]
+ath_gr_extend :: [T.Edge Pcset] -> Pcset -> [T.Edge Pcset]
 ath_gr_extend gr c =
     let f x y = if is_ath (x ++ y) then Just (x,y) else Nothing
         g (p,q) = mapMaybe (f c) [p,q]
     in nub (map T.t2_sort (concatMap g gr))
 
-gr_trs :: Int -> T.GRAPH PCSET -> T.GRAPH PCSET
+gr_trs :: Int -> [T.Edge Pcset] -> [T.Edge Pcset]
 gr_trs n = let f (p,q) = (pcset_trs n p,pcset_trs n q) in map f
 
--- * TABLES
+-- * Tables
 
 -- > length table_3 == 20
-table_3 :: [((PCSET,SC,T.SC_Name),(PCSET,SC,T.SC_Name))]
+table_3 :: [((Pcset,Sc,T.SC_Name),(Pcset,Sc,T.SC_Name))]
 table_3 =
     let f p = let q = ath_complement p
-                  i x = (x,T.forte_prime T.mod12 x,T.sc_name T.mod12 x)
+                  i x = (x,T.z_forte_prime T.z12 x,T.sc_name x)
               in (i p,i q)
     in map f ath_trichords
 
+pp_tbl :: T.Text_Table -> [String]
+pp_tbl = T.table_pp T.table_opt_simple
+
 -- > putStrLn $ unlines $ table_3_md
 table_3_md :: [String]
 table_3_md =
     let pp = pcset_pp_hex
         f ((p,q,r),(s,t,u)) = [pp p,pp q,r,pp s,pp t,u]
         hdr = ["P","P/SC","P/F","Q=H0-P","Q/SC","Q/F"]
-    in T.md_table' (Just hdr,map f table_3)
+    in pp_tbl (hdr : map f table_3)
 
 -- > length table_4 == 10
-table_4 :: [((PCSET,PCSET,T.SC_Name),(PCSET,PCSET,T.SC_Name))]
+table_4 :: [((Pcset,Pcset,T.SC_Name),(Pcset,Pcset,T.SC_Name))]
 table_4 = nub (map T.t2_sort table_3)
 
 -- > putStrLn $ unlines $ table_4_md
@@ -181,18 +185,18 @@
     let pp = pcset_pp_hex
         f ((p,q,r),(s,t,u)) = [pp p ++ "/" ++ pp s,pp q ++ "/" ++ pp t,r ++ "/" ++ u]
         hdr = ["Trichords","Prime Forms","Forte Numbers"]
-    in T.md_table' (Just hdr,map f table_4)
+    in pp_tbl (hdr : map f table_4)
 
-table_5 :: [(PCSET,Int)]
-table_5 = T.histogram (map (T.forte_prime T.mod12) ath_trichords)
+table_5 :: [(Pcset,Int)]
+table_5 = T.histogram (map (T.z_forte_prime T.z12) ath_trichords)
 
 -- > putStrLn $ unlines $ table_5_md
 table_5_md :: [String]
 table_5_md =
     let f (p,q) = [pcset_pp_hex p,show q]
-    in T.md_table' (Just ["SC","#ATH"],map f table_5)
+    in pp_tbl (["SC","#ATH"] : map f table_5)
 
-table_6 :: [(PCSET,Int,Int)]
+table_6 :: [(Pcset,Int,Int)]
 table_6 =
     let f (p,n) = (p,n,length (filter (\q -> p `T.is_subset` q) ath_univ))
     in map f table_5
@@ -201,40 +205,40 @@
 table_6_md :: [String]
 table_6_md =
     let f (p,q,r) = [pcset_pp_hex p,show q,show r]
-    in T.md_table' (Just ["SC","#H0","#Hn"],map f table_6)
+    in pp_tbl (["SC","#H0","#Hn"] : map f table_6)
 
--- * FIGURES
+-- * Figures
 
-fig_1 :: T.GRAPH PCSET
+fig_1 :: [T.Edge Pcset]
 fig_1 = map (T.t2_map T.p3_snd) table_4
 
-fig_1_gr :: G.Gr PCSET ()
+fig_1_gr :: G.Gr Pcset ()
 fig_1_gr = T.g_from_edges fig_1
 
 -- > putStrLn $ unlines $ map (unwords . map pcset_pp) fig_2
-fig_2 :: [[PCSET]]
+fig_2 :: [[Pcset]]
 fig_2 =
  let g = G.undir fig_1_gr
      n = G.labNodes g
      n' = filter ((== 2) . G.deg g . fst) n
      c = T.combinations (2::Int) n'
-     p = map (\[lhs,rhs] -> G.esp (fst lhs) (fst rhs) g) c
-     p' = (filter (not . null) p)
- in map (mapMaybe (\x -> lookup x n)) p'
+     p = map (\l -> let (lhs,rhs) = T.firstSecond l in G.esp (fst lhs) (fst rhs) g) c
+     p' = filter (not . null) p
+ in map (mapMaybe (`lookup` n)) p'
 
-fig_3 :: [T.GRAPH PCSET]
+fig_3 :: [[T.Edge Pcset]]
 fig_3 = map (concatMap (T.adj2 1) . realise_ath_seq) fig_2
 
-fig_3_gr :: [G.Gr PCSET ()]
+fig_3_gr :: [G.Gr Pcset ()]
 fig_3_gr = map T.g_from_edges fig_3
 
-fig_4 :: [T.GRAPH PCSET]
+fig_4 :: [[T.Edge Pcset]]
 fig_4 =
     let p = concatMap realise_ath_seq fig_2
         q = filter ([0,1,2] `elem`) p
     in map (T.adj2 1) q
 
-fig_5 :: [T.GRAPH PCSET]
+fig_5 :: [[T.Edge Pcset]]
 fig_5 =
     let c = [0,4,8]
         f gr = case ath_gr_extend gr c of
@@ -245,52 +249,52 @@
 
 -- * Drawing
 
-uedge_set :: Ord v => [T.EDGE v] -> [T.EDGE v]
+uedge_set :: Ord v => [T.Edge v] -> [T.Edge v]
 uedge_set = nub . map T.t2_sort
 
 -- | Self-inversional pcsets are drawn in a double circle, other pcsets in a circle.
-set_shape :: PCSET -> String
-set_shape v = if self_inv v then "doublecircle" else "circle"
+set_shape :: Pcset -> T.Dot_Attr
+set_shape v = ("shape",if self_inv v then "doublecircle" else "circle")
 
-type GR = G.Gr PCSET ()
+type Gr = G.Gr Pcset ()
 
-gr_pp' :: (PCSET -> String) -> T.GR_PP PCSET ()
-gr_pp' f = (Just . set_shape,Just . f,const Nothing)
+gr_pp' :: (Pcset -> String) -> T.Graph_Pp Pcset ()
+gr_pp' f = (\(_,v) -> [set_shape v,("label",f v)],const [])
 
-gr_pp :: T.GR_PP PCSET ()
+gr_pp :: T.Graph_Pp Pcset ()
 gr_pp = gr_pp' pcset_pp
 
 d_fig_1 :: [String]
-d_fig_1 = T.g_to_udot [] gr_pp fig_1_gr
+d_fig_1 = T.fgl_to_udot [] gr_pp fig_1_gr
 
-d_fig_3_g :: GR
+d_fig_3_g :: Gr
 d_fig_3_g = T.g_from_edges (uedge_set (concat fig_3))
 
 d_fig_3 :: [String]
-d_fig_3 = T.g_to_udot [] gr_pp d_fig_3_g
+d_fig_3 = T.fgl_to_udot [] gr_pp d_fig_3_g
 
 d_fig_3' :: [[String]]
-d_fig_3' = map (T.g_to_udot [("node:shape","circle")] gr_pp) fig_3_gr
+d_fig_3' = map (T.fgl_to_udot [("node:shape","circle")] gr_pp) fig_3_gr
 
-d_fig_4_g :: GR
+d_fig_4_g :: Gr
 d_fig_4_g = T.g_from_edges (uedge_set (concat fig_4))
 
 d_fig_4 :: [String]
-d_fig_4 = T.g_to_udot [] gr_pp d_fig_4_g
+d_fig_4 = T.fgl_to_udot [] gr_pp d_fig_4_g
 
-d_fig_5_g :: GR
+d_fig_5_g :: Gr
 d_fig_5_g = T.g_from_edges (uedge_set (concat fig_5))
 
 d_fig_5 :: [String]
-d_fig_5 = T.g_to_udot [("edge:len","1.5")] (gr_pp' pcset_pp_hex) d_fig_5_g
+d_fig_5 = T.fgl_to_udot [("edge:len","1.5")] (gr_pp' pcset_pp_hex) d_fig_5_g
 
-d_fig_5_e :: [T.EDGE_L PCSET PCSET]
+d_fig_5_e :: [T.Edge_Lbl Pcset Pcset]
 d_fig_5_e = map (\(p,q) -> ((p,q),p++q)) (uedge_set (concat fig_5))
 
-d_fig_5_g' :: G.Gr PCSET PCSET
+d_fig_5_g' :: G.Gr Pcset Pcset
 d_fig_5_g' = T.g_from_edges_l d_fig_5_e
 
 d_fig_5' :: [String]
 d_fig_5' =
-    let pp = (const (Just ""),const Nothing,Just . ath_pp)
-    in T.g_to_udot [("node:shape","point"),("edge:len","1.25")] pp d_fig_5_g'
+    let pp = (const [("shape","")],\(_,e) -> [("label",ath_pp e)])
+    in T.fgl_to_udot [("node:shape","point"),("edge:len","1.25")] pp d_fig_5_g'
diff --git a/Music/Theory/Z/Castren_1994.hs b/Music/Theory/Z/Castren_1994.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Castren_1994.hs
@@ -0,0 +1,153 @@
+-- | Marcus Castrén.
+--   /RECREL: A Similarity Measure for Set-Classes/.
+--   PhD thesis, Sibelius Academy, Helsinki, 1994.
+module Music.Theory.Z.Castren_1994 where
+
+import Data.Int {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ratio {- base -}
+
+import qualified Music.Theory.List as List
+import Music.Theory.Z
+import qualified Music.Theory.Z.Forte_1973 as Forte
+import qualified Music.Theory.Z.Sro as Sro
+
+type Z12 = Int8
+
+-- | Is /p/ symmetrical under inversion.
+--
+-- > map inv_sym (Forte.scs_n 2) == [True,True,True,True,True,True]
+-- > map (fromEnum.inv_sym) (Forte.scs_n 3) == [1,0,0,0,0,1,0,0,1,1,0,1]
+inv_sym :: [Z12] -> Bool
+inv_sym x = x `elem` map (\i -> sort (Sro.z_sro_tn z12 i (Sro.z_sro_invert z12 0 x))) [0..11]
+
+-- | If /p/ is not 'inv_sym' then @(p,invert 0 p)@ else 'Nothing'.
+--
+-- > sc_t_ti [0,2,4] == Nothing
+-- > sc_t_ti [0,1,3] == Just ([0,1,3],[0,2,3])
+sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
+sc_t_ti p =
+    if inv_sym p
+    then Nothing
+    else Just (p,Forte.z_t_prime z12 (Sro.z_sro_invert z12 0 p))
+
+-- | Transpositional equivalence variant of Forte's 'sc_table'.  The
+-- inversionally related classes are distinguished by labels @A@ and
+-- @B@; the class providing the /best normal order/ (Forte 1973) is
+-- always the @A@ class. If neither @A@ nor @B@ appears in the name of
+-- a set-class, it is inversionally symmetrical.
+--
+-- > (length Forte.sc_table,length t_sc_table) == (224,352)
+-- > lookup "5-Z18B" t_sc_table == Just [0,2,3,6,7]
+t_sc_table :: [(Forte.SC_Name,[Z12])]
+t_sc_table =
+    let f x = let nm = Forte.sc_name x
+              in case sc_t_ti x of
+                   Nothing -> [(nm,x)]
+                   Just (p,q) -> [(nm++"A",p),(nm++"B",q)]
+    in concatMap f Forte.scs
+
+-- | Lookup a set-class name.  The input set is subject to
+-- 't_prime' before lookup.
+--
+-- > t_sc_name [0,2,3,6,7] == "5-Z18B"
+-- > t_sc_name [0,1,4,6,7,8] == "6-Z17B"
+t_sc_name :: [Z12] -> Forte.SC_Name
+t_sc_name p =
+    let n = find (\(_,q) -> Forte.z_t_prime z12 p == q) t_sc_table
+    in fst (fromJust n)
+
+-- | Lookup a set-class given a set-class name.
+--
+-- > t_sc "6-Z17A" == [0,1,2,4,7,8]
+t_sc :: Forte.SC_Name -> [Z12]
+t_sc n = snd (fromJust (find (\(m,_) -> n == m) t_sc_table))
+
+-- | List of set classes.
+t_scs :: [[Z12]]
+t_scs = map snd t_sc_table
+
+-- | Cardinality /n/ subset of 't_scs'.
+--
+-- > map (length . t_scs_n) [2..10] == [6,19,43,66,80,66,43,19,6]
+t_scs_n :: Integral i => i -> [[Z12]]
+t_scs_n n = filter ((== n) . genericLength) t_scs
+
+-- | T-related /q/ that are subsets of /p/.
+--
+-- > t_subsets [0,1,2,3,4] [0,1]  == [[0,1],[1,2],[2,3],[3,4]]
+-- > t_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4]]
+-- > t_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6]]
+t_subsets :: [Z12] -> [Z12] -> [[Z12]]
+t_subsets x a = filter (`List.is_subset` x) (map sort (Sro.z_sro_t_related z12 a))
+
+-- | T\/I-related /q/ that are subsets of /p/.
+--
+-- > ti_subsets [0,1,2,3,4] [0,1]  == [[0,1],[1,2],[2,3],[3,4]]
+-- > ti_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4],[0,3,4]]
+-- > ti_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6],[3,6,7]]
+ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
+ti_subsets x a = filter (`List.is_subset` x) (nub (map sort (Sro.z_sro_ti_related z12 a)))
+
+-- | Trivial run length encoder.
+--
+-- > rle "abbcccdde" == [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
+rle :: (Eq a,Integral i) => [a] -> [(i,a)]
+rle =
+    let f x = (genericLength x,head x)
+    in map f . group
+
+-- | Inverse of 'rle'.
+--
+-- > rle_decode [(5,'a'),(4,'b')] == "aaaaabbbb"
+rle_decode :: (Integral i) => [(i,a)] -> [a]
+rle_decode =
+    let f (i,j) = genericReplicate i j
+    in concatMap f
+
+-- | Length of /rle/ encoded sequence.
+--
+-- > rle_length [(5,'a'),(4,'b')] == 9
+rle_length :: (Integral i) => [(i,a)] -> i
+rle_length = sum . map fst
+
+-- | T-equivalence /n/-class vector (subset-class vector, nCV).
+--
+-- > t_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
+-- > rle (t_n_class_vector 3 [0..4]) == [(1,3),(2,2),(2,1),(4,0),(1,1),(9,0)]
+-- > rle (t_n_class_vector 4 [0..4]) == [(1,2),(3,1),(39,0)]
+t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a]
+t_n_class_vector n x =
+    let a = t_scs_n n
+    in map (genericLength . t_subsets x) a
+
+-- | T\/I-equivalence /n/-class vector (subset-class vector, nCV).
+--
+-- > ti_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
+-- > ti_n_class_vector 3 [0,1,2,3,4] == [3,4,2,0,0,1,0,0,0,0,0,0]
+-- > rle (ti_n_class_vector 4 [0,1,2,3,4]) == [(2,2),(1,1),(26,0)]
+ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b]
+ti_n_class_vector n x =
+    let a = Forte.scs_n n
+    in map (genericLength . ti_subsets x) a
+
+-- | 'icv' scaled by sum of /icv/.
+--
+-- > dyad_class_percentage_vector [0,1,2,3,4] == [40,30,20,10,0,0]
+-- > dyad_class_percentage_vector [0,1,4,5,7] == [20,10,20,20,20,10]
+dyad_class_percentage_vector :: Integral i => [Z12] -> [i]
+dyad_class_percentage_vector p =
+    let p' = Forte.z_icv z12 p
+    in map (sum p' *) p'
+
+-- | /rel/ metric.
+--
+-- > rel [0,1,2,3,4] [0,1,4,5,7] == 40
+-- > rel [0,1,2,3,4] [0,2,4,6,8] == 60
+-- > rel [0,1,4,5,7] [0,2,4,6,8] == 60
+rel :: Integral i => [Z12] -> [Z12] -> Ratio i
+rel x y =
+    let x' = dyad_class_percentage_vector x
+        y' = dyad_class_percentage_vector y
+    in sum (map abs (zipWith (-) x' y')) % 2
diff --git a/Music/Theory/Z/Clough_1979.hs b/Music/Theory/Z/Clough_1979.hs
--- a/Music/Theory/Z/Clough_1979.hs
+++ b/Music/Theory/Z/Clough_1979.hs
@@ -6,13 +6,14 @@
 
 import qualified Music.Theory.List as T {- hmt -}
 
--- type Z7 = Int
-
+-- | Shift sequence so the initial value is zero.
+--
+-- > transpose_to_zero [1,2,5] == [0,1,4]
 transpose_to_zero :: Num n => [n] -> [n]
 transpose_to_zero p =
     case p of
       [] -> []
-      n:_ -> map (+ (negate n)) p
+      n:_ -> map (subtract n) p
 
 -- | Diatonic pitch class (Z7) set to /chord/.
 --
@@ -33,8 +34,10 @@
 dpcset_complement p = filter (`notElem` p) z7_univ
 
 -- | Interval class predicate (ie. 'is_z4').
+--
+-- > map is_ic [-1 .. 4] == [False,True,True,True,True,False]
 is_ic :: Integral n => n -> Bool
-is_ic n = n >= 0 && n < 4
+is_ic = is_z4
 
 -- | Interval to interval class.
 --
@@ -48,7 +51,7 @@
 is_chord :: Integral n => [n] -> Bool
 is_chord = (== 7) . sum
 
--- | Interval vector.
+-- | Interval vector, given list of intervals.
 --
 -- > iv [2,2,3] == [0,2,1]
 iv :: Integral n => [n] -> [n]
@@ -97,20 +100,28 @@
 
 -- * Z
 
+-- | Is /n/ in (0,/m/ - 1).
 is_z_n :: Integral n => n -> n -> Bool
 is_z_n m n = n >= 0 && n < m
 
-is_z4 :: Integral n => n -> Bool
-is_z4 = is_z_n 4
-
+-- | Z /m/ universe, ie [0 .. m-1].
 z_n_univ :: Integral n => n -> [n]
 z_n_univ m = [0 .. m - 1]
 
+-- | 'is_z_n' of 4.
+is_z4 :: Integral n => n -> Bool
+is_z4 = is_z_n 4
+
+-- | 'z_n_univ' of 7.
+--
+-- > z7_univ == [0 .. 6]
 z7_univ :: Integral n => [n]
 z7_univ = z_n_univ 7
 
+-- | 'is_z_n' of 7.
 is_z7 :: Integral n => n -> Bool
 is_z7 = is_z_n 7
 
+-- | 'mod' 7.
 mod7 :: Integral n => n -> n
 mod7 n = n `mod` 7
diff --git a/Music/Theory/Z/Drape_1999.hs b/Music/Theory/Z/Drape_1999.hs
--- a/Music/Theory/Z/Drape_1999.hs
+++ b/Music/Theory/Z/Drape_1999.hs
@@ -1,18 +1,367 @@
+-- | Haskell implementations of @pct@ operations.
+-- See <http://rd.slavepianos.org/?t=pct>
 module Music.Theory.Z.Drape_1999 where
 
+import Data.Function {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Music.Theory.List as T {- hmt -}
+import qualified Music.Theory.Set.List as T {- hmt -}
+import qualified Music.Theory.Tuple as T {- hmt -}
 import Music.Theory.Z
-import Music.Theory.Z.SRO
-import Music.Theory.Z.TTO
+import Music.Theory.Z.Forte_1973
+import Music.Theory.Z.Sro
+import Music.Theory.Z.Tto
 
-{- | Relate sets (TnMI).
+-- | Cardinality filter
+--
+-- > cf [0,3] (cg [1..4]) == [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[]]
+cf :: (Integral n) => [n] -> [[a]] -> [[a]]
+cf ns = filter (\p -> genericLength p `elem` ns)
 
+-- | Combinatorial sets formed by considering each set as possible
+-- values for slot.
+--
+-- > cgg [[0,1],[5,7],[3]] == [[0,5,3],[0,7,3],[1,5,3],[1,7,3]]
+-- > let n = "01" in cgg [n,n,n] == ["000","001","010","011","100","101","110","111"]
+cgg :: [[a]] -> [[a]]
+cgg l =
+    case l of
+      x:xs -> [ y:z | y <- x, z <- cgg xs ]
+      _ -> [[]]
+
+-- | Combinations generator, ie. synonym for 'powerset'.
+--
+-- > sort (cg [0,1,3]) == [[],[0],[0,1],[0,1,3],[0,3],[1],[1,3],[3]]
+cg :: [a] -> [[a]]
+cg = T.powerset
+
+-- | Powerset filtered by cardinality.
+--
+-- >>> pct cg -r3 0159
+-- 015
+-- 019
+-- 059
+-- 159
+--
+-- > cg_r 3 [0,1,5,9] == [[0,1,5],[0,1,9],[0,5,9],[1,5,9]]
+cg_r :: (Integral n) => n -> [a] -> [[a]]
+cg_r n = cf [n] . cg
+
+{- | Chain pcsegs.
+
+>>> echo 024579 | pct chn T0 3 | sort -u
+579468 (RT8M)
+579A02 (T5)
+
+> chn_t0 z12 3 [0,2,4,5,7,9] == [[5,7,9,10,0,2],[5,7,9,4,6,8]]
+
+>>> echo 02457t | pct chn T0 2
+7A0135 (RT5I)
+7A81B9 (RT9MI)
+
+> chn_t0 z12 2 [0,2,4,5,7,10] == [[7,10,0,1,3,5],[7,10,8,1,11,9]]
+
+-}
+chn_t0 :: Integral i => Z i -> Int -> [i] -> [[i]]
+chn_t0 z n p =
+    let f q = T.take_right n p == take n q
+    in filter f (z_sro_rtmi_related z p)
+
+{- | Cyclic interval segment.
+
+>>> echo 014295e38t76 | pct cisg
+13A7864529B6
+
+> ciseg z12 [0,1,4,2,9,5,11,3,8,10,7,6] == [1,3,10,7,8,6,4,5,2,9,11,6]
+
+-}
+ciseg :: Integral i => Z i -> [i] -> [i]
+ciseg z = T.d_dx_by (z_sub z) . cyc
+
+-- | Synonynm for 'z_complement'.
+--
+-- >>> pct cmpl 02468t
+-- 13579B
+--
+-- > cmpl z12 [0,2,4,6,8,10] == [1,3,5,7,9,11]
+cmpl :: Integral i => Z i -> [i] -> [i]
+cmpl = z_complement
+
+-- | Form cycle.
+--
+-- >>> echo 056 | pct cyc
+-- 0560
+--
+-- > cyc [0,5,6] == [0,5,6,0]
+cyc :: [a] -> [a]
+cyc l =
+    case l of
+      [] -> []
+      x:xs -> (x:xs) ++ [x]
+
+-- | Diatonic set name. 'd' for diatonic set, 'm' for melodic minor
+-- set, 'o' for octotonic set.
+d_nm :: (Integral a) => [a] -> Maybe Char
+d_nm x =
+    case x of
+      [0,2,4,5,7,9,11] -> Just 'd'
+      [0,2,3,5,7,9,11] -> Just 'm'
+      [0,1,3,4,6,7,9,10] -> Just 'o'
+      _ -> Nothing
+
+-- | Diatonic implications.
+dim :: Integral i => [i] -> [(i,[i])]
+dim p =
+    let g (i,q) = T.is_subset p (z_tto_tn z12 i q)
+        f = filter g . zip [0..11] . repeat
+        d = [0,2,4,5,7,9,11]
+        m = [0,2,3,5,7,9,11]
+        o = [0,1,3,4,6,7,9,10]
+    in f d ++ f m ++ f o
+
+-- | Variant of 'dim' that is closer to the 'pct' form.
+--
+-- >>> pct dim 016
+-- T1d
+-- T1m
+-- T0o
+--
+-- > dim_nm [0,1,6] == [(1,'d'),(1,'m'),(0,'o')]
+dim_nm :: Integral i => [i] -> [(i,Char)]
+dim_nm =
+    let pk f (i,j) = (i,f j)
+    in nubBy ((==) `on` snd) .
+       map (pk (fromMaybe (error "dim_mn") . d_nm)) .
+       dim
+
+-- | Diatonic interval set to interval set.
+--
+-- >>> pct dis 24
+-- 1256
+--
+-- > dis [2,4] == [1,2,5,6]
+dis :: (Integral t) => [Int] -> [t]
+dis =
+    let is = [[], [], [1,2], [3,4], [5,6], [6,7], [8,9], [10,11]]
+    in concatMap (is !!)
+
+-- | Degree of intersection.
+--
+-- >>> echo 024579e | pct doi 6 | sort -u
+-- 024579A
+-- 024679B
+--
+-- > let p = [0,2,4,5,7,9,11]
+-- > doi z12 6 p p == [[0,2,4,5,7,9,10],[0,2,4,6,7,9,11]]
+--
+-- >>> echo 01234 | pct doi 2 7-35 | sort -u
+-- 13568AB
+--
+-- > doi z12 2 (sc "7-35") [0,1,2,3,4] == [[1,3,5,6,8,10,11]]
+doi :: Integral i => Z i -> Int -> [i] -> [i] -> [[i]]
+doi z n p q =
+    let f j = [z_tto_tn z j p,z_tto_tni z j p]
+        xs = concatMap f [0 .. z_modulus z - 1]
+    in T.set (filter (\x -> length (x `intersect` q) == n) xs)
+
+-- | Embedded segment search.
+--
+-- >>> echo 23A | pct ess 0164325
+-- 2B013A9
+-- 923507A
+--
+-- > ess z12 [0,1,6,4,3,2,5] [2,3,10] == [[9,2,3,5,0,7,10],[2,11,0,1,3,10,9]]
+ess :: Integral i => Z i -> [i] -> [i] -> [[i]]
+ess z p q = filter (`T.is_embedding` q) (z_sro_rtmi_related z p)
+
+-- | Forte name (ie 'sc_name').
+fn :: Integral i => [i] -> String
+fn = sc_name
+
+-- | Z-12 cycles.
+frg_cyc :: Integral i => T.T6 [[i]]
+frg_cyc =
+    let add = z_add z12
+        mul = z_mul z12
+        c1 = [[0 .. 11]]
+        c2 = map (\n -> map (add n) [0,2..10]) [0..1]
+        c3 = map (\n -> map (add n) [0,3..9]) [0..2]
+        c4 = map (\n -> map (add n) [0,4..8]) [0..3]
+        c5 = map (map (mul 5)) c1
+        c6 = map (\n -> map (add n) [0,6]) [0..5]
+    in (c1,c2,c3,c4,c5,c6)
+
+-- | Fragmentation of cycles.
+frg :: Integral i =>  [i] -> T.T6 [String]
+frg p =
+    let f = map (\n -> if n `elem` p then z16_to_char n else '-')
+    in T.t6_map (map f) frg_cyc
+
+-- | Header sequence for 'frg_pp'.
+frg_hdr :: [String]
+frg_hdr = map (\n -> "Fragmentation of " ++ show n ++ "-cycle(s)") [1::Int .. 6]
+
+{-| Fragmentation of cycles.
+
+>>> pct frg 024579
+Fragmentation of 1-cycle(s):  [0-2-45-7-9--]
+Fragmentation of 2-cycle(s):  [024---] [--579-]
+Fragmentation of 3-cycle(s):  [0--9] [-47-] [25--]
+Fragmentation of 4-cycle(s):  [04-] [-59] [2--] [-7-]
+Fragmentation of 5-cycle(s):  [05------4927]
+Fragmentation of 6-cycle(s):  [0-] [-7] [2-] [-9] [4-] [5-]
+IC cycle vector: <1> <22> <111> <1100> <5> <000000>
+
+> putStrLn $ frg_pp [0,2,4,5,7,9]
+-}
+frg_pp :: Integral i => [i] -> String
+frg_pp =
+    let f = unwords . map (T.bracket ('[',']'))
+        g x y = x ++ ": " ++ y
+    in unlines . zipWith g frg_hdr . T.t6_to_list . T.t6_map f . frg
+
+-- | Can the set-class q (under prime form algorithm pf) be drawn from the pcset p.
+has_sc_pf :: (Integral a) => ([a] -> [a]) -> [a] -> [a] -> Bool
+has_sc_pf pf p q =
+    let n = length q
+    in pf q `elem` map pf (cf [n] (cg p))
+
+-- | 'has_sc_pf' of 'forte_prime'
+--
+-- > let d = [0,2,4,5,7,9,11]
+-- > has_sc z12 d (z_complement z12 d) == True
+--
+-- > has_sc z12 [] [] == True
+has_sc :: Integral i => Z i -> [i] -> [i] -> Bool
+has_sc z = has_sc_pf (z_forte_prime z)
+
+-- | Interval-class cycle vector.
+ic_cycle_vector :: Integral i => [i] -> T.T6 [Int]
+ic_cycle_vector p =
+    let f str = let str' = if length str > 2 then T.close 1 str else str
+                in length (filter (\(x,y) -> x /= '-' && y /= '-') (T.adj2 1 str'))
+    in T.t6_map (map f) (frg p)
+
+-- | Pretty printer for 'ic_cycle_vector'.
+--
+-- > let r = "IC cycle vector: <1> <22> <111> <1100> <5> <000000>"
+-- > ic_cycle_vector_pp (ic_cycle_vector [0,2,4,5,7,9]) == r
+ic_cycle_vector_pp :: T.T6 [Int] -> String
+ic_cycle_vector_pp = ("IC cycle vector: " ++) . unwords . T.t6_to_list . T.t6_map z16_seq_pp
+
+-- | Interval cycle filter.
+--
+-- >>> echo 22341 | pct icf
+-- 22341
+--
+-- > icf [[2,2,3,4,1]] == [[2,2,3,4,1]]
+icf :: (Num a,Eq a) => [[a]] -> [[a]]
+icf = filter ((== 12) . sum)
+
+-- | Interval class set to interval sets.
+--
+-- >>> pct ici -c 123
+-- 123
+-- 129
+-- 1A3
+-- 1A9
+--
+-- > ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
+ici :: (Num t) => [Int] -> [[t]]
+ici xs =
+    let is j = [[0], [1,11], [2,10], [3,9], [4,8], [5,7], [6]] !! j
+        ys = map is xs
+    in cgg ys
+
+-- | Interval class set to interval sets, concise variant.
+--
+-- > ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
+ici_c :: [Int] -> [[Int]]
+ici_c [] = []
+ici_c (x:xs) = map (x:) (ici xs)
+
+-- | Interval segment (INT).
+iseg :: Integral i => Z i -> [i] -> [i]
+iseg z = T.d_dx_by (z_sub z)
+
+-- | Imbrications.
+--
+-- > let r = [[[0,2,4],[2,4,5],[4,5,7],[5,7,9]]
+-- >         ,[[0,2,4,5],[2,4,5,7],[4,5,7,9]]]
+-- > in imb [3,4] [0,2,4,5,7,9] == r
+imb :: (Integral n) => [n] -> [a] -> [[[a]]]
+imb cs p =
+    let g n = (== n) . genericLength
+        f ps n = filter (g n) (map (genericTake n) ps)
+    in map (f (tails p)) cs
+
+{- | 'issb' gives the set-classes that can append to 'p' to give 'q'.
+
+>>> pct issb 3-7 6-32
+3-7
+3-2
+3-11
+
+> issb (sc "3-7") (sc "6-32") == ["3-2","3-7","3-11"]
+
+-}
+issb :: Integral i => [i] -> [i] -> [String]
+issb p q =
+    let k = length q - length p
+        f = any (\x -> z_forte_prime z12 (nub (p ++ x)) == q) . z_tto_ti_related z12
+    in map sc_name (filter f (cf [k] scs))
+
+-- | Matrix search.
+--
+-- >>> pct mxs 024579 642 | sort -u
+-- 6421B9
+-- B97642
+--
+-- > set (mxs z12 [0,2,4,5,7,9] [6,4,2]) == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
+mxs :: Integral i => Z i -> [i] -> [i] -> [[i]]
+mxs z p q = filter (q `isInfixOf`) (z_sro_rti_related z p)
+
+-- | Normalize (synonym for 'set')
+--
+-- >>> pct nrm 0123456543210
+-- 0123456
+--
+-- > nrm [0,1,2,3,4,5,6,5,4,3,2,1,0] == [0,1,2,3,4,5,6]
+nrm :: (Ord a) => [a] -> [a]
+nrm = T.set
+
+-- | Normalize, retain duplicate elements.
+nrm_r :: (Ord a) => [a] -> [a]
+nrm_r = sort
+
+{- | Pitch-class invariances (called @pi@ at @pct@).
+
+>>> pct pi 0236 12
+pcseg 0236
+pcseg 6320
+pcseg 532B
+pcseg B235
+
+> pci z12 [1,2] [0,2,3,6] == [[0,2,3,6],[5,3,2,11],[6,3,2,0],[11,2,3,5]]
+
+-}
+pci :: Integral i => Z i-> [Int] -> [i] -> [[i]]
+pci z i p =
+    let f q = T.set (map (q !!) i)
+    in filter (\q -> f q == f p) (z_sro_rti_related z p)
+
+{- | Relate sets (TnMI), ie 'z_tto_rel'
+
 >>> $ pct rs 0123 641B
 >>> T1M
 
-> map tto_pp (rs 5 mod12 [0,1,2,3] [6,4,1,11]) == ["T1M","T4MI"]
+> map tto_pp (rs 5 z12 [0,1,2,3] [6,4,1,11]) == ["T1M","T4MI"]
+
 -}
-rs :: Integral t => t -> Z t -> [t] -> [t] -> [TTO t]
-rs = z_tto_rel
+rs :: Integral t => t -> Z t -> [t] -> [t] -> [Tto t]
+rs m z p q = z_tto_rel m z (T.set p) (T.set q)
 
 {- | Relate segments.
 
@@ -25,12 +374,205 @@
 >>> $ pct rsg 0123 B614
 >>> r3RT1M
 
-> let sros = map sro_parse . words
-> rsg 5 mod12 [1,5,6] [3,11,10] == sros "T4I r1RT4MI"
-> rsg 5 mod12 [0,1,2,3] [0,5,10,3] == sros "T0M RT3MI"
-> rsg 5 mod12 [0,1,2,3] [4,11,6,1] == sros "T4MI RT1M"
-> rsg 5 mod12 [0,1,2,3] [11,6,1,4] == sros "r1T4MI r1RT1M"
+> let sros = map (sro_parse 5) . words
+> rsg 5 z12 [1,5,6] [3,11,10] == sros "T4I r1RT4MI"
+> rsg 5 z12 [0,1,2,3] [0,5,10,3] == sros "T0M RT3MI"
+> rsg 5 z12 [0,1,2,3] [4,11,6,1] == sros "T4MI RT1M"
+> rsg 5 z12 [0,1,2,3] [11,6,1,4] == sros "r1T4MI r1RT1M"
 
 -}
-rsg :: Integral i => i -> Z i -> [i] -> [i] -> [SRO i]
-rsg m z x y = filter (\o -> z_sro_apply m z o x == y) (z_sro_univ (length x) z)
+rsg :: Integral i => i -> Z i -> [i] -> [i] -> [Sro i]
+rsg = z_sro_rel
+
+-- | Subsets.
+--
+-- > cf [4] (sb z12 [sc "6-32",sc "6-8"]) == [[0,2,3,5],[0,1,3,5],[0,2,3,7],[0,2,4,7],[0,2,5,7]]
+sb :: Integral i => Z i -> [[i]] -> [[i]]
+sb z xs =
+    let f p = all (\q -> has_sc z q p) xs
+    in filter f scs
+
+{- | scc = set class completion
+
+>>> pct scc 6-32 168
+35A
+49B
+3AB
+34B
+
+> scc z12 (sc "6-32") [1,6,8] == [[3,5,10],[4,9,11],[3,10,11],[3,4,11]]
+
+-}
+scc :: Integral i => Z i -> [i] -> [i] -> [[i]]
+scc z r p = map (\\ p) (filter (T.is_subset p) (z_tto_ti_related z r))
+
+-- | Header fields for 'si'.
+si_hdr :: [String]
+si_hdr =
+    ["pitch-class-set"
+    ,"set-class"
+    ,"interval-class-vector"
+    ,"tics"
+    ,"complement"
+    ,"multiplication-by-five-transform"]
+
+-- | (Pcset,Tto,Forte-Prime)
+type Si i = ([i],Tto i,[i])
+
+-- | Calculator for si.
+--
+-- > si_calc [0,5,3,11]
+si_calc :: Integral i => [i] -> (Si i,[i],[Int],Si i,Si i)
+si_calc p =
+    let n = length p
+        p_icv = fromIntegral n : z_icv z12 p
+        gen_si x = let x_f = z_forte_prime z12 x
+                       x_o = head (rs 5 z12 x_f x)
+                   in (nub (sort x),x_o,x_f)
+    in (gen_si p,p_icv,tics z12 p,gen_si (z_complement z12 p),gen_si (map (z_mul z12 5) p))
+
+-- | Pretty printer for RHS for si.
+--
+-- > si_rhs_pp [0,5,3,11]
+si_rhs_pp :: (Integral i,Show i) => [i] -> [String]
+si_rhs_pp p =
+    let pf_pp concise (x_o,x_f) =
+            concat [tto_pp x_o," ",sc_name x_f
+                   ,if concise then "" else z16_vec_pp x_f]
+        si_pp (x,x_o,x_f) = concat [z16_set_pp x," (",pf_pp True (x_o,x_f),")"]
+        ((p',p_o,p_f),p_icv,p_tics,c,m) = si_calc p
+    in [z16_set_pp p'
+       ,pf_pp False (p_o,p_f)
+       ,z16_vec_pp p_icv
+       ,z16_vec_pp p_tics
+       ,si_pp c
+       ,si_pp m]
+
+{- | Set information.
+
+$ pct si 053b
+pitch-class-set: {035B}
+set-class: TB  4-Z15[0146]
+interval-class-vector: [4111111]
+tics: [102222102022]
+complement: {1246789A} (TAI 8-Z15)
+multiplication-by-five-transform: {0317} (T0  4-Z29)
+$
+
+> putStr $ unlines $ si [0,5,3,11]
+-}
+si :: (Integral i,Show i) => [i] -> [String]
+si p = zipWith (\k v -> concat [k,": ",v]) si_hdr (si_rhs_pp p)
+
+{- | Super set-class.
+
+>>> pct spsc 4-11 4-12
+5-26[02458]
+
+> spsc z12 [sc "4-11",sc "4-12"] == [[0,2,4,5,8]]
+
+>>> pct spsc 3-11 3-8
+4-27[0258]
+4-Z29[0137]
+
+> spsc z12 [sc "3-11",sc "3-8"] == [[0,2,5,8],[0,1,3,7]]
+
+>>> pct spsc `pct fl 3`
+6-Z17[012478]
+
+> spsc z12 (cf [3] scs) == [[0,1,2,4,7,8]]
+
+-}
+spsc :: Integral i => Z i -> [[i]] -> [[i]]
+spsc z xs =
+    let f y = all (has_sc z y) xs
+        g = (==) `on` length
+    in (head . groupBy g . filter f) scs
+
+{- | sra = stravinsky rotational array
+
+>>> echo 019BA7 | pct sra
+019BA7
+08A96B
+021A34
+0B812A
+0923B1
+056243
+
+> let r = [[0,1,9,11,10,7],[0,8,10,9,6,11],[0,2,1,10,3,4],[0,11,8,1,2,10],[0,9,2,3,11,1],[0,5,6,2,4,3]]
+> sra z12 [0,1,9,11,10,7] == r
+
+-}
+sra :: Integral i => Z i -> [i] -> [[i]]
+sra z = map (z_sro_tn_to z 0) . T.rotations
+
+{- | Serial operation.
+
+>>> echo 156 | pct sro T4
+59A
+
+> sro (Z.sro_parse "T4") [1,5,6] == [5,9,10]
+
+>>> echo 024579 | pct sro RT4I
+79B024
+
+> sro (Z.Sro 0 True 4 False True) [0,2,4,5,7,9] == [7,9,11,0,2,4]
+
+>>> echo 156 | pct sro T4I
+3BA
+
+> sro (Z.sro_parse "T4I") [1,5,6] == [3,11,10]
+> sro (Z.Sro 0 False 4 False True) [1,5,6] == [3,11,10]
+
+>>> echo 156 | pct sro T4  | pct sro T0I
+732
+
+> (sro (Z.sro_parse "T0I") . sro (Z.sro_parse "T4")) [1,5,6] == [7,3,2]
+
+>>> echo 024579 | pct sro RT4I
+79B024
+
+> sro (Z.sro_parse "RT4I") [0,2,4,5,7,9] == [7,9,11,0,2,4]
+
+-}
+sro :: Integral i => Z i -> Sro i -> [i] -> [i]
+sro = z_sro_apply
+
+{- | tmatrix
+
+>>> pct tmatrix 1258
+
+1258
+0147
+9A14
+67A1
+
+> tmatrix z12 [1,2,5,8] == [[1,2,5,8],[0,1,4,7],[9,10,1,4],[6,7,10,1]]
+
+-}
+tmatrix :: Integral i => Z i -> [i] -> [[i]]
+tmatrix z p =
+    let i = map (z_negate z) (T.d_dx_by (z_sub z) p)
+    in map (\n -> map (z_add z n) p) (T.dx_d 0 i)
+
+
+{- | trs = transformations search.  Search all RTnMI of /p/ for /q/.
+
+>>> echo 642 | pct trs 024579 | sort -u
+531642
+6421B9
+642753
+B97642
+
+> let r = [[5,3,1,6,4,2],[6,4,2,1,11,9],[6,4,2,7,5,3],[11,9,7,6,4,2]]
+> sort (trs z12 [0,2,4,5,7,9] [6,4,2]) == r
+
+-}
+trs :: Integral i => Z i -> [i] -> [i] -> [[i]]
+trs z p q = filter (q `isInfixOf`) (z_sro_rtmi_related z p)
+
+-- | Like 'trs', but of 'z_sro_rti_related'.
+--
+-- > trs_m z12 [0,2,4,5,7,9] [6,4,2] == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
+trs_m :: Integral i => Z i -> [i] -> [i] -> [[i]]
+trs_m z p q = filter (q `isInfixOf`) (z_sro_rti_related z p)
diff --git a/Music/Theory/Z/Drape_1999/Cli.hs b/Music/Theory/Z/Drape_1999/Cli.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Drape_1999/Cli.hs
@@ -0,0 +1,111 @@
+module Music.Theory.Z.Drape_1999.Cli where
+
+import Data.Char {- base -}
+import Data.Int {- base -}
+
+import Music.Theory.Z {- hmt -}
+import Music.Theory.Z.Drape_1999 {- hmt -}
+import Music.Theory.Z.Forte_1973 {- hmt -}
+import Music.Theory.Z.Sro {- hmt -}
+
+type Z12 = Int8
+
+help :: [String]
+help =
+    ["pct ess pcset"
+    ,"pct fl -c cset"
+    ,"pct frg pcset"
+    ,"pct si [pcset]"
+    ,"pct spsc set-class..."
+    ,"pct sra"
+    ,"pct sro sro"
+    ,"pct tmatrix pcseg"
+    ,"pct trs [-m] pcseg"]
+
+z16_seq_parse :: String -> [Int]
+z16_seq_parse = map digitToInt
+
+pco_parse :: String -> [Z12]
+pco_parse = map fromIntegral . z16_seq_parse
+
+pco_pp :: [Z12] -> String
+pco_pp = map (toUpper . integral_to_digit)
+
+-- > cset_parse "34" == [3,4]
+cset_parse :: String -> [Int]
+cset_parse = map digitToInt
+
+type CMD = String -> String
+
+mk_cmd :: ([Z12] -> [Z12]) -> CMD
+mk_cmd f = pco_pp . f . pco_parse
+
+mk_cmd_many :: ([Z12] -> [[Z12]]) -> CMD
+mk_cmd_many f = unlines . map pco_pp . f . pco_parse
+
+-- > ess_cmd "0164325" "23A" == unlines ["923507A","2B013A9"]
+ess_cmd :: String -> CMD
+ess_cmd p = mk_cmd_many (ess z12 (pco_parse p))
+
+z12_sc_name :: [Z12] -> SC_Name
+z12_sc_name = sc_name
+
+fl_c_cmd :: CMD
+fl_c_cmd = unlines . map z12_sc_name . concatMap scs_n . cset_parse
+
+frg_cmd :: CMD
+frg_cmd p =
+    let p' = pco_parse p
+    in unlines [frg_pp p',ic_cycle_vector_pp (ic_cycle_vector p')]
+
+pi_cmd :: String -> CMD
+pi_cmd p = mk_cmd_many (pci z12 (z16_seq_parse p))
+
+scc_cmd :: String -> CMD
+scc_cmd p = mk_cmd_many (scc z12 (sc p))
+
+si_cmd :: CMD
+si_cmd = unlines . si . pco_parse
+
+z12_sc_name_long :: [Z12] -> SC_Name
+z12_sc_name_long = sc_name_long
+
+-- > spsc_cmd ["4-11","4-12"] == "5-26[02458]\n"
+spsc_cmd :: [String] -> String
+spsc_cmd = unlines . map z12_sc_name_long . spsc z12 . map sc
+
+sra_cmd :: CMD
+sra_cmd = mk_cmd_many (sra z12)
+
+sro_cmd :: String -> CMD
+sro_cmd o = mk_cmd (sro z12 (sro_parse 5 o))
+
+-- > putStrLn $ tmatrix_cmd "1258"
+tmatrix_cmd :: CMD
+tmatrix_cmd = mk_cmd_many (tmatrix z12)
+
+-- > putStrLn $ trs_cmd (trs z12) "024579" "642"
+trs_cmd :: ([Z12] -> [Z12] -> [[Z12]]) -> String -> CMD
+trs_cmd f p = mk_cmd_many (f (pco_parse p))
+
+interact_ln :: CMD -> IO ()
+interact_ln f = interact (unlines . map f . lines)
+
+pct_cli :: [String] -> IO ()
+pct_cli arg = do
+  case arg of
+    ["ess",p] -> interact_ln (ess_cmd p)
+    ["fl","-c",c] -> putStr (fl_c_cmd c)
+    ["frg",p] -> putStr (frg_cmd p)
+    ["pi",p,q] -> putStr (pi_cmd q p)
+    ["scc",p] -> interact_ln (scc_cmd p)
+    ["scc",p,q] -> putStr (scc_cmd p q)
+    ["si"] -> interact_ln si_cmd
+    ["si",p] -> putStr (si_cmd p)
+    "spsc":p -> putStr (spsc_cmd p)
+    ["sra"] -> interact_ln sra_cmd
+    ["sro",o] -> interact_ln (sro_cmd o)
+    ["tmatrix",p] -> putStr (tmatrix_cmd p)
+    ["trs",p] -> interact_ln (trs_cmd (trs z12) p)
+    ["trs","-m",p] -> interact_ln (trs_cmd (trs_m z12) p)
+    _ -> putStrLn (unlines help)
diff --git a/Music/Theory/Z/Forte_1973.hs b/Music/Theory/Z/Forte_1973.hs
--- a/Music/Theory/Z/Forte_1973.hs
+++ b/Music/Theory/Z/Forte_1973.hs
@@ -1,7 +1,8 @@
--- | Allen Forte. /The Structure of Atonal Music/. Yale University
--- Press, New Haven, 1973.
+-- | Allen Forte. /The Structure of Atonal Music/.
+--   Yale University Press, New Haven, 1973.
 module Music.Theory.Z.Forte_1973 where
 
+import Data.Bifunctor {- base -}
 import Data.List {- base -}
 import Data.Maybe {- base -}
 
@@ -10,39 +11,34 @@
 
 import Music.Theory.Unicode {- hmt -}
 import Music.Theory.Z {- hmt -}
-import Music.Theory.Z.SRO {- hmt -}
+import Music.Theory.Z.Sro {- hmt -}
 
 -- * Prime form
 
--- | T-related rotations of /p/.
+-- | T-related rotations of /p/, ie. all rotations tranposed to be at zero.
 --
--- > t_rotations mod12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]]
-t_rotations :: Integral i => Z i -> [i] -> [[i]]
-t_rotations z p =
+-- > z_t_rotations z12 [1,2,4] == [[0,1,3],[0,2,11],[0,9,10]]
+z_t_rotations :: Integral i => Z i -> [i] -> [[i]]
+z_t_rotations z p =
     let r = T.rotations (sort p)
     in map (z_sro_tn_to z 0) r
 
 -- | T\/I-related rotations of /p/.
 --
--- > ti_rotations mod12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]
--- >                               ,[0,9,11],[0,2,3],[0,1,10]]
-ti_rotations :: Integral i => Z i -> [i] -> [[i]]
-ti_rotations z p =
+-- > ti_rotations z12 [0,1,3] == [[0,1,3],[0,2,11],[0,9,10],[0,9,11],[0,2,3],[0,1,10]]
+z_ti_rotations :: Integral i => Z i -> [i] -> [[i]]
+z_ti_rotations z p =
     let q = z_sro_invert z 0 p
         r = T.rotations (sort p) ++ T.rotations (sort q)
     in map (z_sro_tn_to z 0) r
 
--- | Variant with default value for empty input list case.
-minimumBy_or :: t -> (t -> t -> Ordering) -> [t] -> t
-minimumBy_or p f q = if null q then p else minimumBy f q
-
 -- | Prime form rule requiring comparator, considering 't_rotations'.
-t_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
-t_cmp_prime z f = minimumBy_or [] f . t_rotations z
+z_t_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
+z_t_cmp_prime z f = T.minimumBy_or [] f . z_t_rotations z
 
 -- | Prime form rule requiring comparator, considering 'ti_rotations'.
-ti_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
-ti_cmp_prime z f = minimumBy_or [] f . ti_rotations z
+z_ti_cmp_prime :: Integral i => Z i -> ([i] -> [i] -> Ordering) -> [i] -> [i]
+z_ti_cmp_prime z f = T.minimumBy_or [] f . z_ti_rotations z
 
 -- | Forte comparison function (rightmost first then leftmost outwards).
 --
@@ -56,44 +52,52 @@
       _ -> let r = compare (last p) (last q)
            in if r == EQ then compare p q else r
 
--- | Forte prime form, ie. 'cmp_prime' of 'forte_cmp'.
---
--- > forte_prime mod12 [0,1,3,6,8,9] == [0,1,3,6,8,9]
--- > forte_prime mod5 [0,1,4] == [0,1,2]
---
--- > S.set (map (forte_prime mod5) (S.powerset [0..4]))
--- > S.set (map (forte_prime mod7) (S.powerset [0..6]))
-forte_prime :: Integral i => Z i -> [i] -> [i]
-forte_prime z = ti_cmp_prime z forte_cmp
+{- | Forte prime form, ie. 'z_ti_cmp_prime' of 'forte_cmp'.
 
--- | Transpositional equivalence prime form, ie. 't_cmp_prime' of
--- 'forte_cmp'.
+> z_forte_prime z12 [0,1,3,6,8,9] == [0,1,3,6,8,9]
+> z_forte_prime z5 [0,1,4] == [0,1,2]
+> z_forte_prime z5 [0,1,1] -- ERROR
+
+> S.set (map (z_forte_prime z5) (S.powerset [0..4]))
+> S.set (map (z_forte_prime z7) (S.powerset [0..6]))
+-}
+z_forte_prime :: Integral i => Z i -> [i] -> [i]
+z_forte_prime z x =
+  if nub x /= x || map (z_mod z) x /= x
+  then error "z_forte_prime: invalid input"
+  else z_ti_cmp_prime z forte_cmp x
+
+-- | Transpositional equivalence prime form,
+--   ie. 'z_t_cmp_prime' of 'forte_cmp'.
 --
--- > (forte_prime mod12 [0,2,3],t_prime mod12 [0,2,3]) == ([0,1,3],[0,2,3])
-t_prime :: Integral i => Z i -> [i] -> [i]
-t_prime z = t_cmp_prime z forte_cmp
+-- > (z_forte_prime z12 [0,2,3],z_t_prime z12 [0,2,3]) == ([0,1,3],[0,2,3])
+z_t_prime :: Integral i => Z i -> [i] -> [i]
+z_t_prime z = z_t_cmp_prime z forte_cmp
 
 -- * ICV Metric
 
 -- | Interval class of interval /i/.
 --
--- > map (ic 12) [0..11] == [0,1,2,3,4,5,6,5,4,3,2,1]
--- > map (ic 7) [0..6] == [0,1,2,3,3,2,1]
--- > map (ic 5) [1,2,3,4] == [1,2,2,1]
--- > map (ic 12) [5,6,7] == [5,6,5]
--- > map (ic 12 . to_Z mod12) [-13,-1,0,1,13] == [1,1,0,1,1]
-ic :: Integral i => i -> i -> i
-ic z i = if i <= (z `div` 2) then i else z - i
+-- > map (z_ic z12) [0..12] == [0,1,2,3,4,5,6,5,4,3,2,1,0]
+-- > map (z_ic z7) [0..7] == [0,1,2,3,3,2,1,0]
+-- > map (z_ic z5) [0..5] == [0,1,2,2,1,0]
+-- > map (z_ic z12) [5,6,7] == [5,6,5]
+-- > map (z_ic z12) [-13,-1,0,1,13] == [1,1,0,1,1]
+z_ic :: Integral i => Z i -> i -> i
+z_ic z i =
+  let j = z_mod z i
+      m = z_modulus z
+  in if j <= (m `div` 2) then j else m - j
 
 -- | Forte notation for interval class vector.
 --
--- > icv 12 [0,1,2,4,7,8] == [3,2,2,3,3,2]
-icv :: (Integral i, Num n) => i -> [i] -> [n]
-icv z s =
-    let i = map (ic z . flip mod z . uncurry (-)) (S.pairs s)
+-- > z_icv z12 [0,1,2,4,7,8] == [3,2,2,3,3,2]
+z_icv :: (Integral i, Num n) => Z i -> [i] -> [n]
+z_icv z s =
+    let i = map (z_ic z . z_mod z . uncurry (-)) (S.pairs s)
         f l = (head l,genericLength l)
         j = map f (group (sort i))
-        k = map (`lookup` j) [1 .. z `div` 2]
+        k = map (`lookup` j) [1 .. z_modulus z `div` 2]
     in map (fromMaybe 0) k
 
 -- * BIP Metric
@@ -104,43 +108,36 @@
 -- >>> bip 0t95728e3416
 -- 11223344556
 --
--- > bip 12 [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
-bip :: Integral a => a -> [a] -> [a]
-bip z = sort . map (ic z . flip mod z) . T.d_dx
-
--- * Name
+-- > z_bip z12 [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
+z_bip :: Integral i => Z i -> [i] -> [i]
+z_bip z = sort . map (z_ic z . z_mod z) . T.d_dx
 
 {- | Generate SC universe, though not in order of the Forte table.
 
-> let r = [[]
->         ,[0]
->         ,[0,1],[0,2],[0,3]
->         ,[0,1,2],[0,1,3],[0,1,4],[0,2,4]
->         ,[0,1,2,3],[0,1,2,4],[0,1,3,4],[0,1,3,5]
->         ,[0,1,2,3,4],[0,1,2,3,5],[0,1,2,4,5]
->         ,[0,1,2,3,4,5]
->         ,[0,1,2,3,4,5,6]]
-> in sc_univ mod7 == r
-
-> sort (sc_univ mod12) == sort (map snd sc_table)
-
-> zipWith (\p q -> (p == q,p,q)) (sc_univ mod12) (map snd sc_table)
+> length (z_sc_univ z7) == 18
+> sort (z_sc_univ z12) == sort (map snd sc_table)
+> zipWith (\p q -> (p == q,p,q)) (z_sc_univ z12) (map snd sc_table)
 
 -}
-sc_univ :: Integral i => Z i -> [[i]]
-sc_univ z =
-    T.sort_by_two_stage length id $
+z_sc_univ :: Integral i => Z i -> [[i]]
+z_sc_univ z =
+    T.sort_by_two_stage_on length id $
     nub $
-    map (forte_prime z) $
+    map (z_forte_prime z) $
     S.powerset (z_univ z)
 
+-- * Forte Names (Z12)
+
 -- | Synonym for 'String'.
 type SC_Name = String
 
--- | The set-class table (Forte prime forms).
+-- | Table of (SC-NAME,PCSET).
+type SC_Table n = [(SC_Name,[n])]
+
+-- | The Z12 set-class table (Forte prime forms).
 --
 -- > length sc_table == 224
-sc_table :: Num n => [(SC_Name,[n])]
+sc_table :: Num n => SC_Table n
 sc_table =
     [("0-1",[])
     ,("1-1",[0])
@@ -368,10 +365,10 @@
     ,("12-1",[0,1,2,3,4,5,6,7,8,9,10,11])]
 
 -- | Unicode (non-breaking hyphen) variant.
-sc_table_unicode :: Num n => [(SC_Name,[n])]
+sc_table_unicode :: Num n => SC_Table n
 sc_table_unicode =
     let f = map (\c -> if c == '-' then non_breaking_hypen else c)
-    in map (\(nm,pc) -> (f nm,pc)) sc_table
+    in map (first f) sc_table
 
 -- | Lookup name of prime form of set class.  It is an error for the
 -- input not to be a forte prime form.
@@ -380,34 +377,37 @@
 forte_prime_name :: (Num n,Eq n) => [n] -> (SC_Name,[n])
 forte_prime_name p = fromMaybe (error "forte_prime_name") (find (\(_,q) -> p == q) sc_table)
 
-sc_tbl_lookup :: Integral i => Z i -> [(SC_Name,[i])] -> [i] -> Maybe (SC_Name,[i])
-sc_tbl_lookup z tbl p = find (\(_,q) -> forte_prime z p == q) tbl
+-- | Lookup entry for set in table.
+sc_tbl_lookup :: Integral i => SC_Table i -> [i] -> Maybe (SC_Name,[i])
+sc_tbl_lookup tbl p = find (\(_,q) -> z_forte_prime z12 p == q) tbl
 
-sc_tbl_lookup_err :: Integral i => Z i -> [(SC_Name,[i])] -> [i] -> (SC_Name,[i])
-sc_tbl_lookup_err z tbl = fromMaybe (error "sc_tbl_lookup") . sc_tbl_lookup z tbl
+-- | Erroring variant
+sc_tbl_lookup_err :: Integral i => SC_Table i -> [i] -> (SC_Name,[i])
+sc_tbl_lookup_err tbl = fromMaybe (error "sc_tbl_lookup") . sc_tbl_lookup tbl
 
-sc_name' :: Integral i => Z i -> [(SC_Name,[i])] -> [i] -> SC_Name
-sc_name' z tbl = fst . sc_tbl_lookup_err z tbl
+-- | 'fst' of 'sc_tbl_lookup_err'
+sc_name_tbl :: Integral i => SC_Table i -> [i] -> SC_Name
+sc_name_tbl tbl = fst . sc_tbl_lookup_err tbl
 
 -- | Lookup a set-class name.  The input set is subject to
--- 'forte_prime' before lookup.
+-- 'forte_prime' of 'z12' before lookup.
 --
--- > sc_name mod12 [0,2,3,6,7] == "5-Z18"
--- > sc_name mod12 [0,1,4,6,7,8] == "6-Z17"
-sc_name :: Integral i => Z i -> [i] -> SC_Name
-sc_name z = sc_name' z sc_table
+-- > sc_name [0,2,3,6,7] == "5-Z18"
+-- > sc_name [0,1,4,6,7,8] == "6-Z17"
+sc_name :: Integral i => [i] -> SC_Name
+sc_name = sc_name_tbl sc_table
 
 -- | Long name (ie. with enumeration of prime form).
 --
--- > sc_name_long mod12 [0,1,4,6,7,8] == "6-Z17[012478]"
-sc_name_long :: Integral i => Z i -> [i] -> SC_Name
-sc_name_long z p =
-    let (nm,p') = sc_tbl_lookup_err z sc_table p
+-- > sc_name_long [0,1,4,6,7,8] == "6-Z17[012478]"
+sc_name_long :: Integral i => [i] -> SC_Name
+sc_name_long p =
+    let (nm,p') = sc_tbl_lookup_err sc_table p
     in nm ++ z16_vec_pp p'
 
 -- | Unicode (non-breaking hyphen) variant.
-sc_name_unicode :: Integral i => Z i -> [i] -> SC_Name
-sc_name_unicode z = sc_name' z sc_table_unicode
+sc_name_unicode :: Integral i => [i] -> SC_Name
+sc_name_unicode = sc_name_tbl sc_table_unicode
 
 -- | Lookup a set-class given a set-class name.
 --
@@ -415,6 +415,7 @@
 sc :: Num n => SC_Name -> [n]
 sc n = snd (fromMaybe (error "sc") (find (\(m,_) -> n == m) sc_table))
 
+-- | The set-class table (Forte prime forms), ie. 'snd' of 'sc_table'.
 scs :: Num n => [[n]]
 scs = map snd sc_table
 
@@ -426,7 +427,8 @@
 
 -- | Vector indicating degree of intersection with inversion at each transposition.
 --
--- > tics mod12 [0,2,4,5,7,9] == [3,2,5,0,5,2,3,4,1,6,1,4]
+-- > tics z12 [0,2,4,5,7,9] == [3,2,5,0,5,2,3,4,1,6,1,4]
+-- > map (tics z12) scs
 tics :: Integral i => Z i -> [i] -> [Int]
 tics z p =
     let q = z_sro_t_related z (z_sro_invert z 0 p)
@@ -436,13 +438,13 @@
 
 -- | Locate /Z/ relation of set class.
 --
--- > fmap (sc_name mod12) (z_relation_of 12 (sc "7-Z12")) == Just "7-Z36"
-z_relation_of :: Integral i => i -> [i] -> Maybe [i]
-z_relation_of z x =
+-- > fmap sc_name (z_relation_of (sc "7-Z12")) == Just "7-Z36"
+z_relation_of :: Integral i => [i] -> Maybe [i]
+z_relation_of x =
     let n = length x
         eq_i :: [Integer] -> [Integer] -> Bool
         eq_i = (==)
-        f y = (x /= y) && (icv z x `eq_i` icv z y)
+        f y = (x /= y) && (z_icv z12 x `eq_i` z_icv z12 y)
     in case filter f (scs_n n) of
          [] -> Nothing
          [r] -> Just r
diff --git a/Music/Theory/Z/Lewin_1980.hs b/Music/Theory/Z/Lewin_1980.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Lewin_1980.hs
@@ -0,0 +1,50 @@
+-- | David Lewin. \"A Response to a Response: On PC Set
+-- Relatedness\". /Perspectives of New Music/, 18(1-2):498-502, 1980.
+module Music.Theory.Z.Lewin_1980 where
+
+import Data.Int {- base -}
+import Data.List {- base -}
+
+import qualified Music.Theory.Z.Castren_1994 as Castren
+
+type Z12 = Int8
+
+-- | REL function with given /ncv/ function (see 't_rel' and 'ti_rel').
+rel :: Floating n => (Int -> [a] -> [n]) -> [a] -> [a] -> n
+rel ncv x y =
+    let n = min (genericLength x) (genericLength y)
+        p = map (`ncv` x) [2..n]
+        q = map (`ncv` y) [2..n]
+        f = zipWith (\i j -> sqrt (i * j))
+        pt = sum (map sum p)
+        qt = sum (map sum q)
+    in sum (map sum (zipWith f p q)) / sqrt (pt * qt)
+
+-- | T-equivalence REL function.
+--
+-- Kuusi 2001, 7.5.2
+--
+-- > let (~=) p q = abs (p - q) < 0.001
+-- > t_rel [0,1,2,3,4] [0,2,3,6,7] ~= 0.429
+-- > t_rel [0,1,2,3,4] [0,2,4,6,8] ~= 0.253
+-- > t_rel [0,2,3,6,7] [0,2,4,6,8] ~= 0.324
+t_rel :: Floating n => [Z12] -> [Z12] -> n
+t_rel = rel Castren.t_n_class_vector
+
+-- | T/I-equivalence REL function.
+--
+-- Buchler 1998, Fig. 3.38
+--
+-- > let (~=) p q = abs (p - q) < 0.001
+-- > let a = [0,2,3,5,7]::[Z12]
+-- > let b = [0,2,3,4,5,8]::[Z12]
+-- > let g = [0,1,2,3,5,6,8,10]::[Z12]
+-- > let j = [0,2,3,4,5,6,8]::[Z12]
+-- > ti_rel a b ~= 0.593
+-- > ti_rel a g ~= 0.648
+-- > ti_rel a j ~= 0.509
+-- > ti_rel b g ~= 0.712
+-- > ti_rel b j ~= 0.892
+-- > ti_rel g j ~= 0.707
+ti_rel :: Floating n => [Z12] -> [Z12] -> n
+ti_rel = rel Castren.ti_n_class_vector
diff --git a/Music/Theory/Z/Literature.hs b/Music/Theory/Z/Literature.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Literature.hs
@@ -0,0 +1,48 @@
+-- | Z12 set class database.
+module Music.Theory.Z.Literature where
+
+-- | Set class database with descriptors for historically and
+-- theoretically significant set classes, indexed by Forte name.
+--
+-- > lookup "6-Z17" sc_db == Just "All-Trichord Hexachord"
+-- > lookup "7-35" sc_db == Just "diatonic collection (d)"
+sc_db :: [(String,String)]
+sc_db =
+    [("4-Z15","All-Interval Tetrachord (see also 4-Z29)")
+    ,("4-Z29","All-Interval Tetrachord (see also 4-Z15)")
+    ,("6-Z17","All-Trichord Hexachord")
+    ,("8-Z15","All-Tetrachord Octochord (see also 8-Z29)")
+    ,("8-Z29","All-Tetrachord Octochord (see also 8-Z15)")
+    ,("6-1","A-Type All-Combinatorial Hexachord")
+    ,("6-8","B-Type All-Combinatorial Hexachord")
+    ,("6-32","C-Type All-Combinatorial Hexachord")
+    ,("6-7","D-Type All-Combinatorial Hexachord")
+    ,("6-20","E-Type All-Combinatorial Hexachord")
+    ,("6-35","F-Type All-Combinatorial Hexachord")
+    ,("7-35","diatonic collection (d)")
+    ,("7-34","ascending melodic minor collection")
+    ,("8-28","octotonic collection (Messiaen Mode II)")
+    ,("6-35","wholetone collection")
+    ,("3-10","diminished triad")
+    ,("3-11","major/minor triad")
+    ,("3-12","augmented triad")
+    ,("4-19","minor major-seventh chord")
+    ,("4-20","major-seventh chord")
+    ,("4-25","french augmented sixth chord")
+    ,("4-28","dimished-seventh chord")
+    ,("4-26","minor-seventh chord")
+    ,("4-27","half-dimished seventh(P)/dominant-seventh(I) chord")
+    ,("6-30","Petrushka Chord {0476a1},3-11 at T6")
+    ,("6-34","Mystic Chord {06a492}")
+    ,("6-Z44","Schoenberg Signature Set,3-3 at T5 or T7")
+    ,("6-Z19","complement of 6-Z44,3-11 at T1 or TB")
+    ,("9-12","Messiaen Mode III (nontonic collection)")
+    ,("8-9","Messian Mode IV")
+    ,("7-31","The only seven-element subset of 8-28. ")
+    ,("5-31","The only five-element superset of 4-28.")
+    ,("5-33","The only five-element subset of 6-35.")
+    ,("7-33","The only seven-element superset of 6-35.")
+    ,("5-21","The only five-element subset of 6-20.")
+    ,("7-21","The only seven-element superset of 6-20.")
+    ,("5-25","The only five-element subset of both 7-35 and 8-28.")
+    ,("6-14","Any non-intersecting union of 3-6 and 3-12.") ]
diff --git a/Music/Theory/Z/Morris_1974.hs b/Music/Theory/Z/Morris_1974.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Morris_1974.hs
@@ -0,0 +1,49 @@
+-- | Robert Morris and D. Starr. \"The Structure of All-Interval Series\".
+-- /Journal of Music Theory/, 18:364-389, 1974.
+module Music.Theory.Z.Morris_1974 where
+
+import Control.Monad {- base -}
+
+import qualified Control.Monad.Logic as L {- logict -}
+
+-- | 'msum' '.' 'map' 'return'.
+--
+-- > L.observeAll (fromList [1..7]) == [1..7]
+fromList :: MonadPlus m => [a] -> m a
+fromList = msum . map return
+
+-- | Interval from /i/ to /j/ in modulo-/n/.
+--
+-- > let f = int_n 12 in (f 0 11,f 11 0) == (11,1)
+int_n :: Integral a => a -> a -> a -> a
+int_n n i j = abs ((j - i) `mod` n)
+
+-- | 'L.MonadLogic' all-interval series.
+--
+-- > map (length . L.observeAll . all_interval_m) [4,6,8,10] == [2,4,24,288]
+-- > [0,1,3,2,9,5,10,4,7,11,8,6] `elem` L.observeAll (all_interval_m 12)
+-- > length (L.observeAll (all_interval_m 12)) == 3856
+all_interval_m :: (MonadPlus m, L.MonadLogic m) => Int -> m [Int]
+all_interval_m n =
+    let recur k p q = -- k = length p, p = pitch-class sequence, q = interval set
+            if k == n
+            then return (reverse p)
+            else do i <- fromList [1 .. n - 1]
+                    guard (i `notElem` p)
+                    let j = head p
+                        m = int_n n i j
+                    guard (m `notElem` q)
+                    recur (k + 1) (i : p) (m : q)
+    in recur 1 [0] []
+
+{- | 'L.observeAll' of 'all_interval_m'.
+
+> let r = [[0,1,5,2,4,3],[0,2,1,4,5,3],[0,4,5,2,1,3],[0,5,1,4,2,3]]
+> all_interval 6 == r
+
+> d_dx_n n l = zipWith (int_n n) l (tail l)
+> map (d_dx_n 6) r == [[1,4,3,2,5],[2,5,3,1,4],[4,1,3,5,2],[5,2,3,4,1]]
+
+-}
+all_interval :: Int -> [[Int]]
+all_interval = L.observeAll . all_interval_m
diff --git a/Music/Theory/Z/Morris_1987.hs b/Music/Theory/Z/Morris_1987.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Morris_1987.hs
@@ -0,0 +1,12 @@
+-- | Robert Morris. /Composition with Pitch-Classes: A Theory of
+-- Compositional Design/. Yale University Press, New Haven, 1987.
+module Music.Theory.Z.Morris_1987 where
+
+import Music.Theory.List {- hmt -}
+import Music.Theory.Z {- hmt -}
+
+-- | @INT@ operator.
+--
+-- > map (int z12) [[0,1,3,6,10],[3,7,0]] == [[1,2,3,4],[4,5]]
+int :: Integral i => Z i -> [i] -> [i]
+int z = d_dx_by (z_sub z)
diff --git a/Music/Theory/Z/Morris_1987/Parse.hs b/Music/Theory/Z/Morris_1987/Parse.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Morris_1987/Parse.hs
@@ -0,0 +1,19 @@
+-- | Parsers for pitch class sets and sequences, and for 'SRO's.
+module Music.Theory.Z.Morris_1987.Parse where
+
+import Data.Char {- base -}
+
+-- | Parse a /pitch class object/ string.  Each 'Char' is either a
+-- number, a space which is ignored, or a letter name for the numbers
+-- 10 ('t' or 'a' or 'A') or 11 ('e' or 'B' or 'b').
+--
+-- > pco "13te" == [1,3,10,11]
+-- > pco "13te" == pco "13ab"
+pco :: Num n => String -> [n]
+pco s =
+    let s' = dropWhile isSpace s
+        s'' = takeWhile (`elem` "0123456789taAebB") s'
+        f c | c `elem` "taA" = 10
+            | c `elem` "ebB" = 11
+            | otherwise = fromInteger (read [c])
+    in map f s''
diff --git a/Music/Theory/Z/Rahn_1980.hs b/Music/Theory/Z/Rahn_1980.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Rahn_1980.hs
@@ -0,0 +1,29 @@
+-- | John Rahn. /Basic Atonal Theory/. Longman, New York, 1980.
+module Music.Theory.Z.Rahn_1980 where
+
+import qualified Music.Theory.Z.Forte_1973 as Forte_1973 {- hmt -}
+import Music.Theory.Z {- hmt -}
+
+-- | Rahn prime form (comparison is rightmost inwards).
+--
+-- > rahn_cmp [0,1,3,6,8,9] [0,2,3,6,7,9] == GT
+rahn_cmp :: Ord a => [a] -> [a] -> Ordering
+rahn_cmp p q = compare (reverse p) (reverse q)
+
+-- | Rahn prime form, ie. 'Forte_1973.ti_cmp_prime' of 'rahn_cmp'.
+--
+-- > z_rahn_prime z12 [0,1,3,6,8,9] == [0,2,3,6,7,9]
+z_rahn_prime :: Integral i => Z i -> [i] -> [i]
+z_rahn_prime z = Forte_1973.z_ti_cmp_prime z rahn_cmp
+
+-- | The six sets where the Forte and Rahn prime forms differ.
+--   Given here in Forte prime form.
+--
+-- > all (\p -> Forte_1973.forte_prime z12 p /= rahn_prime z12 p) rahn_forte_diff == True
+rahn_forte_diff :: Num n => [[n]]
+rahn_forte_diff =
+  [[0,1,3,7,8] -- #5
+  ,[0,1,3,5,8,9],[0,1,3,6,8,9] -- #6
+  ,[0,1,2,4,7,8,9],[0,1,2,3,5,8,9] -- #7
+  ,[0,1,2,4,5,7,9,10] -- #8
+  ]
diff --git a/Music/Theory/Z/Read_1978.hs b/Music/Theory/Z/Read_1978.hs
--- a/Music/Theory/Z/Read_1978.hs
+++ b/Music/Theory/Z/Read_1978.hs
@@ -7,84 +7,99 @@
 import Data.Char {- base -}
 import Data.List {- base -}
 import Data.Maybe {- base -}
-
-import qualified Music.Theory.List as T {- hmt -}
+import Data.Word {- base -}
 
+import qualified Music.Theory.List as List {- hmt -}
 import qualified Music.Theory.Z as Z {- hmt -}
-import qualified Music.Theory.Z.SRO as Z {- hmt -}
+import qualified Music.Theory.Z.Sro as Sro {- hmt -}
 
 -- | Coding.
-type Code = Int
+type Code = Word64
 
+-- | Number of bits at 'Code'.
+code_len :: Num n => n
+code_len = 64
+
 -- | Bit array.
-type Array = [Bool]
+type Bit_Array = [Bool]
 
--- | Pretty printer for 'Array'.
-array_pp :: Array -> String
-array_pp = map intToDigit . map fromEnum
+-- | Logical complement.
+bit_array_complement :: Bit_Array -> Bit_Array
+bit_array_complement = map not
 
--- | Parse PP of 'Array'.
+-- | Pretty printer for 'Bit_Array'.
+bit_array_pp :: Bit_Array -> String
+bit_array_pp = map (intToDigit . fromEnum)
+
+-- | Parse PP of 'Bit_Array'.
 --
--- > parse_array "01001" == [False,True,False,False,True]
-parse_array :: String -> Array
-parse_array = map (toEnum . digitToInt)
+-- > bit_array_parse "01001" == [False,True,False,False,True]
+bit_array_parse :: String -> Bit_Array
+bit_array_parse = map (toEnum . digitToInt)
 
--- | Generate 'Code' from 'Array', the coding is most to least significant.
+-- * MSB (BIG-ENDIAN)
+
+-- | Generate 'Code' from 'Bit_Array', the coding is most to least significant.
 --
--- > array_to_code (map toEnum [1,1,0,0,1,0,0,0,1,1,1,0,0]) == 6428
-array_to_code :: Array -> Code
-array_to_code a =
-    let n = length a
-        f e j = if e then 2 ^ (n - j - 1) else 0
-    in sum (zipWith f a [0..])
+-- > map (bit_array_to_code . bit_array_parse) (words "000 001 010 011 100 101 110 111") == [0..7]
+-- > bit_array_to_code (bit_array_parse "1100100011100") == 6428
+bit_array_to_code :: Bit_Array -> Code
+bit_array_to_code a =
+  let n = length a
+      f e j = if e then 2 ^ (n - j - 1) else 0
+  in if n > code_len
+     then error "bit_array_to_code: > SZ"
+     else sum (zipWith f a [0..])
 
--- | Inverse of 'array_to_code'.
+-- | Inverse of 'bit_array_to_code'.
 --
--- > code_to_array 13 6428 == map toEnum [1,1,0,0,1,0,0,0,1,1,1,0,0]
-code_to_array :: Int -> Code -> Array
-code_to_array n c = map (testBit c) [n - 1, n - 2 .. 0]
+-- > code_to_bit_array 13 6428 == bit_array_parse "1100100011100"
+code_to_bit_array :: Int -> Code -> Bit_Array
+code_to_bit_array n c =
+  if n > code_len
+  then error "code_to_bit_array: > SZ"
+  else map (testBit c) [n - 1, n - 2 .. 0]
 
--- | Array to set.
+-- | 'Bit_Array' to set.
 --
--- > array_to_set (map toEnum [1,1,0,0,1,0,0,0,1,1,1,0,0]) == [0,1,4,8,9,10]
--- > encode [0,1,4,8,9,10] == 1811
-array_to_set :: Integral i => [Bool] -> [i]
-array_to_set =
+-- > bit_array_to_set (bit_array_parse "1100100011100") == [0,1,4,8,9,10]
+-- > set_to_code 13 [0,1,4,8,9,10] == 6428
+bit_array_to_set :: Integral i => Bit_Array -> [i]
+bit_array_to_set =
     let f (i,e) = if e then Just i else Nothing
     in mapMaybe f . zip [0..]
 
--- | Inverse of 'array_to_set', /z/ is the degree of the array.
-set_to_array :: Integral i => i -> [i] -> Array
-set_to_array z p = map (`elem` p) [0 .. z - 1]
+-- | Inverse of 'bit_array_to_set', /z/ is the degree of the array.
+set_to_bit_array :: Integral i => i -> [i] -> Bit_Array
+set_to_bit_array z p =
+  if z > code_len
+  then error "set_to_bit_array: > SZ"
+  else map (`elem` p) [0 .. z - 1]
 
--- | 'array_to_code' of 'set_to_array'.
+-- | 'bit_array_to_code' of 'set_to_bit_array'.
 --
 -- > set_to_code 12 [0,2,3,5] == 2880
--- > map (set_to_code 12) (T.z_ti_related (flip mod 12) [0,2,3,5])
+-- > map (set_to_code 12) (Sro.z_sro_ti_related (flip mod 12) [0,2,3,5])
 set_to_code :: Integral i => i -> [i] -> Code
-set_to_code z = array_to_code . set_to_array z
-
--- | Logical complement.
-array_complement :: Array -> Array
-array_complement = map not
+set_to_code z = bit_array_to_code . set_to_bit_array z
 
 -- | The /prime/ form is the 'maximum' encoding.
 --
--- > array_is_prime (set_to_array 12 [0,2,3,5]) == False
-array_is_prime :: Array -> Bool
-array_is_prime a =
-    let c = array_to_code a
-        p = array_to_set a
+-- > bit_array_is_prime (set_to_bit_array 12 [0,2,3,5]) == False
+bit_array_is_prime :: Bit_Array -> Bool
+bit_array_is_prime a =
+    let c = bit_array_to_code a
+        p = bit_array_to_set a
         n = length a
-        z = flip mod n
-        u = maximum (map (set_to_code n) (Z.z_sro_ti_related z p))
+        z = Z.Z n
+        u = maximum (map (set_to_code n) (Sro.z_sro_ti_related z p))
     in c == u
 
 -- | The augmentation rule adds @1@ in each empty slot at end of array.
 --
--- > map array_pp (array_augment (parse_array "01000")) == ["01100","01010","01001"]
-array_augment :: Array -> [Array]
-array_augment a =
+-- > map bit_array_pp (bit_array_augment (bit_array_parse "01000")) == ["01100","01010","01001"]
+bit_array_augment :: Bit_Array -> [Bit_Array]
+bit_array_augment a =
     let (z,a') = break id (reverse a)
         a'' = reverse a'
         n = length z
@@ -93,55 +108,61 @@
     in map (a'' ++) x
 
 -- | Enumerate first half of the set-classes under given /prime/ function.
--- The second half can be derived as the complement of the first.
+--   The second half can be derived as the complement of the first.
 --
--- > import Music.Theory.Z12.Forte_1973
+-- > import Music.Theory.Z.Forte_1973
 -- > length scs == 224
 -- > map (length . scs_n) [0..12] == [1,1,6,12,29,38,50,38,29,12,6,1,1]
 --
--- > let z12 = map (fmap (map array_to_set)) (enumerate_half array_is_prime 12)
+-- > let z12 = map (fmap (map bit_array_to_set)) (enumerate_half bit_array_is_prime 12)
 -- > map (length . snd) z12 == [1,1,6,12,29,38,50]
 --
 -- This can become slow, edit /z/ to find out.  It doesn't matter
 -- about /n/.  This can be edited so that small /n/ would run quickly
 -- even for large /z/.
 --
--- > fmap (map array_to_set) (lookup 5 (enumerate_half array_is_prime 16))
-enumerate_half :: (Array -> Bool) -> Int -> [(Int,[Array])]
+-- > fmap (map bit_array_to_set) (lookup 5 (enumerate_half bit_array_is_prime 16))
+enumerate_half :: (Bit_Array -> Bool) -> Int -> [(Int,[Bit_Array])]
 enumerate_half pr n =
     let a0 = replicate n False
         f k a = if k >= n `div` 2
                 then []
-                else let r = filter pr (array_augment a)
+                else let r = filter pr (bit_array_augment a)
                      in (k + 1,r) : concatMap (f (k + 1)) r
         jn l = case l of
                  (x,y):l' -> (x,concat (y : map snd l'))
                  _ -> error ""
-        post_proc = map jn . T.group_on fst . sortOn fst
+        post_proc = map jn . List.group_on fst . sortOn fst
     in post_proc ((0,[a0]) : f 0 a0)
 
--- * Alternate (reverse) form.
+-- * LSB - LITTLE-ENDIAN
 
+-- | If the size of the set is '>' 'code_len' then 'error', else 'id'.
+set_coding_validate :: [t] -> [t]
+set_coding_validate l = if length l <= code_len then l else error "set_coding_validate: SIZE"
+
 -- | Encoder for 'encode_prime'.
 --
--- > encode [0,1,3,6,8,9] == 843
-encode :: Integral i => [i] -> Code
-encode = sum . map (2 ^)
+-- > map set_encode [[0,1,3,7,8],[0,1,3,6,8,9]] == [395,843]
+--
+-- > map (set_to_code 12) [[0,1,3,7,8],[0,1,3,6,8,9]] == [3352,3372]
+set_encode :: Integral i => [i] -> Code
+set_encode = sum . map (2 ^) . set_coding_validate
 
 -- | Decoder for 'encode_prime'.
 --
--- > decode 12 843 == [0,1,3,6,8,9]
-decode :: Integral i => i -> Code -> [i]
-decode z n =
-    let f i = (i,testBit n (fromIntegral i))
+-- > map (set_decode 12) [395,843] == [[0,1,3,7,8],[0,1,3,6,8,9]]
+set_decode :: Integral i => Int -> Code -> [i]
+set_decode z n =
+    let f i = (fromIntegral i,testBit n i)
     in map fst (filter snd (map f [0 .. z - 1]))
 
 -- | Binary encoding prime form algorithm, equalivalent to Rahn.
 --
--- > encode_prime Z.mod12 [0,1,3,6,8,9] == [0,2,3,6,7,9]
--- > Music.Theory.Z12.Rahn_1980.rahn_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
-encode_prime :: Integral i => Z.Z i -> [i] -> [i]
-encode_prime z s =
-    let t = map (\x -> Z.z_sro_tn z x s) (Z.z_univ z)
-        c = t ++ map (Z.z_sro_invert z 0) t
-    in decode (Z.z_modulus z) (minimum (map encode c))
+-- > set_encode_prime Z.z12 [0,1,3,6,8,9] == [0,2,3,6,7,9]
+-- > Music.Theory.Z.Rahn_1980.rahn_prime Z.z12 [0,1,3,6,8,9] == [0,2,3,6,7,9]
+set_encode_prime :: Integral i => Z.Z i -> [i] -> [i]
+set_encode_prime z s =
+    let t = map (\x -> Sro.z_sro_tn z x s) (Z.z_univ z)
+        c = t ++ map (Sro.z_sro_invert z 0) t
+    in set_decode (fromIntegral (Z.z_modulus z)) (minimum (map set_encode c))
diff --git a/Music/Theory/Z/SRO.hs b/Music/Theory/Z/SRO.hs
deleted file mode 100644
--- a/Music/Theory/Z/SRO.hs
+++ /dev/null
@@ -1,189 +0,0 @@
--- | Serial (ordered) pitch-class operations on 'Z'.
-module Music.Theory.Z.SRO where
-
-import Data.List {- base -}
-import qualified Text.ParserCombinators.Parsec as P {- parsec -}
-
-import qualified Music.Theory.List as T
-import qualified Music.Theory.Parse as T
-
-import Music.Theory.Z
-
--- | Serial operator,of the form rRTMI.
-data SRO t = SRO {sro_r :: Int
-                 ,sro_R :: Bool
-                 ,sro_T :: t
-                 ,sro_M :: Bool
-                 ,sro_I :: Bool}
-             deriving (Eq,Show)
-
--- | Printer in 'rnRTnMI' form.
-sro_pp :: Show t => SRO t -> String
-sro_pp (SRO rN r tN m i) =
-    concat [if rN /= 0 then 'r' : show rN else ""
-           ,if r then "R" else ""
-           ,'T' : show tN
-           ,if m then "M" else ""
-           ,if i then "I" else ""]
-
-p_sro :: Integral t => P.GenParser Char () (SRO t)
-p_sro = do
-  let rot = P.option 0 (P.char 'r' >> T.parse_int)
-  r <- rot
-  r' <- T.is_char 'R'
-  _ <- P.char 'T'
-  t <- T.parse_int
-  m <- T.is_char 'M'
-  i <- T.is_char 'I'
-  P.eof
-  return (SRO r r' t m i)
-
--- | Parse a Morris format serial operator descriptor.
---
--- > sro_parse "r2RT3MI" == SRO 2 True 3 True True
-sro_parse :: Integral i => String -> SRO i
-sro_parse =
-    either (\e -> error ("sro_parse failed\n" ++ show e)) id .
-    P.parse p_sro ""
-
--- | The total set of serial operations.
---
--- > let u = z_sro_univ 3 mod12
--- > zip (map sro_pp u) (map (\o -> z_sro_apply 5 mod12 o [0,1,3]) u)
-z_sro_univ :: Integral i => Int -> Z i -> [SRO i]
-z_sro_univ n_rot z =
-    [SRO r r' t m i |
-     r <- [0 .. n_rot - 1],
-     r' <- [False,True],
-     t <- z_univ z,
-     m <- [False,True],
-     i <- [False,True]]
-
--- | The set of transposition 'SRO's.
-z_sro_Tn :: Integral i => Z i -> [SRO i]
-z_sro_Tn z = [SRO 0 False n False False | n <- z_univ z]
-
--- | The set of transposition and inversion 'SRO's.
-z_sro_TnI :: Integral i => Z i -> [SRO i]
-z_sro_TnI z =
-    [SRO 0 False n False i |
-     n <- z_univ z,
-     i <- [False,True]]
-
--- | The set of retrograde and transposition and inversion 'SRO's.
-z_sro_RTnI :: Integral i => Z i -> [SRO i]
-z_sro_RTnI z =
-    [SRO 0 r n False i |
-     r <- [True,False],
-     n <- z_univ z,
-     i <- [False,True]]
-
--- | The set of transposition, @M5@ and inversion 'SRO's.
-z_sro_TnMI :: Integral i => Z i -> [SRO i]
-z_sro_TnMI z =
-    [SRO 0 False n m i |
-     n <- z_univ z,
-     m <- [True,False],
-     i <- [True,False]]
-
--- | The set of retrograde,transposition,@M5@ and inversion 'SRO's.
-z_sro_RTnMI :: Integral i => Z i -> [SRO i]
-z_sro_RTnMI z =
-    [SRO 0 r n m i |
-     r <- [True,False],
-     n <- z_univ z,
-     m <- [True,False],
-     i <- [True,False]]
-
--- * Serial operations
-
--- | Apply SRO.  M is ordinarily 5, but can be specified here.
---
--- > z_sro_apply 5 mod12 (SRO 1 True 1 True False) [0,1,2,3] == [11,6,1,4]
--- > z_sro_apply 5 mod12 (SRO 1 False 4 True True) [0,1,2,3] == [11,6,1,4]
-z_sro_apply :: Integral i => i -> Z i -> SRO i -> [i] -> [i]
-z_sro_apply mn z (SRO r r' t m i) x =
-    let x1 = if i then z_sro_invert z 0 x else x
-        x2 = if m then z_sro_mn z mn x1 else x1
-        x3 = z_sro_tn z t x2
-        x4 = if r' then reverse x3 else x3
-    in T.rotate_left r x4
-
--- | Transpose /p/ by /n/.
---
--- > z_sro_tn mod5 4 [0,1,4] == [4,0,3]
--- > z_sro_tn mod12 4 [1,5,6] == [5,9,10]
-z_sro_tn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-z_sro_tn z n = fmap (z_add z n)
-
--- | Invert /p/ about /n/.
---
--- > z_sro_invert mod5 0 [0,1,4] == [0,4,1]
--- > z_sro_invert mod12 6 [4,5,6] == [8,7,6]
--- > z_sro_invert mod12 0 [0,1,3] == [0,11,9]
---
--- > import Data.Word {- base -}
--- > z_sro_invert mod12 (0::Word8) [1,4,8]
-z_sro_invert :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-z_sro_invert z n = fmap (\p -> z_sub z n (z_sub z p  n))
-
--- | Composition of 'invert' about @0@ and 'tn'.
---
--- > z_sro_tni mod5 1 [0,1,3] == [1,0,3]
--- > z_sro_tni mod12 4 [1,5,6] == [3,11,10]
--- > (z_sro_invert mod12 0 . z_sro_tn mod12 4) [1,5,6] == [7,3,2]
-z_sro_tni :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-z_sro_tni z n = z_sro_tn z n . z_sro_invert z 0
-
--- | Modulo multiplication.
---
--- > z_sro_mn mod12 11 [0,1,4,9] == z_tni mod12 0 [0,1,4,9]
-z_sro_mn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
-z_sro_mn z n = fmap (z_mul z n)
-
--- | T-related sequences of /p/.
---
--- > length (z_sro_t_related mod12 [0,3,6,9]) == 12
--- > z_sro_t_related mod5 [0,2] == [[0,2],[1,3],[2,4],[3,0],[4,1]]
-z_sro_t_related :: (Integral i, Functor f) => Z i -> f i -> [f i]
-z_sro_t_related z p = fmap (\n -> z_sro_tn z n p) (z_univ z)
-
--- | T\/I-related sequences of /p/.
---
--- > length (z_sro_ti_related mod12 [0,1,3]) == 24
--- > length (z_sro_ti_related mod12 [0,3,6,9]) == 24
--- > z_sro_ti_related mod12 [0] == map return [0..11]
-z_sro_ti_related :: (Eq (f i), Integral i, Functor f) => Z i -> f i -> [f i]
-z_sro_ti_related z p = nub (z_sro_t_related z p ++ z_sro_t_related z (z_sro_invert z 0 p))
-
--- | R\/T\/I-related sequences of /p/.
---
--- > length (z_sro_rti_related mod12 [0,1,3]) == 48
--- > length (z_sro_rti_related mod12 [0,3,6,9]) == 24
-z_sro_rti_related :: Integral i => Z i -> [i] -> [[i]]
-z_sro_rti_related z p = let q = z_sro_ti_related z p in nub (q ++ map reverse q)
-
--- * Sequence operations
-
--- | Variant of 'tn', transpose /p/ so first element is /n/.
---
--- > z_sro_tn_to mod12 5 [0,1,3] == [5,6,8]
--- > map (z_sro_tn_to mod12 0) [[0,1,3],[1,3,0],[3,0,1]]
-z_sro_tn_to :: Integral i => Z i -> i -> [i] -> [i]
-z_sro_tn_to z n p =
-    case p of
-      [] -> []
-      x:xs -> n : z_sro_tn z (z_sub z n x) xs
-
--- | Variant of 'invert', inverse about /n/th element.
---
--- > map (z_sro_invert_ix mod12 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
--- > map (z_sro_invert_ix mod12 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
-z_sro_invert_ix :: Integral i => Z i -> Int -> [i] -> [i]
-z_sro_invert_ix z n p = z_sro_invert z (p !! n) p
-
--- | The standard t-matrix of /p/.
---
--- > z_tmatrix mod12 [0,1,3] == [[0,1,3],[11,0,2],[9,10,0]]
-z_tmatrix :: Integral i => Z i -> [i] -> [[i]]
-z_tmatrix z p = map (\n -> z_sro_tn z n p) (z_sro_tn_to z 0 (z_sro_invert_ix z 0 p))
diff --git a/Music/Theory/Z/Sro.hs b/Music/Theory/Z/Sro.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Sro.hs
@@ -0,0 +1,219 @@
+-- | Serial (ordered) pitch-class operations on 'Z'.
+module Music.Theory.Z.Sro where
+
+import Data.List {- base -}
+
+import qualified Text.Parsec as P {- parsec -}
+
+import qualified Music.Theory.List as List {- hmt -}
+import qualified Music.Theory.Parse as Parse {- hmt -}
+
+import Music.Theory.Z
+
+-- | Serial operator,of the form rRTMI.
+data Sro t = Sro {sro_r :: Int
+                 ,sro_R :: Bool
+                 ,sro_T :: t
+                 ,sro_M :: t -- 1 5
+                 ,sro_I :: Bool}
+             deriving (Eq,Show)
+
+-- | Printer in 'rnRTnMI' form.
+sro_pp :: (Show t,Eq t,Num t) => Sro t -> String
+sro_pp (Sro rN r tN m i) =
+    concat [if rN /= 0 then 'r' : show rN else ""
+           ,if r then "R" else ""
+           ,'T' : show tN
+           ,if m == 5 then "M" else if m == 1 then "" else error "sro_pp: M?"
+           ,if i then "I" else ""]
+
+-- | Parser for Sro.
+p_sro :: Integral t => t -> Parse.P (Sro t)
+p_sro m_mul = do
+  let rot = P.option 0 (P.char 'r' >> Parse.parse_int)
+  r <- rot
+  r' <- Parse.is_char 'R'
+  _ <- P.char 'T'
+  t <- Parse.parse_int
+  m <- Parse.is_char 'M'
+  i <- Parse.is_char 'I'
+  P.eof
+  return (Sro r r' t (if m then m_mul else 1) i)
+
+-- | Parse a Morris format serial operator descriptor.
+--
+-- > sro_parse 5 "r2RT3MI" == Sro 2 True 3 5 True
+sro_parse :: Integral i => i -> String -> Sro i
+sro_parse m =
+    either (\e -> error ("sro_parse failed\n" ++ show e)) id .
+    P.parse (p_sro m) ""
+
+-- * Z
+
+-- | The total set of serial operations.
+--
+-- > let u = z_sro_univ 3 5 z12
+-- > zip (map sro_pp u) (map (\o -> z_sro_apply z12 o [0,1,3]) u)
+z_sro_univ :: Integral i => Int -> i -> Z i -> [Sro i]
+z_sro_univ n_rot m_mul z =
+    [Sro r r' t m i |
+     r <- [0 .. n_rot - 1],
+     r' <- [False,True],
+     t <- z_univ z,
+     m <- [1,m_mul],
+     i <- [False,True]]
+
+-- | The set of transposition 'Sro's.
+z_sro_Tn :: Integral i => Z i -> [Sro i]
+z_sro_Tn z = [Sro 0 False n 1 False | n <- z_univ z]
+
+-- | The set of transposition and inversion 'Sro's.
+z_sro_TnI :: Integral i => Z i -> [Sro i]
+z_sro_TnI z =
+    [Sro 0 False n 1 i |
+     n <- z_univ z,
+     i <- [False,True]]
+
+-- | The set of retrograde and transposition and inversion 'Sro's.
+z_sro_RTnI :: Integral i => Z i -> [Sro i]
+z_sro_RTnI z =
+    [Sro 0 r n 1 i |
+     r <- [True,False],
+     n <- z_univ z,
+     i <- [False,True]]
+
+-- | The set of transposition, @M@ and inversion 'Sro's.
+z_sro_TnMI :: Integral i => i -> Z i -> [Sro i]
+z_sro_TnMI m_mul z =
+    [Sro 0 False n m i |
+     n <- z_univ z,
+     m <- [1,m_mul],
+     i <- [True,False]]
+
+-- | The set of retrograde,transposition,@M5@ and inversion 'Sro's.
+z_sro_RTnMI :: Integral i => i -> Z i -> [Sro i]
+z_sro_RTnMI m_mul z =
+    [Sro 0 r n m i |
+     r <- [True,False],
+     n <- z_univ z,
+     m <- [1,m_mul],
+     i <- [True,False]]
+
+-- * Serial operations
+
+-- | Apply Sro.
+--
+-- > z_sro_apply z12 (Sro 1 True 1 5 False) [0,1,2,3] == [11,6,1,4]
+-- > z_sro_apply z12 (Sro 1 False 4 5 True) [0,1,2,3] == [11,6,1,4]
+z_sro_apply :: Integral i => Z i -> Sro i -> [i] -> [i]
+z_sro_apply z (Sro r r' t m i) x =
+    let x1 = if i then z_sro_invert z 0 x else x
+        x2 = if m == 1 then x1 else z_sro_mn z m x1
+        x3 = z_sro_tn z t x2
+        x4 = if r' then reverse x3 else x3
+    in List.rotate_left r x4
+
+-- | Find 'Sro's that map /x/ to /y/ given /m/ and /z/.
+--
+-- > map sro_pp (z_sro_rel 5 z12 [0,1,2,3] [11,6,1,4]) == ["r1T4MI","r1RT1M"]
+z_sro_rel :: (Ord t,Integral t) => t -> Z t -> [t] -> [t] -> [Sro t]
+z_sro_rel m z x y = filter (\o -> z_sro_apply z o x == y) (z_sro_univ (length x) m z)
+
+-- * Plain
+
+-- | Transpose /p/ by /n/.
+--
+-- > z_sro_tn z5 4 [0,1,4] == [4,0,3]
+-- > z_sro_tn z12 4 [1,5,6] == [5,9,10]
+z_sro_tn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
+z_sro_tn z n = fmap (z_add z n)
+
+-- | Invert /p/ about /n/.
+--
+-- > z_sro_invert z5 0 [0,1,4] == [0,4,1]
+-- > z_sro_invert z12 6 [4,5,6] == [8,7,6]
+-- > map (z_sro_invert z12 0) [[0,1,3],[1,4,8]] == [[0,11,9],[11,8,4]]
+--
+-- > import Data.Word {- base -}
+-- > z_sro_invert z12 (0::Word8) [1,4,8] == [3,0,8]
+z_sro_invert :: (Integral i, Functor f) => Z i -> i -> f i -> f i
+z_sro_invert z n = fmap (\p -> z_sub z n (z_sub z p  n))
+
+-- | Composition of 'invert' about @0@ and 'tn'.
+--
+-- > z_sro_tni z5 1 [0,1,3] == [1,0,3]
+-- > z_sro_tni z12 4 [1,5,6] == [3,11,10]
+-- > (z_sro_invert z12 0 . z_sro_tn z12 4) [1,5,6] == [7,3,2]
+z_sro_tni :: (Integral i, Functor f) => Z i -> i -> f i -> f i
+z_sro_tni z n = z_sro_tn z n . z_sro_invert z 0
+
+-- | Modulo multiplication.
+--
+-- > z_sro_mn z12 11 [0,1,4,9] == z_sro_tni z12 0 [0,1,4,9]
+z_sro_mn :: (Integral i, Functor f) => Z i -> i -> f i -> f i
+z_sro_mn z n = fmap (z_mul z n)
+
+-- | M5, ie. 'mn' @5@.
+--
+-- > z_sro_m5 z12 [0,1,3] == [0,5,3]
+z_sro_m5 :: (Integral i, Functor f) => Z i -> f i -> f i
+z_sro_m5 z = z_sro_mn z 5
+
+-- | T-related sequences of /p/.
+--
+-- > length (z_sro_t_related z12 [0,3,6,9]) == 12
+-- > z_sro_t_related z5 [0,2] == [[0,2],[1,3],[2,4],[3,0],[4,1]]
+z_sro_t_related :: (Integral i, Functor f) => Z i -> f i -> [f i]
+z_sro_t_related z p = fmap (\n -> z_sro_tn z n p) (z_univ z)
+
+-- | T\/I-related sequences of /p/.
+--
+-- > length (z_sro_ti_related z12 [0,1,3]) == 24
+-- > length (z_sro_ti_related z12 [0,3,6,9]) == 24
+-- > z_sro_ti_related z12 [0] == map return [0..11]
+z_sro_ti_related :: (Eq (f i), Integral i, Functor f) => Z i -> f i -> [f i]
+z_sro_ti_related z p = nub (z_sro_t_related z p ++ z_sro_t_related z (z_sro_invert z 0 p))
+
+-- | R\/T\/I-related sequences of /p/.
+--
+-- > length (z_sro_rti_related z12 [0,1,3]) == 48
+-- > length (z_sro_rti_related z12 [0,3,6,9]) == 24
+z_sro_rti_related :: Integral i => Z i -> [i] -> [[i]]
+z_sro_rti_related z p = let q = z_sro_ti_related z p in nub (q ++ map reverse q)
+
+-- | T\/M\/I-related sequences of /p/, duplicates removed.
+z_sro_tmi_related :: Integral i => Z i -> [i] -> [[i]]
+z_sro_tmi_related z p = let q = z_sro_ti_related z p in nub (q ++ map (z_sro_m5 z) q)
+
+-- | R\/T\/M\/I-related sequences of /p/, duplicates removed.
+z_sro_rtmi_related :: Integral i => Z i -> [i] -> [[i]]
+z_sro_rtmi_related z p = let q = z_sro_tmi_related z p in nub (q ++ map reverse q)
+
+-- | r\/R\/T\/M\/I-related sequences of /p/, duplicates removed.
+z_sro_rrtmi_related :: Integral i => Z i -> [i] -> [[i]]
+z_sro_rrtmi_related z p = nub (concatMap (z_sro_rtmi_related z) (List.rotations p))
+
+-- * Sequence operations
+
+-- | Variant of 'tn', transpose /p/ so first element is /n/.
+--
+-- > z_sro_tn_to z12 5 [0,1,3] == [5,6,8]
+-- > map (z_sro_tn_to z12 0) [[0,1,3],[1,3,0],[3,0,1]] == [[0,1,3],[0,2,11],[0,9,10]]
+z_sro_tn_to :: Integral i => Z i -> i -> [i] -> [i]
+z_sro_tn_to z n p =
+    case p of
+      [] -> []
+      x:xs -> n : z_sro_tn z (z_sub z n x) xs
+
+-- | Variant of 'invert', inverse about /n/th element.
+--
+-- > map (z_sro_invert_ix z12 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
+-- > map (z_sro_invert_ix z12 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
+z_sro_invert_ix :: Integral i => Z i -> Int -> [i] -> [i]
+z_sro_invert_ix z n p = z_sro_invert z (p !! n) p
+
+-- | The standard t-matrix of /p/.
+--
+-- > z_tmatrix z12 [0,1,3] == [[0,1,3],[11,0,2],[9,10,0]]
+z_tmatrix :: Integral i => Z i -> [i] -> [[i]]
+z_tmatrix z p = map (\n -> z_sro_tn z n p) (z_sro_tn_to z 0 (z_sro_invert_ix z 0 p))
diff --git a/Music/Theory/Z/TTO.hs b/Music/Theory/Z/TTO.hs
deleted file mode 100644
--- a/Music/Theory/Z/TTO.hs
+++ /dev/null
@@ -1,75 +0,0 @@
-module Music.Theory.Z.TTO where
-
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import qualified Text.ParserCombinators.Parsec as P {- parsec -}
-
-import qualified Music.Theory.Parse as T
-import qualified Music.Theory.Set.List as T
-import Music.Theory.Z
-
--- | Twelve-tone operator, of the form TMI.
-data TTO t = TTO {tto_T :: t,tto_M :: Bool,tto_I :: Bool}
-             deriving (Eq,Show)
-
-tto_identity :: Num t => TTO t
-tto_identity = TTO 0 False False
-
--- | Pretty printer.
-tto_pp :: Show t => TTO t -> String
-tto_pp (TTO t m i) = concat ['T' : show t,if m then "M" else "",if i then "I" else ""]
-
-p_tto :: Integral t => P.GenParser Char () (TTO t)
-p_tto = do
-  _ <- P.char 'T'
-  t <- T.parse_int
-  m <- T.is_char 'M'
-  i <- T.is_char 'I'
-  P.eof
-  return (TTO t m i)
-
--- | Parser, transposition must be decimal.
---
--- > map (tto_pp . tto_parse) (words "T5 T3I T11M T9MI")
-tto_parse :: Integral i => String -> TTO i
-tto_parse = either (\e -> error ("tto_parse failed\n" ++ show e)) id . P.parse p_tto ""
-
--- | The set of all 'TTO', given 'Z' function.
---
--- > length (z_tto_univ mod12) == 48
--- > map tto_pp (z_tto_univ mod12)
-z_tto_univ :: Integral t => Z t -> [TTO t]
-z_tto_univ z = [TTO t m i | m <- [False,True], i <- [False,True], t <- z_univ z]
-
--- | M is ordinarily 5, but can be specified here.
---
--- > map (z_tto_f 5 mod12 (tto_parse "T1M")) [0,1,2,3] == [1,6,11,4]
-z_tto_f :: Integral t => t -> Z t -> TTO t -> (t -> t)
-z_tto_f mn z (TTO t m i) =
-    let i_f = if i then z_negate z else id
-        m_f = if m then z_mul z mn else id
-        t_f = if t > 0 then z_add z t else id
-    in t_f . m_f . i_f
-
--- | 'sort' of 'map' 'z_tto_f'.
---
--- > z_tto_apply 5 mod12 (tto_parse "T1M") [0,1,2,3] == [1,4,6,11]
-z_tto_apply :: Integral t => t -> Z t -> TTO t -> [t] -> [t]
-z_tto_apply mn z o = sort . map (z_tto_f mn z o)
-
-tto_apply :: Integral t => t -> TTO t -> [t] -> [t]
-tto_apply mn = z_tto_apply mn id
-
--- | Find 'TTO' that that map /x/ to /y/ given /m/ and /z/.
---
--- > map tto_pp (z_tto_rel 5 mod12 [0,1,2,3] [6,4,1,11]) == ["T1M","T4MI"]
-z_tto_rel :: (Ord t,Integral t) => t -> Z t -> [t] -> [t] -> [TTO t]
-z_tto_rel m z x y =
-    let q = T.set y
-    in mapMaybe (\o -> if z_tto_apply m z o x == q then Just o else Nothing) (z_tto_univ z)
-
--- | 'nub' of 'sort' of 'map' /z/.
---
--- > map (z_pcset mod12) [[0,6],[6,12],[12,18]] == replicate 3 [0,6]
-z_pcset :: Ord t => Z t -> [t] -> [t]
-z_pcset z = nub . sort . map z
diff --git a/Music/Theory/Z/Tto.hs b/Music/Theory/Z/Tto.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Z/Tto.hs
@@ -0,0 +1,147 @@
+-- | Generalised twelve-tone operations on un-ordered pitch-class sets with arbitrary Z.
+module Music.Theory.Z.Tto where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Text.Parsec as P {- parsec -}
+
+import qualified Music.Theory.Parse as Parse {- hmt -}
+
+import Music.Theory.Z {- hmt -}
+
+-- * Tto
+
+-- | Twelve-tone operator, of the form TMI.
+data Tto t = Tto {tto_T :: t,tto_M :: t,tto_I :: Bool}
+             deriving (Eq,Show)
+
+-- | T0
+tto_identity :: Num t => Tto t
+tto_identity = Tto 0 1 False
+
+-- | Pretty printer.  It is an error here is M is not 1 or 5.
+tto_pp :: (Show t,Num t,Eq t) => Tto t -> String
+tto_pp (Tto t m i) =
+  concat ['T' : show t
+         ,if m == 1 then "" else if m == 5 then "M" else error "tto_pp: M?"
+         ,if i then "I" else ""]
+
+-- | Parser for Tto, requires value for M (ordinarily 5 for 12-tone Tto).
+p_tto :: Integral t => t -> Parse.P (Tto t)
+p_tto m_mul = do
+  _ <- P.char 'T'
+  t <- Parse.parse_int
+  m <- Parse.is_char 'M'
+  i <- Parse.is_char 'I'
+  P.eof
+  return (Tto t (if m then m_mul else 1) i)
+
+-- | Parser, transposition must be decimal.
+--
+-- > map (tto_pp . tto_parse 5) (words "T5 T3I T11M T9MI") == ["T5","T3I","T11M","T9MI"]
+tto_parse :: Integral i => i -> String -> Tto i
+tto_parse m = either (\e -> error ("tto_parse failed\n" ++ show e)) id . P.parse (p_tto m) ""
+
+-- | Set M at Tto.
+tto_M_set :: Integral t => t -> Tto t -> Tto t
+tto_M_set m (Tto t _ i) = Tto t m i
+
+-- * Z
+
+-- | The set of all 'Tto', given 'Z'.
+--
+-- > length (z_tto_univ 5 z12) == 48
+-- > map tto_pp (z_tto_univ 5 z12)
+z_tto_univ :: Integral t => t -> Z t -> [Tto t]
+z_tto_univ m_mul z = [Tto t m i | m <- [1,m_mul], i <- [False,True], t <- z_univ z]
+
+-- | Apply Tto to pitch-class.
+--
+-- > map (z_tto_f z12 (tto_parse 5 "T1M")) [0,1,2,3] == [1,6,11,4]
+z_tto_f :: Integral t => Z t -> Tto t -> (t -> t)
+z_tto_f z (Tto t m i) =
+    let i_f = if i then z_negate z else id
+        m_f = if m == 1 then id else z_mul z m
+        t_f = if t > 0 then z_add z t else id
+    in t_f . m_f . i_f
+
+-- | 'nub' of 'sort' of 'z_tto_f'.  (nub because M may be 0).
+--
+-- > z_tto_apply z12 (tto_parse 5 "T1M") [0,1,2,3] == [1,4,6,11]
+z_tto_apply :: Integral t => Z t -> Tto t -> [t] -> [t]
+z_tto_apply z o = nub . sort . map (z_tto_f z o)
+
+-- | Find 'Tto's that map pc-set /x/ to pc-set /y/ given /m/ and /z/.
+--
+-- > map tto_pp (z_tto_rel 5 z12 [0,1,2,3] [1,4,6,11]) == ["T1M","T4MI"]
+z_tto_rel :: (Ord t,Integral t) => t -> Z t -> [t] -> [t] -> [Tto t]
+z_tto_rel m z x y =
+  let f o = if z_tto_apply z o x == y then Just o else Nothing
+  in mapMaybe f (z_tto_univ m z)
+
+-- * Plain
+
+-- | 'nub' of 'sort' of 'z_mod' of /z/.
+--
+-- > z_pcset z12 [1,13] == [1]
+-- > map (z_pcset z12) [[0,6],[6,12],[12,18]] == replicate 3 [0,6]
+z_pcset :: (Integral t,Ord t) => Z t -> [t] -> [t]
+z_pcset z = nub . sort . map (z_mod z)
+
+-- | Transpose by n.
+--
+-- > z_tto_tn z12 4 [1,5,6] == [5,9,10]
+-- > z_tto_tn z12 4 [0,4,8] == [0,4,8]
+z_tto_tn :: Integral i => Z i -> i -> [i] -> [i]
+z_tto_tn z n = sort . map (z_add z n)
+
+-- | Invert about n.
+--
+-- > z_tto_invert z12 6 [4,5,6] == [6,7,8]
+-- > z_tto_invert z12 0 [0,1,3] == [0,9,11]
+z_tto_invert :: Integral i => Z i -> i -> [i] -> [i]
+z_tto_invert z n = sort . map (\p -> z_sub z n (z_sub z p n))
+
+-- | Composition of 'z_tto_invert' about @0@ and 'z_tto_tn'.
+--
+-- > z_tto_tni z12 4 [1,5,6] == [3,10,11]
+-- > (z_tto_invert z12 0 . z_tto_tn z12 4) [1,5,6] == [2,3,7]
+z_tto_tni :: Integral i => Z i -> i -> [i] -> [i]
+z_tto_tni z n = z_tto_tn z n . z_tto_invert z 0
+
+-- | Modulo-z multiplication
+--
+-- > z_tto_mn z12 11 [0,1,4,9] == z_tto_invert z12 0 [0,1,4,9]
+z_tto_mn :: Integral i => Z i -> i -> [i] -> [i]
+z_tto_mn z n = sort . map (z_mul z n)
+
+-- | M5, ie. 'mn' @5@.
+--
+-- > z_tto_m5 z12 [0,1,3] == [0,3,5]
+z_tto_m5 :: Integral i => Z i -> [i] -> [i]
+z_tto_m5 z = z_tto_mn z 5
+
+-- * Sequence
+
+-- | T-related sets of /p/.
+z_tto_t_related_seq :: Integral i => Z i -> [i] -> [[i]]
+z_tto_t_related_seq z p = map (\q -> z_tto_tn z q p) [0..11]
+
+-- | Unique elements of 'z_tto_t_related_seq'.
+--
+-- > length (z_tto_t_related z12 [0,1,3]) == 12
+-- > z_tto_t_related z12 [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
+z_tto_t_related :: Integral i => Z i -> [i] -> [[i]]
+z_tto_t_related z = nub . z_tto_t_related_seq z
+
+-- | T\/I-related set of /p/.
+z_tto_ti_related_seq :: Integral i => Z i -> [i] -> [[i]]
+z_tto_ti_related_seq z p = z_tto_t_related z p ++ z_tto_t_related z (z_tto_invert z 0 p)
+
+-- | Unique elements of 'z_tto_ti_related_seq'.
+--
+-- > length (z_tto_ti_related z12 [0,1,3]) == 24
+-- > z_tto_ti_related z12 [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
+z_tto_ti_related :: Integral i => Z i -> [i] -> [[i]]
+z_tto_ti_related z = nub . z_tto_ti_related_seq z
diff --git a/Music/Theory/Z12.hs b/Music/Theory/Z12.hs
deleted file mode 100644
--- a/Music/Theory/Z12.hs
+++ /dev/null
@@ -1,111 +0,0 @@
-{-# Language DataKinds #-}
-{- | Z12
-
-Z12 are modulo 12 integers.
-
-> map signum [-1,0::Z12,1] == [1,0,1]
-> map abs [-1,0::Z12,1] == [11,0,1]
-
-Aspects of the 'Enum' instance are cyclic.
-
-> pred (0::Z12) == 11
-> succ (11::Z12) == 0
-
-'Bounded' works
-
-> [minBound::Z12 .. maxBound] == [0::Z12 .. 11]
-
--}
-module Music.Theory.Z12 where
-
-import Data.Char {- base -}
-import Data.List {- base -}
-import qualified Data.Modular as M {- modular-arithmetic -}
-import qualified GHC.TypeLits as L {- base -}
-
-import qualified Music.Theory.List as T {- hmt -}
-
--- | 'Mod' 'Int'.
-type Z n = M.Mod Int n
-
--- | 'Z' 12.
---
--- > map negate [0::Z12 .. 0xB] == [0,0xB,0xA,9,8,7,6,5,4,3,2,1]
--- > map (+ 5) [0::Z12 .. 11] == [5,6,7,8,9,0xA,0xB,0,1,2,3,4]
-type Z12 = M.Mod Int 12
-
--- | Cyclic form of 'enumFromThenTo'.
---
--- > [9::Z12,11 .. 3] == []
--- > enumFromThenTo_cyc (9::Z12) 11 3 == [9,11,1,3]
-enumFromThenTo_cyc :: L.KnownNat n => Z n -> Z n -> Z n -> [Z n]
-enumFromThenTo_cyc n m o =
-    let m' = m + (m - n)
-    in case compare m' o of
-         LT -> n : enumFromThenTo_cyc m m' o
-         EQ -> [n,m,o]
-         GT -> [n,m]
-
--- | Cyclic form of 'enumFromTo'.
---
--- > [9::Z12 .. 3] == []
--- > enumFromTo_cyc (9::Z12) 3 == [9,10,11,0,1,2,3]
-enumFromTo_cyc :: L.KnownNat n => Z n -> Z n -> [Z n]
-enumFromTo_cyc n m =
-    let n' = succ n
-    in if n' == m then [n,m] else n : enumFromTo_cyc n' m
-
-{-
--}
-
--- | Convert integral to 'Z12'.
---
--- > map to_Z12 [-9,-3,0,13] == [3,9,0,1]
-to_Z12 :: Integral i => i -> Z12
-to_Z12 = M.toMod . fromIntegral
-
-int_to_Z12 :: Int -> Z12
-int_to_Z12 = to_Z12
-
--- | Convert 'Z12' to integral.
-from_Z12 :: Integral i => Z12 -> i
-from_Z12 = fromIntegral . M.unMod
-
-int_from_Z12 :: Z12 -> Int
-int_from_Z12 = from_Z12
-
--- | Z12 not in set.
---
--- > complement [0,2,4,5,7,9,11] == [1,3,6,8,10]
-complement :: [Z12] -> [Z12]
-complement = (\\) [0 .. 11]
-
--- | Z12 to character (10 -> A, 11 -> B).
---
--- > map z12_to_char [0 .. 11] == "0123456789AB"
-z12_to_char :: Z12 -> Char
-z12_to_char = toUpper . intToDigit . M.unMod
-
--- | Z12 to character (10 -> A, 11 -> B).
---
--- > map char_to_z12 "0123456789AB" == [0..11]
-char_to_z12 :: Char -> Z12
-char_to_z12 = to_Z12 . digitToInt
-
--- | Unordered set notation (braces).
---
--- > z12_set_pp [0,1,3] == "{013}"
-z12_set_pp :: [Z12] -> String
-z12_set_pp = T.bracket ('{','}') . map z12_to_char
-
--- | Ordered sequence notation (angle brackets).
---
--- > z12_seq_pp [0,1,3] == "<013>"
-z12_seq_pp :: [Z12] -> String
-z12_seq_pp = T.bracket ('<','>') . map z12_to_char
-
--- | Ordered vector notation (square brackets).
---
--- > z12_vec_pp [0,1,3] == "[013]"
-z12_vec_pp :: [Z12] -> String
-z12_vec_pp = T.bracket ('[',']') . map z12_to_char
diff --git a/Music/Theory/Z12/Castren_1994.hs b/Music/Theory/Z12/Castren_1994.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Castren_1994.hs
+++ /dev/null
@@ -1,151 +0,0 @@
--- | Marcus Castrén. /RECREL: A Similarity Measure for Set-Classes/. PhD
--- thesis, Sibelius Academy, Helsinki, 1994.
-module Music.Theory.Z12.Castren_1994 where
-
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Data.Ratio {- base -}
-
-import qualified Music.Theory.List as T
-import Music.Theory.Z (mod12)
-import qualified Music.Theory.Z.SRO as T
-import qualified Music.Theory.Z.Forte_1973 as T
-
-type Z12 = Int
-
--- | Is /p/ symmetrical under inversion.
---
--- > map inv_sym (T.scs_n 2) == [True,True,True,True,True,True]
--- > map (fromEnum.inv_sym) (T.scs_n 3) == [1,0,0,0,0,1,0,0,1,1,0,1]
-inv_sym :: [Z12] -> Bool
-inv_sym x = x `elem` map (\i -> sort (T.z_sro_tn mod12 i (T.z_sro_invert mod12 0 x))) [0..11]
-
--- | If /p/ is not 'inv_sym' then @(p,invert 0 p)@ else 'Nothing'.
---
--- > sc_t_ti [0,2,4] == Nothing
--- > sc_t_ti [0,1,3] == Just ([0,1,3],[0,2,3])
-sc_t_ti :: [Z12] -> Maybe ([Z12], [Z12])
-sc_t_ti p =
-    if inv_sym p
-    then Nothing
-    else Just (p,T.t_prime mod12 (T.z_sro_invert mod12 0 p))
-
--- | Transpositional equivalence variant of Forte's 'sc_table'.  The
--- inversionally related classes are distinguished by labels @A@ and
--- @B@; the class providing the /best normal order/ (Forte 1973) is
--- always the @A@ class. If neither @A@ nor @B@ appears in the name of
--- a set-class, it is inversionally symmetrical.
---
--- > (length T.sc_table,length t_sc_table) == (224,352)
--- > lookup "5-Z18B" t_sc_table == Just [0,2,3,6,7]
-t_sc_table :: [(T.SC_Name,[Z12])]
-t_sc_table =
-    let f x = let nm = T.sc_name mod12 x
-              in case sc_t_ti x of
-                   Nothing -> [(nm,x)]
-                   Just (p,q) -> [(nm++"A",p),(nm++"B",q)]
-    in concatMap f T.scs
-
--- | Lookup a set-class name.  The input set is subject to
--- 't_prime' before lookup.
---
--- > t_sc_name [0,2,3,6,7] == "5-Z18B"
--- > t_sc_name [0,1,4,6,7,8] == "6-Z17B"
-t_sc_name :: [Z12] -> T.SC_Name
-t_sc_name p =
-    let n = find (\(_,q) -> T.t_prime mod12 p == q) t_sc_table
-    in fst (fromJust n)
-
--- | Lookup a set-class given a set-class name.
---
--- > t_sc "6-Z17A" == [0,1,2,4,7,8]
-t_sc :: T.SC_Name -> [Z12]
-t_sc n = snd (fromJust (find (\(m,_) -> n == m) t_sc_table))
-
--- | List of set classes.
-t_scs :: [[Z12]]
-t_scs = map snd t_sc_table
-
--- | Cardinality /n/ subset of 't_scs'.
---
--- > map (length . t_scs_n) [2..10] == [6,19,43,66,80,66,43,19,6]
-t_scs_n :: Integral i => i -> [[Z12]]
-t_scs_n n = filter ((== n) . genericLength) t_scs
-
--- | T-related /q/ that are subsets of /p/.
---
--- > t_subsets [0,1,2,3,4] [0,1]  == [[0,1],[1,2],[2,3],[3,4]]
--- > t_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4]]
--- > t_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6]]
-t_subsets :: [Z12] -> [Z12] -> [[Z12]]
-t_subsets x a = filter (`T.is_subset` x) (map sort (T.z_sro_t_related mod12 a))
-
--- | T\/I-related /q/ that are subsets of /p/.
---
--- > ti_subsets [0,1,2,3,4] [0,1]  == [[0,1],[1,2],[2,3],[3,4]]
--- > ti_subsets [0,1,2,3,4] [0,1,4] == [[0,1,4],[0,3,4]]
--- > ti_subsets [0,2,3,6,7] [0,1,4] == [[2,3,6],[3,6,7]]
-ti_subsets :: [Z12] -> [Z12] -> [[Z12]]
-ti_subsets x a = filter (`T.is_subset` x) (nub (map sort (T.z_sro_ti_related mod12 a)))
-
--- | Trivial run length encoder.
---
--- > rle "abbcccdde" == [(1,'a'),(2,'b'),(3,'c'),(2,'d'),(1,'e')]
-rle :: (Eq a,Integral i) => [a] -> [(i,a)]
-rle =
-    let f x = (genericLength x,head x)
-    in map f . group
-
--- | Inverse of 'rle'.
---
--- > rle_decode [(5,'a'),(4,'b')] == "aaaaabbbb"
-rle_decode :: (Integral i) => [(i,a)] -> [a]
-rle_decode =
-    let f (i,j) = genericReplicate i j
-    in concatMap f
-
--- | Length of /rle/ encoded sequence.
---
--- > rle_length [(5,'a'),(4,'b')] == 9
-rle_length :: (Integral i) => [(i,a)] -> i
-rle_length = sum . map fst
-
--- | T-equivalence /n/-class vector (subset-class vector, nCV).
---
--- > t_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
--- > rle (t_n_class_vector 3 [0..4]) == [(1,3),(2,2),(2,1),(4,0),(1,1),(9,0)]
--- > rle (t_n_class_vector 4 [0..4]) == [(1,2),(3,1),(39,0)]
-t_n_class_vector :: (Num a, Integral i) => i -> [Z12] -> [a]
-t_n_class_vector n x =
-    let a = t_scs_n n
-    in map (genericLength . t_subsets x) a
-
--- | T\/I-equivalence /n/-class vector (subset-class vector, nCV).
---
--- > ti_n_class_vector 2 [0..4] == [4,3,2,1,0,0]
--- > ti_n_class_vector 3 [0,1,2,3,4] == [3,4,2,0,0,1,0,0,0,0,0,0]
--- > rle (ti_n_class_vector 4 [0,1,2,3,4]) == [(2,2),(1,1),(26,0)]
-ti_n_class_vector :: (Num b, Integral i) => i -> [Z12] -> [b]
-ti_n_class_vector n x =
-    let a = T.scs_n n
-    in map (genericLength . ti_subsets x) a
-
--- | 'icv' scaled by sum of /icv/.
---
--- > dyad_class_percentage_vector [0,1,2,3,4] == [40,30,20,10,0,0]
--- > dyad_class_percentage_vector [0,1,4,5,7] == [20,10,20,20,20,10]
-dyad_class_percentage_vector :: Integral i => [Z12] -> [i]
-dyad_class_percentage_vector p =
-    let p' = T.icv 12 p
-    in map (sum p' *) p'
-
--- | /rel/ metric.
---
--- > rel [0,1,2,3,4] [0,1,4,5,7] == 40
--- > rel [0,1,2,3,4] [0,2,4,6,8] == 60
--- > rel [0,1,4,5,7] [0,2,4,6,8] == 60
-rel :: Integral i => [Z12] -> [Z12] -> Ratio i
-rel x y =
-    let x' = dyad_class_percentage_vector x
-        y' = dyad_class_percentage_vector y
-    in sum (map abs (zipWith (-) x' y')) % 2
diff --git a/Music/Theory/Z12/Drape_1999.hs b/Music/Theory/Z12/Drape_1999.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Drape_1999.hs
+++ /dev/null
@@ -1,588 +0,0 @@
--- | Haskell implementations of @pct@ operations.
--- See <http://slavepianos.org/rd/t/pct>.
-module Music.Theory.Z12.Drape_1999 where
-
-import Data.Function {- base -}
-import Data.List {- base -}
-import Data.Maybe {- base -}
-import Safe {- safe -}
-
-import qualified Music.Theory.List as T
-import qualified Music.Theory.Set.List as T
-import qualified Music.Theory.Tuple as T
-
-import qualified Music.Theory.Z as Z
-import qualified Music.Theory.Z.SRO as Z
-import qualified Music.Theory.Z.TTO as Z
-
-import Music.Theory.Z12 (Z12)
-import qualified Music.Theory.Z12 as Z12
-import qualified Music.Theory.Z12.Forte_1973 as Z12
-import qualified Music.Theory.Z12.TTO as Z12
-import qualified Music.Theory.Z12.SRO as Z12
-
--- | Cardinality filter
---
--- > cf [0,3] (cg [1..4]) == [[1,2,3],[1,2,4],[1,3,4],[2,3,4],[]]
-cf :: (Integral n) => [n] -> [[a]] -> [[a]]
-cf ns = filter (\p -> genericLength p `elem` ns)
-
--- | Combinatorial sets formed by considering each set as possible
--- values for slot.
---
--- > cgg [[0,1],[5,7],[3]] == [[0,5,3],[0,7,3],[1,5,3],[1,7,3]]
--- > let n = "01" in cgg [n,n,n] == ["000","001","010","011","100","101","110","111"]
-cgg :: [[a]] -> [[a]]
-cgg l =
-    case l of
-      x:xs -> [ y:z | y <- x, z <- cgg xs ]
-      _ -> [[]]
-
--- | Combinations generator, ie. synonym for 'T.powerset'.
---
--- > sort (cg [0,1,3]) == [[],[0],[0,1],[0,1,3],[0,3],[1],[1,3],[3]]
-cg :: [a] -> [[a]]
-cg = T.powerset
-
--- | Powerset filtered by cardinality.
---
--- >>> pct cg -r3 0159
--- 015
--- 019
--- 059
--- 159
---
--- > cg_r 3 [0,1,5,9] == [[0,1,5],[0,1,9],[0,5,9],[1,5,9]]
-cg_r :: (Integral n) => n -> [a] -> [[a]]
-cg_r n = cf [n] . cg
-
-{- | Chain pcsegs.
-
->>> echo 024579 | pct chn T0 3 | sort -u
-579468 (RT8M)
-579A02 (T5)
-
-> chn_t0 3 [0,2,4,5,7,9] == [[5,7,9,10,0,2],[5,7,9,4,6,8]]
-
->>> echo 02457t | pct chn T0 2
-7A0135 (RT5I)
-7A81B9 (RT9MI)
-
-> chn_t0 2 [0,2,4,5,7,10] == [[7,10,0,1,3,5],[7,10,8,1,11,9]]
-
--}
-chn_t0 :: Int -> [Z12] -> [[Z12]]
-chn_t0 n p =
-    let f q = T.take_right n p == take n q
-    in filter f (Z12.sro_rtmi_related p)
-
-{- | Cyclic interval segment.
-
->>> echo 014295e38t76 | pct cisg
-13A7864529B6
-
-> ciseg [0,1,4,2,9,5,11,3,8,10,7,6] == [1,3,10,7,8,6,4,5,2,9,11,6]
-
--}
-ciseg :: [Z12] -> [Z12]
-ciseg = T.d_dx . cyc
-
--- | Synonynm for 'complement'.
---
--- >>> pct cmpl 02468t
--- 13579B
---
--- > cmpl [0,2,4,6,8,10] == [1,3,5,7,9,11]
-cmpl :: [Z12] -> [Z12]
-cmpl = Z12.complement
-
--- | Form cycle.
---
--- >>> echo 056 | pct cyc
--- 0560
---
--- > cyc [0,5,6] == [0,5,6,0]
-cyc :: [a] -> [a]
-cyc l =
-    case l of
-      [] -> []
-      x:xs -> (x:xs) ++ [x]
-
--- | Diatonic set name. 'd' for diatonic set, 'm' for melodic minor
--- set, 'o' for octotonic set.
-d_nm :: (Integral a) => [a] -> Maybe Char
-d_nm x =
-    case x of
-      [0,2,4,5,7,9,11] -> Just 'd'
-      [0,2,3,5,7,9,11] -> Just 'm'
-      [0,1,3,4,6,7,9,10] -> Just 'o'
-      _ -> Nothing
-
--- | Diatonic implications.
-dim :: [Z12] -> [(Z12,[Z12])]
-dim p =
-    let g (i,q) = T.is_subset p (Z12.tto_tn i q)
-        f = filter g . zip [0..11] . repeat
-        d = [0,2,4,5,7,9,11]
-        m = [0,2,3,5,7,9,11]
-        o = [0,1,3,4,6,7,9,10]
-    in f d ++ f m ++ f o
-
--- | Variant of 'dim' that is closer to the 'pct' form.
---
--- >>> pct dim 016
--- T1d
--- T1m
--- T0o
---
--- > dim_nm [0,1,6] == [(1,'d'),(1,'m'),(0,'o')]
-dim_nm :: [Z12] -> [(Z12,Char)]
-dim_nm =
-    let pk f (i,j) = (i,f j)
-    in nubBy ((==) `on` snd) .
-       map (pk (fromMaybe (error "dim_mn") . d_nm)) .
-       dim
-
--- | Diatonic interval set to interval set.
---
--- >>> pct dis 24
--- 1256
---
--- > dis [2,4] == [1,2,5,6]
-dis :: (Integral t) => [Int] -> [t]
-dis =
-    let is = [[], [], [1,2], [3,4], [5,6], [6,7], [8,9], [10,11]]
-    in concatMap (\j -> is !! j)
-
--- | Degree of intersection.
---
--- >>> echo 024579e | pct doi 6 | sort -u
--- 024579A
--- 024679B
---
--- > let p = [0,2,4,5,7,9,11]
--- > in doi 6 p p == [[0,2,4,5,7,9,10],[0,2,4,6,7,9,11]]
---
--- >>> echo 01234 | pct doi 2 7-35 | sort -u
--- 13568AB
---
--- > doi 2 (T.sc "7-35") [0,1,2,3,4] == [[1,3,5,6,8,10,11]]
-doi :: Int -> [Z12] -> [Z12] -> [[Z12]]
-doi n p q =
-    let f j = [Z12.tto_tn j p,Z12.tto_tni j p]
-        xs = concatMap f [0..11]
-    in T.set (filter (\x -> length (x `intersect` q) == n) xs)
-
--- | Forte name.
-fn :: [Z12] -> String
-fn = Z12.sc_name
-
--- | Z12 cycles.
-frg_cyc :: T.T6 [[Z12]]
-frg_cyc =
-    let c1 = [[0..11]]
-        c2 = map (\n -> map (+ n) [0,2..10]) [0..1]
-        c3 = map (\n -> map (+ n) [0,3..9]) [0..2]
-        c4 = map (\n -> map (+ n) [0,4..8]) [0..3]
-        c5 = map (map (* 5)) c1
-        c6 = map (\n -> map (+ n) [0,6]) [0..5]
-    in (c1,c2,c3,c4,c5,c6)
-
--- | Fragmentation of cycles.
-frg :: [Z12] -> T.T6 [String]
-frg p =
-    let f = map (\n -> if n `elem` p then Z12.z12_to_char n else '-')
-    in T.t6_map (map f) frg_cyc
-
-ic_cycle_vector :: [Z12] -> T.T6 [Int]
-ic_cycle_vector p =
-    let f str = let str' = if length str > 2 then T.close str else str
-                in length (filter (\(x,y) -> x /= '-' && y /= '-') (T.adj2 1 str'))
-    in T.t6_map (map f) (frg p)
-
--- | Pretty printer for 'ic_cycle_vector'.
---
--- > let r = "IC cycle vector: <1> <22> <111> <1100> <5> <000000>"
--- > in ic_cycle_vector_pp (ic_cycle_vector [0,2,4,5,7,9]) == r
-ic_cycle_vector_pp :: T.T6 [Int] -> String
-ic_cycle_vector_pp = ("IC cycle vector: " ++) . unwords . T.t6_to_list . T.t6_map Z.z16_seq_pp
-
-frg_hdr :: [String]
-frg_hdr = map (\n -> "Fragmentation of " ++ show n ++ "-cycle(s)") [1::Int .. 6]
-
-{-| Fragmentation of cycles.
-
->>> pct frg 024579
-Fragmentation of 1-cycle(s):  [0-2-45-7-9--]
-Fragmentation of 2-cycle(s):  [024---] [--579-]
-Fragmentation of 3-cycle(s):  [0--9] [-47-] [25--]
-Fragmentation of 4-cycle(s):  [04-] [-59] [2--] [-7-]
-Fragmentation of 5-cycle(s):  [05------4927]
-Fragmentation of 6-cycle(s):  [0-] [-7] [2-] [-9] [4-] [5-]
-IC cycle vector: <1> <22> <111> <1100> <5> <000000>
-
-> putStrLn $ frg_pp [0,2,4,5,7,9]
--}
-frg_pp :: [Z12] -> String
-frg_pp =
-    let f = unwords . map (\p -> T.bracket ('[',']') p)
-        g x y = x ++ ": " ++ y
-    in unlines . zipWith g frg_hdr . T.t6_to_list . T.t6_map f . frg
-
--- | Embedded segment search.
---
--- >>> echo 23A | pct ess 0164325
--- 2B013A9
--- 923507A
---
--- > ess [0,1,6,4,3,2,5] [2,3,10] == [[9,2,3,5,0,7,10],[2,11,0,1,3,10,9]]
-ess :: [Z12] -> [Z12] -> [[Z12]]
-ess p q = filter (`T.is_embedding` q) (Z12.sro_rtmi_related p)
-
--- | Can the set-class q (under prime form algorithm pf) be
---   drawn from the pcset p.
-has_sc_pf :: (Integral a) => ([a] -> [a]) -> [a] -> [a] -> Bool
-has_sc_pf pf p q =
-    let n = length q
-    in pf q `elem` map pf (cf [n] (cg p))
-
--- | Can the set-class q be drawn from the pcset p.
---
--- > let d = [0,2,4,5,7,9,11] in has_sc d (complement d) == True
--- > has_sc [] [] == True
-has_sc :: [Z12] -> [Z12] -> Bool
-has_sc = has_sc_pf Z12.forte_prime
-
--- | Interval cycle filter.
---
--- >>> echo 22341 | pct icf
--- 22341
---
--- > icf [[2,2,3,4,1]] == [[2,2,3,4,1]]
-icf :: (Num a,Eq a) => [[a]] -> [[a]]
-icf = filter ((== 12) . sum)
-
--- | Interval class set to interval sets.
---
--- >>> pct ici -c 123
--- 123
--- 129
--- 1A3
--- 1A9
---
--- > ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
-ici :: (Num t) => [Int] -> [[t]]
-ici xs =
-    let is j = [[0], [1,11], [2,10], [3,9], [4,8], [5,7], [6]] !! j
-        ys = map is xs
-    in cgg ys
-
--- | Interval class set to interval sets, concise variant.
---
--- > ici_c [1,2,3] == [[1,2,3],[1,2,9],[1,10,3],[1,10,9]]
-ici_c :: [Int] -> [[Int]]
-ici_c [] = []
-ici_c (x:xs) = map (x:) (ici xs)
-
--- | Interval-class segment.
---
--- >>> pct icseg 013265e497t8
--- 12141655232
---
--- > icseg [0,1,3,2,6,5,11,4,9,7,10,8] == [1,2,1,4,1,6,5,5,2,3,2]
-icseg :: [Z12] -> [Z12]
-icseg = map Z12.ic . iseg
-
--- | Interval segment (INT).
-iseg :: [Z12] -> [Z12]
-iseg = T.d_dx
-
--- | Imbrications.
---
--- > let r = [[[0,2,4],[2,4,5],[4,5,7],[5,7,9]]
--- >         ,[[0,2,4,5],[2,4,5,7],[4,5,7,9]]]
--- > in imb [3,4] [0,2,4,5,7,9] == r
-imb :: (Integral n) => [n] -> [a] -> [[[a]]]
-imb cs p =
-    let g n = (== n) . genericLength
-        f ps n = filter (g n) (map (genericTake n) ps)
-    in map (f (tails p)) cs
-
-{- | 'issb' gives the set-classes that can append to 'p' to give 'q'.
-
->>> pct issb 3-7 6-32
-3-7
-3-2
-3-11
-
-> issb (T.sc "3-7") (T.sc "6-32") == ["3-2","3-7","3-11"]
-
--}
-issb :: [Z12] -> [Z12] -> [String]
-issb p q =
-    let k = length q - length p
-        f = any id . map (\x -> Z12.forte_prime (p ++ x) == q) . Z12.tto_ti_related
-    in map Z12.sc_name (filter f (cf [k] Z12.scs))
-
--- | Matrix search.
---
--- >>> pct mxs 024579 642 | sort -u
--- 6421B9
--- B97642
---
--- > T.set (mxs [0,2,4,5,7,9] [6,4,2]) == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
-mxs :: [Z12] -> [Z12] -> [[Z12]]
-mxs p q = filter (q `isInfixOf`) (Z12.sro_rti_related p)
-
--- | Normalize.
---
--- >>> pct nrm 0123456543210
--- 0123456
---
--- > nrm [0,1,2,3,4,5,6,5,4,3,2,1,0] == [0,1,2,3,4,5,6]
-nrm :: (Ord a) => [a] -> [a]
-nrm = T.set
-
--- | Normalize, retain duplicate elements.
-nrm_r :: (Ord a) => [a] -> [a]
-nrm_r = sort
-
-{- | Pitch-class invariances (called @pi@ at @pct@).
-
->>> pct pi 0236 12
-pcseg 0236
-pcseg 6320
-pcseg 532B
-pcseg B235
-
-> pci [1,2] [0,2,3,6] == [[0,2,3,6],[5,3,2,11],[6,3,2,0],[11,2,3,5]]
-
--}
-pci :: [Int] -> [Z12] -> [[Z12]]
-pci i p =
-    let f q = T.set (map (q !!) i)
-    in filter (\q -> f q == f p) (Z12.sro_rti_related p)
-
--- | Relate sets (TnMI).
---
--- >>> pct rs 0123 641e
--- T1M
---
--- > rs [0,1,2,3] [6,4,1,11] == [(Z.tto_parse "T1M",[1,6,11,4])
--- >                            ,(Z.tto_parse "T4MI",[4,11,6,1])]
-rs :: [Z12] -> [Z12] -> [(Z.TTO Z12, [Z12])]
-rs x y =
-    let xs = map (\o -> (o,Z.z_tto_apply 5 id o x)) (Z.z_tto_univ id)
-        q = T.set y
-    in filter (\(_,p) -> T.set p == q) xs
-
-rs1 :: [Z12] -> [Z12] -> Maybe (Z.TTO Z12)
-rs1 p = fmap fst . headMay . rs p
-
-{- | Relate segments.
-
->>> pct rsg 156 3BA
-T4I
-
-> rsg [1,5,6] [3,11,10] == [Z.sro_parse "T4I",Z.sro_parse "r1RT4MI"]
-
->>> pct rsg 0123 05t3
-T0M
-
-> rsg [0,1,2,3] [0,5,10,3] == [Z.sro_parse "T0M",Z.sro_parse "RT3MI"]
-
->>> pct rsg 0123 4e61
-RT1M
-
-> rsg [0,1,2,3] [4,11,6,1] == [Z.sro_parse "T4MI",Z.sro_parse "RT1M"]
-
->>> echo e614 | pct rsg 0123
-r3RT1M
-
-> rsg [0,1,2,3] [11,6,1,4] == [Z.sro_parse "r1T4MI",Z.sro_parse "r1RT1M"]
-
--}
-rsg :: [Z12] -> [Z12] -> [Z.SRO Z12]
-rsg x y = filter (\o -> sro o x == y) (Z.z_sro_univ (length x) id)
-
--- | Subsets.
-sb :: [[Z12]] -> [[Z12]]
-sb xs =
-    let f p = all id (map (`has_sc` p) xs)
-    in filter f Z12.scs
-
-{- | scc = set class completion
-
->>> pct scc 6-32 168
-35A
-49B
-3AB
-34B
-
-> scc (Z12.sc "6-32") [1,6,8] == [[3,5,10],[4,9,11],[3,10,11],[3,4,11]]
-
--}
-scc :: [Z12] -> [Z12] -> [[Z12]]
-scc r p = map (\\ p) (filter (T.is_subset p) (Z12.tto_ti_related r))
-
-si_hdr :: [String]
-si_hdr =
-    ["pitch-class-set"
-    ,"set-class"
-    ,"interval-class-vector"
-    ,"tics"
-    ,"complement"
-    ,"multiplication-by-five-transform"]
-
-type SI = ([Z12],Z.TTO Z12,[Z12])
-
--- > si_raw [0,5,3,11]
-si_raw :: [Z12] -> (SI,[Z12],[Int],SI,SI)
-si_raw p =
-    let n = length p
-        p_icv = Z12.to_Z12 n : Z12.icv p
-        gen_si x = let x_f = Z12.forte_prime x
-                       Just x_o = rs1 x_f x
-                   in (nub (sort x),x_o,x_f)
-    in (gen_si p,p_icv,tics p,gen_si (Z12.complement p),gen_si (map (* 5) p))
-
-si_raw_pp :: [Z12] -> [String]
-si_raw_pp p =
-    let pf_pp concise (x_o,x_f) =
-            concat [Z.tto_pp x_o," ",Z12.sc_name x_f
-                   ,if concise then "" else Z12.z12_vec_pp x_f]
-        si_pp (x,x_o,x_f) = concat [Z12.z12_set_pp x," (",pf_pp True (x_o,x_f),")"]
-        ((p',p_o,p_f),p_icv,p_tics,c,m) = si_raw p
-    in [Z12.z12_set_pp p'
-       ,pf_pp False (p_o,p_f)
-       ,Z12.z12_vec_pp p_icv
-       ,Z.z16_vec_pp p_tics
-       ,si_pp c
-       ,si_pp m]
-
--- | Set information.
---
--- > putStr $ unlines $ si [0,5,3,11]
-si :: [Z12] -> [String]
-si p = zipWith (\k v -> concat [k,": ",v]) si_hdr (si_raw_pp p)
-
-{- | Super set-class.
-
->>> pct spsc 4-11 4-12
-5-26[02458]
-
-> spsc [Z12.sc "4-11",Z12.sc "4-12"] == [[0,2,4,5,8]]
-
->>> pct spsc 3-11 3-8
-4-27[0258]
-4-Z29[0137]
-
-> spsc [Z12.sc "3-11",Z12.sc "3-8"] == [[0,2,5,8],[0,1,3,7]]
-
->>> pct spsc `pct fl 3`
-6-Z17[012478]
-
-> spsc (cf [3] Z12.scs) == [[0,1,2,4,7,8]]
-
--}
-spsc :: [[Z12]] -> [[Z12]]
-spsc xs =
-    let f y = all (y `has_sc`) xs
-        g = (==) `on` length
-    in (head . groupBy g . filter f) Z12.scs
-
-{- | sra = stravinsky rotational array
-
->>> echo 019BA7 | pct sra
-019BA7
-08A96B
-021A34
-0B812A
-0923B1
-056243
-
-> let r = [[0,1,9,11,10,7],[0,8,10,9,6,11],[0,2,1,10,3,4]
->        ,[0,11,8,1,2,10],[0,9,2,3,11,1],[0,5,6,2,4,3]]
-> in sra [0,1,9,11,10,7] == r
-
--}
-sra :: [Z12] -> [[Z12]]
-sra = map (Z12.sro_tn_to 0) . T.rotations
-
-{- | Serial operation.
-
->>> echo 156 | pct sro T4
-59A
-
-> sro (Z.sro_parse "T4") [1,5,6] == [5,9,10]
-
->>> echo 024579 | pct sro RT4I
-79B024
-
-> sro (Z.SRO 0 True 4 False True) [0,2,4,5,7,9] == [7,9,11,0,2,4]
-
->>> echo 156 | pct sro T4I
-3BA
-
-> sro (Z.sro_parse "T4I") [1,5,6] == [3,11,10]
-> sro (Z.SRO 0 False 4 False True) [1,5,6] == [3,11,10]
-
->>> echo 156 | pct sro T4  | pct sro T0I
-732
-
-> (sro (Z.sro_parse "T0I") . sro (Z.sro_parse "T4")) [1,5,6] == [7,3,2]
-
->>> echo 024579 | pct sro RT4I
-79B024
-
-> sro (Z.sro_parse "RT4I") [0,2,4,5,7,9] == [7,9,11,0,2,4]
-
--}
-sro :: Z.SRO Z12 -> [Z12] -> [Z12]
-sro o = Z.z_sro_apply 5 id o
-
--- | Vector indicating degree of intersection with inversion at each transposition.
---
--- > tics [0,2,4,5,7,9] == [3,2,5,0,5,2,3,4,1,6,1,4]
--- > map tics Z12.scs
-tics :: [Z12] -> [Int]
-tics p =
-    let q = Z12.tto_t_related (Z12.tto_invert 0 p)
-    in map (length . intersect p) q
-
-{- | tmatrix
-
->>> pct tmatrix 1258
-
-1258
-0147
-9A14
-67A1
-
-> tmatrix [1,2,5,8] == [[1,2,5,8],[0,1,4,7],[9,10,1,4],[6,7,10,1]]
-
--}
-tmatrix :: [Z12] -> [[Z12]]
-tmatrix p =
-    let i = map negate (T.d_dx p)
-    in map (\n -> map (+ n) p) (T.dx_d 0 i)
-
-
-{- | trs = transformations search.  Search all RTnMI of /p/ for /q/.
-
->>> echo 642 | pct trs 024579 | sort -u
-531642
-6421B9
-642753
-B97642
-
-> let r = [[5,3,1,6,4,2],[6,4,2,1,11,9],[6,4,2,7,5,3],[11,9,7,6,4,2]]
-> in sort (trs [0,2,4,5,7,9] [6,4,2]) == r
-
--}
-trs :: [Z12] -> [Z12] -> [[Z12]]
-trs p q = filter (q `isInfixOf`) (Z12.sro_rtmi_related p)
-
--- > trs_m [0,2,4,5,7,9] [6,4,2] == [[6,4,2,1,11,9],[11,9,7,6,4,2]]
-trs_m :: [Z12] -> [Z12] -> [[Z12]]
-trs_m p q = filter (q `isInfixOf`) (Z12.sro_rti_related p)
diff --git a/Music/Theory/Z12/Forte_1973.hs b/Music/Theory/Z12/Forte_1973.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Forte_1973.hs
+++ /dev/null
@@ -1,341 +0,0 @@
--- | Allen Forte. /The Structure of Atonal Music/. Yale University
--- Press, New Haven, 1973.
-module Music.Theory.Z12.Forte_1973 where
-
-import qualified Music.Theory.Z.Forte_1973 as Z
-import Music.Theory.Z12
-
--- * Prime form
-
--- | T-related rotations of /p/.
---
--- > t_rotations [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]]
-t_rotations :: [Z12] -> [[Z12]]
-t_rotations = Z.t_rotations id
-
--- | T\/I-related rotations of /p/.
---
--- > ti_rotations [0,1,3] == [[0,1,3],[0,2,11],[0,9,10]
--- >                         ,[0,9,11],[0,2,3],[0,1,10]]
-ti_rotations :: [Z12] -> [[Z12]]
-ti_rotations = Z.ti_rotations id
-
--- | Forte prime form, ie. 'cmp_prime' of 'forte_cmp'.
---
--- > forte_prime [0,1,3,6,8,9] == [0,1,3,6,8,9]
--- > forte_prime [0,2,3,6,7] == [0,1,4,5,7]
-forte_prime :: [Z12] -> [Z12]
-forte_prime = Z.forte_prime id
-
--- | Transpositional equivalence prime form, ie. 't_cmp_prime' of
--- 'forte_cmp'.
---
--- > (forte_prime [0,2,3],t_prime [0,2,3]) == ([0,1,3],[0,2,3])
-t_prime :: [Z12] -> [Z12]
-t_prime = Z.t_prime id
-
--- * Set Class Table
-
-type SC_Name = Z.SC_Name
-
--- | The set-class table (Forte prime forms).
---
--- > length sc_table == 224
-sc_table :: [(SC_Name,[Z12])]
-sc_table = Z.sc_table
-
--- | Lookup a set-class name.  The input set is subject to
--- 'forte_prime' before lookup.
---
--- > sc_name [0,2,3,6,7] == "5-Z18"
--- > sc_name [0,1,4,6,7,8] == "6-Z17"
-sc_name :: [Z12] -> SC_Name
-sc_name = Z.sc_name id
-
--- > sc_name_long [0,1,4,6,7,8] == "6-Z17[012478]"
-sc_name_long :: [Z12] -> SC_Name
-sc_name_long = Z.sc_name_long id
-
--- | Lookup a set-class given a set-class name.
---
--- > sc "6-Z17" == [0,1,2,4,7,8]
-sc :: SC_Name -> [Z12]
-sc = Z.sc
-
-{- | List of set classes (the set class universe).
-
-> let r = [("0-1",[0,0,0,0,0,0])
->         ,("1-1",[0,0,0,0,0,0])
->         ,("2-1",[1,0,0,0,0,0])
->         ,("2-2",[0,1,0,0,0,0])
->         ,("2-3",[0,0,1,0,0,0])
->         ,("2-4",[0,0,0,1,0,0])
->         ,("2-5",[0,0,0,0,1,0])
->         ,("2-6",[0,0,0,0,0,1])
->         ,("3-1",[2,1,0,0,0,0])
->         ,("3-2",[1,1,1,0,0,0])
->         ,("3-3",[1,0,1,1,0,0])
->         ,("3-4",[1,0,0,1,1,0])
->         ,("3-5",[1,0,0,0,1,1])
->         ,("3-6",[0,2,0,1,0,0])
->         ,("3-7",[0,1,1,0,1,0])
->         ,("3-8",[0,1,0,1,0,1])
->         ,("3-9",[0,1,0,0,2,0])
->         ,("3-10",[0,0,2,0,0,1])
->         ,("3-11",[0,0,1,1,1,0])
->         ,("3-12",[0,0,0,3,0,0])
->         ,("4-1",[3,2,1,0,0,0])
->         ,("4-2",[2,2,1,1,0,0])
->         ,("4-3",[2,1,2,1,0,0])
->         ,("4-4",[2,1,1,1,1,0])
->         ,("4-5",[2,1,0,1,1,1])
->         ,("4-6",[2,1,0,0,2,1])
->         ,("4-7",[2,0,1,2,1,0])
->         ,("4-8",[2,0,0,1,2,1])
->         ,("4-9",[2,0,0,0,2,2])
->         ,("4-10",[1,2,2,0,1,0])
->         ,("4-11",[1,2,1,1,1,0])
->         ,("4-12",[1,1,2,1,0,1])
->         ,("4-13",[1,1,2,0,1,1])
->         ,("4-14",[1,1,1,1,2,0])
->         ,("4-Z15",[1,1,1,1,1,1])
->         ,("4-16",[1,1,0,1,2,1])
->         ,("4-17",[1,0,2,2,1,0])
->         ,("4-18",[1,0,2,1,1,1])
->         ,("4-19",[1,0,1,3,1,0])
->         ,("4-20",[1,0,1,2,2,0])
->         ,("4-21",[0,3,0,2,0,1])
->         ,("4-22",[0,2,1,1,2,0])
->         ,("4-23",[0,2,1,0,3,0])
->         ,("4-24",[0,2,0,3,0,1])
->         ,("4-25",[0,2,0,2,0,2])
->         ,("4-26",[0,1,2,1,2,0])
->         ,("4-27",[0,1,2,1,1,1])
->         ,("4-28",[0,0,4,0,0,2])
->         ,("4-Z29",[1,1,1,1,1,1])
->         ,("5-1",[4,3,2,1,0,0])
->         ,("5-2",[3,3,2,1,1,0])
->         ,("5-3",[3,2,2,2,1,0])
->         ,("5-4",[3,2,2,1,1,1])
->         ,("5-5",[3,2,1,1,2,1])
->         ,("5-6",[3,1,1,2,2,1])
->         ,("5-7",[3,1,0,1,3,2])
->         ,("5-8",[2,3,2,2,0,1])
->         ,("5-9",[2,3,1,2,1,1])
->         ,("5-10",[2,2,3,1,1,1])
->         ,("5-11",[2,2,2,2,2,0])
->         ,("5-Z12",[2,2,2,1,2,1])
->         ,("5-13",[2,2,1,3,1,1])
->         ,("5-14",[2,2,1,1,3,1])
->         ,("5-15",[2,2,0,2,2,2])
->         ,("5-16",[2,1,3,2,1,1])
->         ,("5-Z17",[2,1,2,3,2,0])
->         ,("5-Z18",[2,1,2,2,2,1])
->         ,("5-19",[2,1,2,1,2,2])
->         ,("5-20",[2,1,1,2,3,1])
->         ,("5-21",[2,0,2,4,2,0])
->         ,("5-22",[2,0,2,3,2,1])
->         ,("5-23",[1,3,2,1,3,0])
->         ,("5-24",[1,3,1,2,2,1])
->         ,("5-25",[1,2,3,1,2,1])
->         ,("5-26",[1,2,2,3,1,1])
->         ,("5-27",[1,2,2,2,3,0])
->         ,("5-28",[1,2,2,2,1,2])
->         ,("5-29",[1,2,2,1,3,1])
->         ,("5-30",[1,2,1,3,2,1])
->         ,("5-31",[1,1,4,1,1,2])
->         ,("5-32",[1,1,3,2,2,1])
->         ,("5-33",[0,4,0,4,0,2])
->         ,("5-34",[0,3,2,2,2,1])
->         ,("5-35",[0,3,2,1,4,0])
->         ,("5-Z36",[2,2,2,1,2,1])
->         ,("5-Z37",[2,1,2,3,2,0])
->         ,("5-Z38",[2,1,2,2,2,1])
->         ,("6-1",[5,4,3,2,1,0])
->         ,("6-2",[4,4,3,2,1,1])
->         ,("6-Z3",[4,3,3,2,2,1])
->         ,("6-Z4",[4,3,2,3,2,1])
->         ,("6-5",[4,2,2,2,3,2])
->         ,("6-Z6",[4,2,1,2,4,2])
->         ,("6-7",[4,2,0,2,4,3])
->         ,("6-8",[3,4,3,2,3,0])
->         ,("6-9",[3,4,2,2,3,1])
->         ,("6-Z10",[3,3,3,3,2,1])
->         ,("6-Z11",[3,3,3,2,3,1])
->         ,("6-Z12",[3,3,2,2,3,2])
->         ,("6-Z13",[3,2,4,2,2,2])
->         ,("6-14",[3,2,3,4,3,0])
->         ,("6-15",[3,2,3,4,2,1])
->         ,("6-16",[3,2,2,4,3,1])
->         ,("6-Z17",[3,2,2,3,3,2])
->         ,("6-18",[3,2,2,2,4,2])
->         ,("6-Z19",[3,1,3,4,3,1])
->         ,("6-20",[3,0,3,6,3,0])
->         ,("6-21",[2,4,2,4,1,2])
->         ,("6-22",[2,4,1,4,2,2])
->         ,("6-Z23",[2,3,4,2,2,2])
->         ,("6-Z24",[2,3,3,3,3,1])
->         ,("6-Z25",[2,3,3,2,4,1])
->         ,("6-Z26",[2,3,2,3,4,1])
->         ,("6-27",[2,2,5,2,2,2])
->         ,("6-Z28",[2,2,4,3,2,2])
->         ,("6-Z29",[2,2,4,2,3,2])
->         ,("6-30",[2,2,4,2,2,3])
->         ,("6-31",[2,2,3,4,3,1])
->         ,("6-32",[1,4,3,2,5,0])
->         ,("6-33",[1,4,3,2,4,1])
->         ,("6-34",[1,4,2,4,2,2])
->         ,("6-35",[0,6,0,6,0,3])
->         ,("6-Z36",[4,3,3,2,2,1])
->         ,("6-Z37",[4,3,2,3,2,1])
->         ,("6-Z38",[4,2,1,2,4,2])
->         ,("6-Z39",[3,3,3,3,2,1])
->         ,("6-Z40",[3,3,3,2,3,1])
->         ,("6-Z41",[3,3,2,2,3,2])
->         ,("6-Z42",[3,2,4,2,2,2])
->         ,("6-Z43",[3,2,2,3,3,2])
->         ,("6-Z44",[3,1,3,4,3,1])
->         ,("6-Z45",[2,3,4,2,2,2])
->         ,("6-Z46",[2,3,3,3,3,1])
->         ,("6-Z47",[2,3,3,2,4,1])
->         ,("6-Z48",[2,3,2,3,4,1])
->         ,("6-Z49",[2,2,4,3,2,2])
->         ,("6-Z50",[2,2,4,2,3,2])
->         ,("7-1",[6,5,4,3,2,1])
->         ,("7-2",[5,5,4,3,3,1])
->         ,("7-3",[5,4,4,4,3,1])
->         ,("7-4",[5,4,4,3,3,2])
->         ,("7-5",[5,4,3,3,4,2])
->         ,("7-6",[5,3,3,4,4,2])
->         ,("7-7",[5,3,2,3,5,3])
->         ,("7-8",[4,5,4,4,2,2])
->         ,("7-9",[4,5,3,4,3,2])
->         ,("7-10",[4,4,5,3,3,2])
->         ,("7-11",[4,4,4,4,4,1])
->         ,("7-Z12",[4,4,4,3,4,2])
->         ,("7-13",[4,4,3,5,3,2])
->         ,("7-14",[4,4,3,3,5,2])
->         ,("7-15",[4,4,2,4,4,3])
->         ,("7-16",[4,3,5,4,3,2])
->         ,("7-Z17",[4,3,4,5,4,1])
->         ,("7-Z18",[4,3,4,4,4,2])
->         ,("7-19",[4,3,4,3,4,3])
->         ,("7-20",[4,3,3,4,5,2])
->         ,("7-21",[4,2,4,6,4,1])
->         ,("7-22",[4,2,4,5,4,2])
->         ,("7-23",[3,5,4,3,5,1])
->         ,("7-24",[3,5,3,4,4,2])
->         ,("7-25",[3,4,5,3,4,2])
->         ,("7-26",[3,4,4,5,3,2])
->         ,("7-27",[3,4,4,4,5,1])
->         ,("7-28",[3,4,4,4,3,3])
->         ,("7-29",[3,4,4,3,5,2])
->         ,("7-30",[3,4,3,5,4,2])
->         ,("7-31",[3,3,6,3,3,3])
->         ,("7-32",[3,3,5,4,4,2])
->         ,("7-33",[2,6,2,6,2,3])
->         ,("7-34",[2,5,4,4,4,2])
->         ,("7-35",[2,5,4,3,6,1])
->         ,("7-Z36",[4,4,4,3,4,2])
->         ,("7-Z37",[4,3,4,5,4,1])
->         ,("7-Z38",[4,3,4,4,4,2])
->         ,("8-1",[7,6,5,4,4,2])
->         ,("8-2",[6,6,5,5,4,2])
->         ,("8-3",[6,5,6,5,4,2])
->         ,("8-4",[6,5,5,5,5,2])
->         ,("8-5",[6,5,4,5,5,3])
->         ,("8-6",[6,5,4,4,6,3])
->         ,("8-7",[6,4,5,6,5,2])
->         ,("8-8",[6,4,4,5,6,3])
->         ,("8-9",[6,4,4,4,6,4])
->         ,("8-10",[5,6,6,4,5,2])
->         ,("8-11",[5,6,5,5,5,2])
->         ,("8-12",[5,5,6,5,4,3])
->         ,("8-13",[5,5,6,4,5,3])
->         ,("8-14",[5,5,5,5,6,2])
->         ,("8-Z15",[5,5,5,5,5,3])
->         ,("8-16",[5,5,4,5,6,3])
->         ,("8-17",[5,4,6,6,5,2])
->         ,("8-18",[5,4,6,5,5,3])
->         ,("8-19",[5,4,5,7,5,2])
->         ,("8-20",[5,4,5,6,6,2])
->         ,("8-21",[4,7,4,6,4,3])
->         ,("8-22",[4,6,5,5,6,2])
->         ,("8-23",[4,6,5,4,7,2])
->         ,("8-24",[4,6,4,7,4,3])
->         ,("8-25",[4,6,4,6,4,4])
->         ,("8-26",[4,5,6,5,6,2])
->         ,("8-27",[4,5,6,5,5,3])
->         ,("8-28",[4,4,8,4,4,4])
->         ,("8-Z29",[5,5,5,5,5,3])
->         ,("9-1",[8,7,6,6,6,3])
->         ,("9-2",[7,7,7,6,6,3])
->         ,("9-3",[7,6,7,7,6,3])
->         ,("9-4",[7,6,6,7,7,3])
->         ,("9-5",[7,6,6,6,7,4])
->         ,("9-6",[6,8,6,7,6,3])
->         ,("9-7",[6,7,7,6,7,3])
->         ,("9-8",[6,7,6,7,6,4])
->         ,("9-9",[6,7,6,6,8,3])
->         ,("9-10",[6,6,8,6,6,4])
->         ,("9-11",[6,6,7,7,7,3])
->         ,("9-12",[6,6,6,9,6,3])
->         ,("10-1",[9,8,8,8,8,4])
->         ,("10-2",[8,9,8,8,8,4])
->         ,("10-3",[8,8,9,8,8,4])
->         ,("10-4",[8,8,8,9,8,4])
->         ,("10-5",[8,8,8,8,9,4])
->         ,("10-6",[8,8,8,8,8,5])
->         ,("11-1",[10,10,10,10,10,5])
->         ,("12-1",[12,12,12,12,12,6])]
-> in let icvs = map icv scs in zip (map sc_name scs) icvs == r
-
--}
-scs :: [[Z12]]
-scs = Z.scs
-
--- | Cardinality /n/ subset of 'scs'.
---
--- > map (length . scs_n) [1..11] == [1,6,12,29,38,50,38,29,12,6,1]
-scs_n :: Integral i => i -> [[Z12]]
-scs_n = Z.scs_n
-
--- * BIP Metric
-
--- | Basic interval pattern, see Allen Forte \"The Basic Interval Patterns\"
--- /JMT/ 17/2 (1973):234-272
---
--- >>> pct bip 0t95728e3416
--- 11223344556
---
--- > bip [0,10,9,5,7,2,8,11,3,4,1,6] == [1,1,2,2,3,3,4,4,5,5,6]
--- > bip (pco "0t95728e3416") == [1,1,2,2,3,3,4,4,5,5,6]
-bip :: [Z12] -> [Z12]
-bip = map int_to_Z12 . Z.bip 12 . map int_from_Z12
-
--- * ICV Metric
-
--- | Interval class of Z12 interval /i/.
---
--- > map ic [5,6,7] == [5,6,5]
--- > map ic [-13,-1,0,1,13] == [1,1,0,1,1]
-ic :: Z12 -> Z12
-ic = int_to_Z12 . Z.ic 12 . int_from_Z12
-
--- | Forte notation for interval class vector.
---
--- > icv [0,1,2,4,7,8] == [3,2,2,3,3,2]
-icv :: Integral i => [Z12] -> [i]
-icv = map fromInteger . Z.icv 12 . map int_from_Z12
-
--- | Type specialise...
-icv' :: [Z12] -> [Int]
-icv' = icv
-
--- * Z-relation
-
--- | Locate /Z/ relation of set class.
---
--- > fmap sc_name (z_relation_of (sc "7-Z12")) == Just "7-Z36"
-z_relation_of :: [Z12] -> Maybe [Z12]
-z_relation_of = fmap (map int_to_Z12) . Z.z_relation_of 12 . map int_from_Z12
diff --git a/Music/Theory/Z12/Lewin_1980.hs b/Music/Theory/Z12/Lewin_1980.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Lewin_1980.hs
+++ /dev/null
@@ -1,48 +0,0 @@
--- | David Lewin. \"A Response to a Response: On PC Set
--- Relatedness\". /Perspectives of New Music/, 18(1-2):498-502, 1980.
-module Music.Theory.Z12.Lewin_1980 where
-
-import Data.List
-import qualified Music.Theory.Z12.Castren_1994 as C
-
-type Z12 = Int
-
--- | REL function with given /ncv/ function (see 't_rel' and 'ti_rel').
-rel :: Floating n => (Int -> [a] -> [n]) -> [a] -> [a] -> n
-rel ncv x y =
-    let n = min (genericLength x) (genericLength y)
-        p = map (`ncv` x) [2..n]
-        q = map (`ncv` y) [2..n]
-        f = zipWith (\i j -> sqrt (i * j))
-        pt = sum (map sum p)
-        qt = sum (map sum q)
-    in sum (map sum (zipWith f p q)) / sqrt (pt * qt)
-
--- | T-equivalence REL function.
---
--- Kuusi 2001, 7.5.2
---
--- > let (~=) p q = abs (p - q) < 1e-2
--- > t_rel [0,1,2,3,4] [0,2,3,6,7] ~= 0.44
--- > t_rel [0,1,2,3,4] [0,2,4,6,8] ~= 0.28
--- > t_rel [0,2,3,6,7] [0,2,4,6,8] ~= 0.31
-t_rel :: Floating n => [Z12] -> [Z12] -> n
-t_rel = rel C.t_n_class_vector
-
--- | T/I-equivalence REL function.
---
--- Buchler 1998, Fig. 3.38
---
--- > let (~=) p q = abs (p - q) < 1e-3
--- > let a = [0,2,3,5,7]::[Z12]
--- > let b = [0,2,3,4,5,8]::[Z12]
--- > let g = [0,1,2,3,5,6,8,10]::[Z12]
--- > let j = [0,2,3,4,5,6,8]::[Z12]
--- > ti_rel a b ~= 0.593
--- > ti_rel a g ~= 0.648
--- > ti_rel a j ~= 0.509
--- > ti_rel b g ~= 0.712
--- > ti_rel b j ~= 0.892
--- > ti_rel g j ~= 0.707
-ti_rel :: Floating n => [Z12] -> [Z12] -> n
-ti_rel = rel C.ti_n_class_vector
diff --git a/Music/Theory/Z12/Literature.hs b/Music/Theory/Z12/Literature.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Literature.hs
+++ /dev/null
@@ -1,48 +0,0 @@
--- | Z12 set class database.
-module Music.Theory.Z12.Literature where
-
--- | Set class database with descriptors for historically and
--- theoretically significant set classes, indexed by Forte name.
---
--- > lookup "6-Z17" sc_db == Just "All-Trichord Hexachord"
--- > lookup "7-35" sc_db == Just "diatonic collection (d)"
-sc_db :: [(String,String)]
-sc_db =
-    [("4-Z15","All-Interval Tetrachord (see also 4-Z29)")
-    ,("4-Z29","All-Interval Tetrachord (see also 4-Z15)")
-    ,("6-Z17","All-Trichord Hexachord")
-    ,("8-Z15","All-Tetrachord Octochord (see also 8-Z29)")
-    ,("8-Z29","All-Tetrachord Octochord (see also 8-Z15)")
-    ,("6-1","A-Type All-Combinatorial Hexachord")
-    ,("6-8","B-Type All-Combinatorial Hexachord")
-    ,("6-32","C-Type All-Combinatorial Hexachord")
-    ,("6-7","D-Type All-Combinatorial Hexachord")
-    ,("6-20","E-Type All-Combinatorial Hexachord")
-    ,("6-35","F-Type All-Combinatorial Hexachord")
-    ,("7-35","diatonic collection (d)")
-    ,("7-34","ascending melodic minor collection")
-    ,("8-28","octotonic collection (Messiaen Mode II)")
-    ,("6-35","wholetone collection")
-    ,("3-10","diminished triad")
-    ,("3-11","major/minor triad")
-    ,("3-12","augmented triad")
-    ,("4-19","minor major-seventh chord")
-    ,("4-20","major-seventh chord")
-    ,("4-25","french augmented sixth chord")
-    ,("4-28","dimished-seventh chord")
-    ,("4-26","minor-seventh chord")
-    ,("4-27","half-dimished seventh(P)/dominant-seventh(I) chord")
-    ,("6-30","Petrushka Chord {0476a1},3-11 at T6")
-    ,("6-34","Mystic Chord {06a492}")
-    ,("6-Z44","Schoenberg Signature Set,3-3 at T5 or T7")
-    ,("6-Z19","complement of 6-Z44,3-11 at T1 or TB")
-    ,("9-12","Messiaen Mode III (nontonic collection)")
-    ,("8-9","Messian Mode IV")
-    ,("7-31","The only seven-element subset of 8-28. ")
-    ,("5-31","The only five-element superset of 4-28.")
-    ,("5-33","The only five-element subset of 6-35.")
-    ,("7-33","The only seven-element superset of 6-35.")
-    ,("5-21","The only five-element subset of 6-20.")
-    ,("7-21","The only seven-element superset of 6-20.")
-    ,("5-25","The only five-element subset of both 7-35 and 8-28.")
-    ,("6-14","Any non-intersecting union of 3-6 and 3-12.") ]
diff --git a/Music/Theory/Z12/Morris_1974.hs b/Music/Theory/Z12/Morris_1974.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Morris_1974.hs
+++ /dev/null
@@ -1,36 +0,0 @@
--- | Robert Morris and D. Starr. \"The Structure of All-Interval Series\".
--- /Journal of Music Theory/, 18:364-389, 1974.
-module Music.Theory.Z12.Morris_1974 where
-
-import qualified Control.Monad.Logic as L {- logict -}
-
--- | 'L.msum' '.' 'map' 'return'.
---
--- > L.observeAll (fromList [1..7]) == [1..7]
-fromList :: L.MonadPlus m => [a] -> m a
-fromList = L.msum . map return
-
--- | 'L.MonadLogic' all-interval series.
---
--- > map (length . L.observeAll . all_interval_m) [4,6,8,10] == [2,4,24,288]
--- > [0,1,3,2,9,5,10,4,7,11,8,6] `elem` L.observeAll (all_interval_m 12)
--- > length (L.observeAll (all_interval_m 12)) == 3856
-all_interval_m :: L.MonadLogic m => Int -> m [Int]
-all_interval_m n =
-    let recur k p q = -- k = length p
-            if k == n
-            then return (reverse p)
-            else do i <- fromList [1 .. n - 1]
-                    L.guard (i `notElem` p)
-                    let j:_ = p
-                        m = abs ((i - j) `mod` n)
-                    L.guard (m `notElem` q)
-                    recur (k + 1) (i : p) (m : q)
-    in recur 1 [0] []
-
--- | 'L.observeAll' of 'all_interval_m'.
---
--- > let r = [[0,1,5,2,4,3],[0,2,1,4,5,3],[0,4,5,2,1,3],[0,5,1,4,2,3]]
--- > in all_interval 6 == r
-all_interval :: Int -> [[Int]]
-all_interval = L.observeAll . all_interval_m
diff --git a/Music/Theory/Z12/Morris_1987.hs b/Music/Theory/Z12/Morris_1987.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Morris_1987.hs
+++ /dev/null
@@ -1,12 +0,0 @@
--- | Robert Morris. /Composition with Pitch-Classes: A Theory of
--- Compositional Design/. Yale University Press, New Haven, 1987.
-module Music.Theory.Z12.Morris_1987 where
-
-import Music.Theory.List
-import Music.Theory.Z12
-
--- | @INT@ operator.
---
--- > int [0,1,3,6,10] == [1,2,3,4]
-int :: [Z12] -> [Z12]
-int = d_dx
diff --git a/Music/Theory/Z12/Morris_1987/Parse.hs b/Music/Theory/Z12/Morris_1987/Parse.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Morris_1987/Parse.hs
+++ /dev/null
@@ -1,21 +0,0 @@
--- | Parsers for pitch class sets and sequences, and for 'SRO's.
-module Music.Theory.Z12.Morris_1987.Parse where
-
-import Data.Char {- base -}
-
-import Music.Theory.Z12
-
--- | Parse a /pitch class object/ string.  Each 'Char' is either a
--- number, a space which is ignored, or a letter name for the numbers
--- 10 ('t' or 'a' or 'A') or 11 ('e' or 'B' or 'b').
---
--- > pco "13te" == [1,3,10,11]
--- > pco "13te" == pco "13ab"
-pco :: String -> [Z12]
-pco s =
-    let s' = dropWhile isSpace s
-        s'' = takeWhile (`elem` "0123456789taAebB") s'
-        f c | c `elem` "taA" = 10
-            | c `elem` "ebB" = 11
-            | otherwise = fromInteger (read [c])
-    in map f s''
diff --git a/Music/Theory/Z12/Rahn_1980.hs b/Music/Theory/Z12/Rahn_1980.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Rahn_1980.hs
+++ /dev/null
@@ -1,25 +0,0 @@
--- | John Rahn. /Basic Atonal Theory/. Longman, New York, 1980.
-module Music.Theory.Z12.Rahn_1980 where
-
-import Music.Theory.Z12
-import qualified Music.Theory.Z.Forte_1973 as Z
-
--- | Rahn prime form (comparison is rightmost inwards).
---
--- > rahn_cmp [0,1,3,6,8,9] [0,2,3,6,7,9] == GT
-rahn_cmp :: Ord a => [a] -> [a] -> Ordering
-rahn_cmp p q = compare (reverse p) (reverse q)
-
--- | Rahn prime form, ie. 'ti_cmp_prime' of 'rahn_cmp'.
---
--- > rahn_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
---
--- > import Music.Theory.Z12.Forte_1973
---
--- > let s = [[0,1,3,7,8]
--- >         ,[0,1,3,6,8,9],[0,1,3,5,8,9]
--- >         ,[0,1,2,4,7,8,9]
--- >         ,[0,1,2,4,5,7,9,10]]
--- > in all (\p -> forte_prime p /= rahn_prime p) s == True
-rahn_prime :: [Z12] -> [Z12]
-rahn_prime = Z.ti_cmp_prime id rahn_cmp
diff --git a/Music/Theory/Z12/Read_1978.hs b/Music/Theory/Z12/Read_1978.hs
deleted file mode 100644
--- a/Music/Theory/Z12/Read_1978.hs
+++ /dev/null
@@ -1,28 +0,0 @@
--- | Ronald C. Read. \"Every one a winner or how to avoid isomorphism
--- search when cataloguing combinatorial configurations.\" /Annals of
--- Discrete Mathematics/ 2:107–20, 1978.
-module Music.Theory.Z12.Read_1978 where
-
-import Music.Theory.Z12 {- hmt -}
-import qualified Music.Theory.Z.Read_1978 as Z {- hmt -}
-
-type Code = Z.Code
-
--- | Encoder for 'encode_prime'.
---
--- > encode [0,1,3,6,8,9] == 843
-encode :: [Z12] -> Code
-encode = Z.encode
-
--- | Decoder for 'encode_prime'.
---
--- > decode 843 == [0,1,3,6,8,9]
-decode :: Code -> [Z12]
-decode = Z.decode 12
-
--- | Binary encoding prime form algorithm, equalivalent to Rahn.
---
--- > encode_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
--- > Music.Theory.Z12.Rahn_1980.rahn_prime [0,1,3,6,8,9] == [0,2,3,6,7,9]
-encode_prime :: [Z12] -> [Z12]
-encode_prime = Z.encode_prime id
diff --git a/Music/Theory/Z12/SRO.hs b/Music/Theory/Z12/SRO.hs
deleted file mode 100644
--- a/Music/Theory/Z12/SRO.hs
+++ /dev/null
@@ -1,97 +0,0 @@
--- | Serial (ordered) pitch-class operations on 'Z12'.
-module Music.Theory.Z12.SRO where
-
-import Data.List {- base -}
-
-import qualified Music.Theory.List as T
-import qualified Music.Theory.Z.SRO as Z
-import           Music.Theory.Z12
-
--- | Transpose /p/ by /n/.
---
--- > sro_tn 4 [1,5,6] == [5,9,10]
-sro_tn :: Z12 -> [Z12] -> [Z12]
-sro_tn = Z.z_sro_tn id
-
--- | Invert /p/ about /n/.
---
--- > sro_invert 6 [4,5,6] == [8,7,6]
--- > sro_invert 0 [0,1,3] == [0,11,9]
-sro_invert :: Z12 -> [Z12] -> [Z12]
-sro_invert = Z.z_sro_invert id
-
--- | Composition of 'invert' about @0@ and 'tn'.
---
--- > tni 4 [1,5,6] == [3,11,10]
--- > (sro_invert 0 . sro_tn  4) [1,5,6] == [7,3,2]
-sro_tni :: Z12 -> [Z12] -> [Z12]
-sro_tni = Z.z_sro_tni id
-
--- | Modulo 12 multiplication
---
--- > sro_mn 11 [0,1,4,9] == sro_tni 0 [0,1,4,9]
-sro_mn :: Z12 -> [Z12] -> [Z12]
-sro_mn = Z.z_sro_mn id
-
--- | M5, ie. 'mn' @5@.
---
--- > sro_m5 [0,1,3] == [0,5,3]
-sro_m5 :: [Z12] -> [Z12]
-sro_m5 = sro_mn 5
-
--- | T-related sequences of /p/.
---
--- > length (sro_t_related [0,3,6,9]) == 12
-sro_t_related :: [Z12] -> [[Z12]]
-sro_t_related = Z.z_sro_t_related id
-
--- | T\/I-related sequences of /p/.
---
--- > length (ti_related [0,1,3]) == 24
--- > length (ti_related [0,3,6,9]) == 24
--- > ti_related [0] == map return [0..11]
-sro_ti_related :: [Z12] -> [[Z12]]
-sro_ti_related = Z.z_sro_ti_related id
-
--- | R\/T\/I-related sequences of /p/.
---
--- > length (rti_related [0,1,3]) == 48
--- > length (rti_related [0,3,6,9]) == 24
-sro_rti_related :: [Z12] -> [[Z12]]
-sro_rti_related = Z.z_sro_rti_related id
-
--- | T\/M\/I-related sequences of /p/, duplicates removed.
-sro_tmi_related :: [Z12] -> [[Z12]]
-sro_tmi_related p = let q = sro_ti_related p in nub (q ++ map sro_m5 q)
-
--- | R\/T\/M\/I-related sequences of /p/, duplicates removed.
-sro_rtmi_related :: [Z12] -> [[Z12]]
-sro_rtmi_related p = let q = sro_tmi_related p in nub (q ++ map reverse q)
-
--- | r\/R\/T\/M\/I-related sequences of /p/, duplicates removed.
-sro_rrtmi_related :: [Z12] -> [[Z12]]
-sro_rrtmi_related p = nub (concatMap sro_rtmi_related (T.rotations p))
-
--- * Sequence operations
-
--- | Variant of 'tn', transpose /p/ so first element is /n/.
---
--- > sro_tn_to 5 [0,1,3] == [5,6,8]
--- > map (sro_tn_to 0) [[0,1,3],[1,3,0],[3,0,1]] == [[0,1,3],[0,2,11],[0,9,10]]
-sro_tn_to :: Z12 -> [Z12] -> [Z12]
-sro_tn_to = Z.z_sro_tn_to id
-
--- | Variant of 'invert', inverse about /n/th element.
---
--- > map (sro_invert_ix 0) [[0,1,3],[3,4,6]] == [[0,11,9],[3,2,0]]
--- > map (sro_invert_ix 1) [[0,1,3],[3,4,6]] == [[2,1,11],[5,4,2]]
-sro_invert_ix :: Int -> [Z12] -> [Z12]
-sro_invert_ix = Z.z_sro_invert_ix id
-
--- | The standard t-matrix of /p/.
---
--- > tmatrix [0,1,3] == [[0,1,3]
--- >                    ,[11,0,2]
--- >                    ,[9,10,0]]
-tmatrix :: [Z12] -> [[Z12]]
-tmatrix = Z.z_tmatrix id
diff --git a/Music/Theory/Z12/TTO.hs b/Music/Theory/Z12/TTO.hs
deleted file mode 100644
--- a/Music/Theory/Z12/TTO.hs
+++ /dev/null
@@ -1,59 +0,0 @@
--- | Pitch-class set (unordered) operations on 'Z12'.
-module Music.Theory.Z12.TTO where
-
-import Data.List {- base -}
-
-import Music.Theory.Z12
-
--- | Map to pitch-class and reduce to set.
---
--- > pcset [1,13] == [1]
-pcset :: (Integral a) => [a] -> [Z12]
-pcset = nub . sort . map fromIntegral
-
--- | Transpose by n.
---
--- > tto_tn 4 [1,5,6] == [5,9,10]
--- > tto_tn 4 [0,4,8] == [0,4,8]
-tto_tn :: Z12 -> [Z12] -> [Z12]
-tto_tn n = sort . map (+ n)
-
--- | Invert about n.
---
--- > tto_invert 6 [4,5,6] == [6,7,8]
--- > tto_invert 0 [0,1,3] == [0,9,11]
-tto_invert :: Z12 -> [Z12] -> [Z12]
-tto_invert n = sort . map (\p -> n - (p - n))
-
--- | Composition of 'invert' about @0@ and 'tn'.
---
--- > tto_tni 4 [1,5,6] == [3,10,11]
--- > (tto_invert 0 . tto_tn 4) [1,5,6] == [2,3,7]
-tto_tni :: Z12 -> [Z12] -> [Z12]
-tto_tni n = tto_tn n . tto_invert 0
-
--- | Modulo 12 multiplication
---
--- > tto_mn 11 [0,1,4,9] == tto_invert 0 [0,1,4,9]
-tto_mn :: Z12 -> [Z12] -> [Z12]
-tto_mn n = sort . map (* n)
-
--- | M5, ie. 'mn' @5@.
---
--- > tto_m5 [0,1,3] == [0,3,5]
-tto_m5 :: [Z12] -> [Z12]
-tto_m5 = tto_mn 5
-
--- | T-related sets of /p/.
---
--- > length (tto_t_related [0,1,3]) == 12
--- > tto_t_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
-tto_t_related :: [Z12] -> [[Z12]]
-tto_t_related p = nub (map (`tto_tn` p) [0..11])
-
--- | T\/I-related set of /p/.
---
--- > length (tto_ti_related [0,1,3]) == 24
--- > tto_ti_related [0,3,6,9] == [[0,3,6,9],[1,4,7,10],[2,5,8,11]]
-tto_ti_related :: [Z12] -> [[Z12]]
-tto_ti_related p = nub (tto_t_related p ++ tto_t_related (tto_invert 0 p))
diff --git a/README b/README
deleted file mode 100644
--- a/README
+++ /dev/null
@@ -1,21 +0,0 @@
-hmt - haskell music theory
---------------------------
-
-Music theory operations in [haskell][hs], primarily focused on 'set
-theory' and 'common music notation'.
-
-- [hmt-diagrams][hmt-diagrams]
-
-## cli
-
-[db](?t=hmt&e=md/db.md),
-[pct](?t=hmt&e=md/pct.md),
-[scala](?t=hmt&e=md/scala.md)
-
-[hs]: http://haskell.org/
-[hmt-diagrams]:  http://rd.slavepianos.org/?t=hmt-diagrams
-
-© [rohan drape][rd], 2006-2017, [gpl][gpl].
-
-[rd]:  http://rd.slavepianos.org/
-[gpl]: http://gnu.org/copyleft/
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,26 @@
+hmt - haskell music theory
+--------------------------
+
+[haskell](http://haskell.org/) music theory
+
+requires:
+
+- [hmt-base](http://rohandrape.net/?t=hmt-base)
+
+related:
+
+- [hmt-diagrams](http://rohandrape.net/?t=hmt-diagrams)
+- [hmt-texts](http://rohandrape.net/?t=hmt-texts)
+
+## cli
+
+[csv-midi](http://rohandrape.net/?t=hmt&e=md/csv-midi.md),
+[db](http://rohandrape.net/?t=hmt&e=md/db.md),
+[gl](http://rohandrape.net/?t=hmt&e=md/gl.md),
+[gr-planar](http://rohandrape.net/?t=hmt&e=md/gr-planar.md),
+[obj](http://rohandrape.net/?t=hmt&e=md/obj.md),
+[pct](http://rohandrape.net/?t=hmt&e=md/pct.md),
+[ply](http://rohandrape.net/?t=hmt&e=md/ply.md),
+[scala](http://rohandrape.net/?t=hmt&e=md/scala.md)
+
+© [rohan drape](http://rohandrape.net/), 2006-2022, [gpl](http://gnu.org/copyleft/).
diff --git a/data/csv/mnd/all-notes-off.csv b/data/csv/mnd/all-notes-off.csv
new file mode 100644
--- /dev/null
+++ b/data/csv/mnd/all-notes-off.csv
@@ -0,0 +1,129 @@
+time,on/off,note,velocity,channel,param
+0.0000,off,0,0,0,
+0.0100,off,1,0,0,
+0.0200,off,2,0,0,
+0.0300,off,3,0,0,
+0.0400,off,4,0,0,
+0.0500,off,5,0,0,
+0.0600,off,6,0,0,
+0.0700,off,7,0,0,
+0.0800,off,8,0,0,
+0.0900,off,9,0,0,
+0.1000,off,10,0,0,
+0.1100,off,11,0,0,
+0.1200,off,12,0,0,
+0.1300,off,13,0,0,
+0.1400,off,14,0,0,
+0.1500,off,15,0,0,
+0.1600,off,16,0,0,
+0.1700,off,17,0,0,
+0.1800,off,18,0,0,
+0.1900,off,19,0,0,
+0.2000,off,20,0,0,
+0.2100,off,21,0,0,
+0.2200,off,22,0,0,
+0.2300,off,23,0,0,
+0.2400,off,24,0,0,
+0.2500,off,25,0,0,
+0.2600,off,26,0,0,
+0.2700,off,27,0,0,
+0.2800,off,28,0,0,
+0.2900,off,29,0,0,
+0.3000,off,30,0,0,
+0.3100,off,31,0,0,
+0.3200,off,32,0,0,
+0.3300,off,33,0,0,
+0.3400,off,34,0,0,
+0.3500,off,35,0,0,
+0.3600,off,36,0,0,
+0.3700,off,37,0,0,
+0.3800,off,38,0,0,
+0.3900,off,39,0,0,
+0.4000,off,40,0,0,
+0.4100,off,41,0,0,
+0.4200,off,42,0,0,
+0.4300,off,43,0,0,
+0.4400,off,44,0,0,
+0.4500,off,45,0,0,
+0.4600,off,46,0,0,
+0.4700,off,47,0,0,
+0.4800,off,48,0,0,
+0.4900,off,49,0,0,
+0.5000,off,50,0,0,
+0.5100,off,51,0,0,
+0.5200,off,52,0,0,
+0.5300,off,53,0,0,
+0.5400,off,54,0,0,
+0.5500,off,55,0,0,
+0.5600,off,56,0,0,
+0.5700,off,57,0,0,
+0.5800,off,58,0,0,
+0.5900,off,59,0,0,
+0.6000,off,60,0,0,
+0.6100,off,61,0,0,
+0.6200,off,62,0,0,
+0.6300,off,63,0,0,
+0.6400,off,64,0,0,
+0.6500,off,65,0,0,
+0.6600,off,66,0,0,
+0.6700,off,67,0,0,
+0.6800,off,68,0,0,
+0.6900,off,69,0,0,
+0.7000,off,70,0,0,
+0.7100,off,71,0,0,
+0.7200,off,72,0,0,
+0.7300,off,73,0,0,
+0.7400,off,74,0,0,
+0.7500,off,75,0,0,
+0.7600,off,76,0,0,
+0.7700,off,77,0,0,
+0.7800,off,78,0,0,
+0.7900,off,79,0,0,
+0.8000,off,80,0,0,
+0.8100,off,81,0,0,
+0.8200,off,82,0,0,
+0.8300,off,83,0,0,
+0.8400,off,84,0,0,
+0.8500,off,85,0,0,
+0.8600,off,86,0,0,
+0.8700,off,87,0,0,
+0.8800,off,88,0,0,
+0.8900,off,89,0,0,
+0.9000,off,90,0,0,
+0.9100,off,91,0,0,
+0.9200,off,92,0,0,
+0.9300,off,93,0,0,
+0.9400,off,94,0,0,
+0.9500,off,95,0,0,
+0.9600,off,96,0,0,
+0.9700,off,97,0,0,
+0.9800,off,98,0,0,
+0.9900,off,99,0,0,
+1.0000,off,100,0,0,
+1.0100,off,101,0,0,
+1.0200,off,102,0,0,
+1.0300,off,103,0,0,
+1.0400,off,104,0,0,
+1.0500,off,105,0,0,
+1.0600,off,106,0,0,
+1.0700,off,107,0,0,
+1.0800,off,108,0,0,
+1.0900,off,109,0,0,
+1.1000,off,110,0,0,
+1.1100,off,111,0,0,
+1.1200,off,112,0,0,
+1.1300,off,113,0,0,
+1.1400,off,114,0,0,
+1.1500,off,115,0,0,
+1.1600,off,116,0,0,
+1.1700,off,117,0,0,
+1.1800,off,118,0,0,
+1.1900,off,119,0,0,
+1.2000,off,120,0,0,
+1.2100,off,121,0,0,
+1.2200,off,122,0,0,
+1.2300,off,123,0,0,
+1.2400,off,124,0,0,
+1.2500,off,125,0,0,
+1.2600,off,126,0,0,
+1.2700,off,127,0,0,
diff --git a/data/dot/euler-j5-a.dot b/data/dot/euler-j5-a.dot
deleted file mode 100644
--- a/data/dot/euler-j5-a.dot
+++ /dev/null
@@ -1,30 +0,0 @@
-graph g {
-graph [layout="dot",rankdir="TB",nodesep=0.5];
-edge [fontsize="8",fontname="century schoolbook"];
-node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
-R_5_3 [label="A♮\n5:3"];
-R_5_4 [label="E♮\n5:4"];
-R_15_8 [label="B♮\n15:8"];
-R_16_9 [label="B♭\n16:9"];
-R_4_3 [label="F♮\n4:3"];
-R_1_1 [label="C♮\n1:1"];
-R_3_2 [label="G♮\n3:2"];
-R_9_8 [label="D♮\n9:8"];
-R_64_45 [label="F♯\n64:45"];
-R_16_15 [label="C♯\n16:15"];
-R_8_5 [label="A♭\n8:5"];
-R_6_5 [label="E♭\n6:5"];
-R_5_3 -- R_5_4 -- R_15_8;
-R_16_9 -- R_4_3 -- R_1_1 -- R_3_2 -- R_9_8;
-R_64_45 -- R_16_15 -- R_8_5 -- R_6_5;
-R_4_3 -- R_5_3 [label="   (8:5)"];
-R_1_1 -- R_5_4 [label="   (8:5)"];
-R_3_2 -- R_15_8 [label="   (8:5)"];
-R_64_45 -- R_16_9 [label="   (8:5)"];
-R_16_15 -- R_4_3 [label="   (8:5)"];
-R_8_5 -- R_1_1 [label="   (8:5)"];
-R_6_5 -- R_3_2 [label="   (8:5)"];
-{rank=min; R_5_3 R_5_4 R_15_8}
-{rank=same; R_16_9 R_4_3 R_1_1 R_3_2 R_9_8}
-{rank=max; R_64_45 R_16_15 R_8_5 R_6_5}
-}
diff --git a/data/dot/euler-j5-b.dot b/data/dot/euler-j5-b.dot
deleted file mode 100644
--- a/data/dot/euler-j5-b.dot
+++ /dev/null
@@ -1,30 +0,0 @@
-graph g {
-graph [layout="dot",rankdir="TB",nodesep=0.5];
-edge [fontsize="8",fontname="century schoolbook"];
-node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
-R_5_3 [label="A♮\n5:3"];
-R_5_4 [label="E♮\n5:4"];
-R_15_8 [label="B♮\n15:8"];
-R_45_32 [label="F♯\n45:32"];
-R_16_9 [label="B♭\n16:9"];
-R_4_3 [label="F♮\n4:3"];
-R_1_1 [label="C♮\n1:1"];
-R_3_2 [label="G♮\n3:2"];
-R_9_8 [label="D♮\n9:8"];
-R_16_15 [label="C♯\n16:15"];
-R_8_5 [label="A♭\n8:5"];
-R_6_5 [label="E♭\n6:5"];
-R_5_3 -- R_5_4 -- R_15_8 -- R_45_32;
-R_16_9 -- R_4_3 -- R_1_1 -- R_3_2 -- R_9_8;
-R_16_15 -- R_8_5 -- R_6_5;
-R_4_3 -- R_5_3 [label="   (8:5)"];
-R_1_1 -- R_5_4 [label="   (8:5)"];
-R_3_2 -- R_15_8 [label="   (8:5)"];
-R_9_8 -- R_45_32 [label="   (8:5)"];
-R_16_15 -- R_4_3 [label="   (8:5)"];
-R_8_5 -- R_1_1 [label="   (8:5)"];
-R_6_5 -- R_3_2 [label="   (8:5)"];
-{rank=min; R_5_3 R_5_4 R_15_8 R_45_32}
-{rank=same; R_16_9 R_4_3 R_1_1 R_3_2 R_9_8}
-{rank=max; R_16_15 R_8_5 R_6_5}
-}
diff --git a/data/dot/euler-j7.dot b/data/dot/euler-j7.dot
deleted file mode 100644
--- a/data/dot/euler-j7.dot
+++ /dev/null
@@ -1,29 +0,0 @@
-graph g {
-graph [layout="dot",rankdir="TB",nodesep=0.5];
-edge [fontsize="8",fontname="century schoolbook"];
-node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
-R_5_4 [label="E♮\n5:4"];
-R_15_8 [label="B♮\n15:8"];
-R_45_32 [label="F♯\n45:32"];
-R_135_128 [label="C♯\n135:128"];
-R_4_3 [label="F♮\n4:3"];
-R_1_1 [label="C♮\n1:1"];
-R_3_2 [label="G♮\n3:2"];
-R_9_8 [label="D♮\n9:8"];
-R_27_16 [label="A♮\n27:16"];
-R_14_9 [label="A♭\n14:9"];
-R_7_6 [label="E♭\n7:6"];
-R_7_4 [label="B♭\n7:4"];
-R_5_4 -- R_15_8 -- R_45_32 -- R_135_128;
-R_4_3 -- R_1_1 -- R_3_2 -- R_9_8 -- R_27_16;
-R_14_9 -- R_7_6 -- R_7_4;
-R_1_1 -- R_5_4 [label="   (8:5)"];
-R_3_2 -- R_15_8 [label="   (8:5)"];
-R_9_8 -- R_45_32 [label="   (8:5)"];
-R_27_16 -- R_135_128 [label="   (8:5)"];
-R_7_6 -- R_4_3 [label="   (7:4)"];
-R_7_4 -- R_1_1 [label="   (7:4)"];
-{rank=min; R_5_4 R_15_8 R_45_32 R_135_128}
-{rank=same; R_4_3 R_1_1 R_3_2 R_9_8 R_27_16}
-{rank=max; R_14_9 R_7_6 R_7_4}
-}
diff --git a/data/dot/euler-wtp.dot b/data/dot/euler-wtp.dot
deleted file mode 100644
--- a/data/dot/euler-wtp.dot
+++ /dev/null
@@ -1,30 +0,0 @@
-graph g {
-graph [layout="dot",rankdir="TB",nodesep=0.5];
-edge [fontsize="8",fontname="century schoolbook"];
-node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
-R_49_32 [label="B♭=738\n49:32"];
-R_147_128 [label="F♮=240\n147:128"];
-R_441_256 [label="C♮=942\n441:256"];
-R_1323_1024 [label="G♮=444\n1323:1024"];
-R_7_4 [label="C♯=969\n7:4"];
-R_21_16 [label="A♭=471\n21:16"];
-R_63_32 [label="E♭=1173\n63:32"];
-R_189_128 [label="B♭=675\n189:128"];
-R_567_512 [label="F♮=177\n567:512"];
-R_1_1 [label="E♭=0\n1:1"];
-R_3_2 [label="B♭=702\n3:2"];
-R_9_8 [label="F♮=204\n9:8"];
-R_49_32 -- R_147_128 -- R_441_256 -- R_1323_1024;
-R_7_4 -- R_21_16 -- R_63_32 -- R_189_128 -- R_567_512;
-R_1_1 -- R_3_2 -- R_9_8;
-R_7_4 -- R_49_32 [label="   (8:7)"];
-R_21_16 -- R_147_128 [label="   (8:7)"];
-R_63_32 -- R_441_256 [label="   (8:7)"];
-R_189_128 -- R_1323_1024 [label="   (8:7)"];
-R_1_1 -- R_7_4 [label="   (8:7)"];
-R_3_2 -- R_21_16 [label="   (8:7)"];
-R_9_8 -- R_63_32 [label="   (8:7)"];
-{rank=min; R_49_32 R_147_128 R_441_256 R_1323_1024}
-{rank=same; R_7_4 R_21_16 R_63_32 R_189_128 R_567_512}
-{rank=max; R_1_1 R_3_2 R_9_8}
-}
diff --git a/data/dot/euler/euler-j5-a.dot b/data/dot/euler/euler-j5-a.dot
new file mode 100644
--- /dev/null
+++ b/data/dot/euler/euler-j5-a.dot
@@ -0,0 +1,30 @@
+graph g {
+graph [layout="dot",rankdir="TB",nodesep=0.5];
+edge [fontsize="8",fontname="century schoolbook"];
+node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
+R_5_3 [label="A♮\n5:3"];
+R_5_4 [label="E♮\n5:4"];
+R_15_8 [label="B♮\n15:8"];
+R_16_9 [label="B♭\n16:9"];
+R_4_3 [label="F♮\n4:3"];
+R_1_1 [label="C♮\n1:1"];
+R_3_2 [label="G♮\n3:2"];
+R_9_8 [label="D♮\n9:8"];
+R_64_45 [label="F♯\n64:45"];
+R_16_15 [label="C♯\n16:15"];
+R_8_5 [label="A♭\n8:5"];
+R_6_5 [label="E♭\n6:5"];
+R_5_3 -- R_5_4 -- R_15_8;
+R_16_9 -- R_4_3 -- R_1_1 -- R_3_2 -- R_9_8;
+R_64_45 -- R_16_15 -- R_8_5 -- R_6_5;
+R_4_3 -- R_5_3 [label="   (8:5)"];
+R_1_1 -- R_5_4 [label="   (8:5)"];
+R_3_2 -- R_15_8 [label="   (8:5)"];
+R_64_45 -- R_16_9 [label="   (8:5)"];
+R_16_15 -- R_4_3 [label="   (8:5)"];
+R_8_5 -- R_1_1 [label="   (8:5)"];
+R_6_5 -- R_3_2 [label="   (8:5)"];
+{rank=min; R_5_3 R_5_4 R_15_8}
+{rank=same; R_16_9 R_4_3 R_1_1 R_3_2 R_9_8}
+{rank=max; R_64_45 R_16_15 R_8_5 R_6_5}
+}
diff --git a/data/dot/euler/euler-j5-b.dot b/data/dot/euler/euler-j5-b.dot
new file mode 100644
--- /dev/null
+++ b/data/dot/euler/euler-j5-b.dot
@@ -0,0 +1,30 @@
+graph g {
+graph [layout="dot",rankdir="TB",nodesep=0.5];
+edge [fontsize="8",fontname="century schoolbook"];
+node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
+R_5_3 [label="A♮\n5:3"];
+R_5_4 [label="E♮\n5:4"];
+R_15_8 [label="B♮\n15:8"];
+R_45_32 [label="F♯\n45:32"];
+R_16_9 [label="B♭\n16:9"];
+R_4_3 [label="F♮\n4:3"];
+R_1_1 [label="C♮\n1:1"];
+R_3_2 [label="G♮\n3:2"];
+R_9_8 [label="D♮\n9:8"];
+R_16_15 [label="C♯\n16:15"];
+R_8_5 [label="A♭\n8:5"];
+R_6_5 [label="E♭\n6:5"];
+R_5_3 -- R_5_4 -- R_15_8 -- R_45_32;
+R_16_9 -- R_4_3 -- R_1_1 -- R_3_2 -- R_9_8;
+R_16_15 -- R_8_5 -- R_6_5;
+R_4_3 -- R_5_3 [label="   (8:5)"];
+R_1_1 -- R_5_4 [label="   (8:5)"];
+R_3_2 -- R_15_8 [label="   (8:5)"];
+R_9_8 -- R_45_32 [label="   (8:5)"];
+R_16_15 -- R_4_3 [label="   (8:5)"];
+R_8_5 -- R_1_1 [label="   (8:5)"];
+R_6_5 -- R_3_2 [label="   (8:5)"];
+{rank=min; R_5_3 R_5_4 R_15_8 R_45_32}
+{rank=same; R_16_9 R_4_3 R_1_1 R_3_2 R_9_8}
+{rank=max; R_16_15 R_8_5 R_6_5}
+}
diff --git a/data/dot/euler/euler-j7.dot b/data/dot/euler/euler-j7.dot
new file mode 100644
--- /dev/null
+++ b/data/dot/euler/euler-j7.dot
@@ -0,0 +1,29 @@
+graph g {
+graph [layout="dot",rankdir="TB",nodesep=0.5];
+edge [fontsize="8",fontname="century schoolbook"];
+node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
+R_5_4 [label="E♮\n5:4"];
+R_15_8 [label="B♮\n15:8"];
+R_45_32 [label="F♯\n45:32"];
+R_135_128 [label="C♯\n135:128"];
+R_4_3 [label="F♮\n4:3"];
+R_1_1 [label="C♮\n1:1"];
+R_3_2 [label="G♮\n3:2"];
+R_9_8 [label="D♮\n9:8"];
+R_27_16 [label="A♮\n27:16"];
+R_14_9 [label="A♭\n14:9"];
+R_7_6 [label="E♭\n7:6"];
+R_7_4 [label="B♭\n7:4"];
+R_5_4 -- R_15_8 -- R_45_32 -- R_135_128;
+R_4_3 -- R_1_1 -- R_3_2 -- R_9_8 -- R_27_16;
+R_14_9 -- R_7_6 -- R_7_4;
+R_1_1 -- R_5_4 [label="   (8:5)"];
+R_3_2 -- R_15_8 [label="   (8:5)"];
+R_9_8 -- R_45_32 [label="   (8:5)"];
+R_27_16 -- R_135_128 [label="   (8:5)"];
+R_7_6 -- R_4_3 [label="   (7:4)"];
+R_7_4 -- R_1_1 [label="   (7:4)"];
+{rank=min; R_5_4 R_15_8 R_45_32 R_135_128}
+{rank=same; R_4_3 R_1_1 R_3_2 R_9_8 R_27_16}
+{rank=max; R_14_9 R_7_6 R_7_4}
+}
diff --git a/data/dot/euler/euler-wtp.dot b/data/dot/euler/euler-wtp.dot
new file mode 100644
--- /dev/null
+++ b/data/dot/euler/euler-wtp.dot
@@ -0,0 +1,30 @@
+graph g {
+graph [layout="dot",rankdir="TB",nodesep=0.5];
+edge [fontsize="8",fontname="century schoolbook"];
+node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
+R_49_32 [label="B♭=738\n49:32"];
+R_147_128 [label="F♮=240\n147:128"];
+R_441_256 [label="C♮=942\n441:256"];
+R_1323_1024 [label="G♮=444\n1323:1024"];
+R_7_4 [label="C♯=969\n7:4"];
+R_21_16 [label="A♭=471\n21:16"];
+R_63_32 [label="E♭=1173\n63:32"];
+R_189_128 [label="B♭=675\n189:128"];
+R_567_512 [label="F♮=177\n567:512"];
+R_1_1 [label="E♭=0\n1:1"];
+R_3_2 [label="B♭=702\n3:2"];
+R_9_8 [label="F♮=204\n9:8"];
+R_49_32 -- R_147_128 -- R_441_256 -- R_1323_1024;
+R_7_4 -- R_21_16 -- R_63_32 -- R_189_128 -- R_567_512;
+R_1_1 -- R_3_2 -- R_9_8;
+R_7_4 -- R_49_32 [label="   (8:7)"];
+R_21_16 -- R_147_128 [label="   (8:7)"];
+R_63_32 -- R_441_256 [label="   (8:7)"];
+R_189_128 -- R_1323_1024 [label="   (8:7)"];
+R_1_1 -- R_7_4 [label="   (8:7)"];
+R_3_2 -- R_21_16 [label="   (8:7)"];
+R_9_8 -- R_63_32 [label="   (8:7)"];
+{rank=min; R_49_32 R_147_128 R_441_256 R_1323_1024}
+{rank=same; R_7_4 R_21_16 R_63_32 R_189_128 R_567_512}
+{rank=max; R_1_1 R_3_2 R_9_8}
+}
diff --git a/data/dot/tj_oh_p012.dot b/data/dot/tj_oh_p012.dot
deleted file mode 100644
--- a/data/dot/tj_oh_p012.dot
+++ /dev/null
@@ -1,30 +0,0 @@
-graph g {
-graph [layout="dot",rankdir="TB",nodesep=0.5];
-edge [fontsize="8",fontname="century schoolbook"];
-node [shape="plaintext",fontsize="10",fontname="century schoolbook"];
-R_5_3 [label="A♮=884\n5:3"];
-R_5_4 [label="E♮=386\n5:4"];
-R_15_8 [label="B♮=1088\n15:8"];
-R_45_32 [label="F♯=590\n45:32"];
-R_16_9 [label="B♭=996\n16:9"];
-R_4_3 [label="F♮=498\n4:3"];
-R_1_1 [label="C♮=0\n1:1"];
-R_3_2 [label="G♮=702\n3:2"];
-R_9_8 [label="D♮=204\n9:8"];
-R_16_15 [label="C♯=112\n16:15"];
-R_8_5 [label="A♭=814\n8:5"];
-R_6_5 [label="E♭=316\n6:5"];
-R_5_3 -- R_5_4 -- R_15_8 -- R_45_32;
-R_16_9 -- R_4_3 -- R_1_1 -- R_3_2 -- R_9_8;
-R_16_15 -- R_8_5 -- R_6_5;
-R_4_3 -- R_5_3 [label="   (8:5)"];
-R_1_1 -- R_5_4 [label="   (8:5)"];
-R_3_2 -- R_15_8 [label="   (8:5)"];
-R_9_8 -- R_45_32 [label="   (8:5)"];
-R_16_15 -- R_4_3 [label="   (8:5)"];
-R_8_5 -- R_1_1 [label="   (8:5)"];
-R_6_5 -- R_3_2 [label="   (8:5)"];
-{rank=min; R_5_3 R_5_4 R_15_8 R_45_32}
-{rank=same; R_16_9 R_4_3 R_1_1 R_3_2 R_9_8}
-{rank=max; R_16_15 R_8_5 R_6_5}
-}
diff --git a/data/dot/tj_oh_p014.dot b/data/dot/tj_oh_p014.dot
deleted file mode 100644
--- a/data/dot/tj_oh_p014.dot
+++ /dev/null
@@ -1,58 +0,0 @@
-graph
- g {
-graph [start=168732,layout=neato,epsilon=0.000001];
-node [shape=plaintext,fontsize=10,fontname="century schoolbook"];
-0 [label="C♮"];
-1 [label="c♮"];
-2 [label="C♯"];
-3 [label="c♯"];
-4 [label="D♮"];
-5 [label="d♮"];
-6 [label="E♭"];
-7 [label="e♭"];
-8 [label="E♮"];
-9 [label="e♮"];
-10 [label="F♮"];
-11 [label="f♮"];
-12 [label="F♯"];
-13 [label="f♯"];
-14 [label="G♮"];
-15 [label="g♮"];
-16 [label="A♭"];
-17 [label="a♭"];
-18 [label="A♮"];
-19 [label="a♮"];
-20 [label="B♮"];
-21 [label="b♮"];
-22 [label="b♭"];
-23 [label="B♭"];
-0 -- 1;
-0 -- 9;
-0 -- 19;
-2 -- 3;
-2 -- 11;
-2 -- 22;
-4 -- 5;
-4 -- 21;
-6 -- 1;
-6 -- 7;
-6 -- 15;
-8 -- 3;
-8 -- 9;
-8 -- 17;
-10 -- 11;
-12 -- 13;
-12 -- 22;
-14 -- 9;
-14 -- 15;
-14 -- 21;
-16 -- 11;
-16 -- 17;
-18 -- 3;
-18 -- 13;
-18 -- 19;
-20 -- 17;
-20 -- 21;
-23 -- 5;
-23 -- 15;
-}
diff --git a/data/dot/tj_oh_p031.dot b/data/dot/tj_oh_p031.dot
deleted file mode 100644
--- a/data/dot/tj_oh_p031.dot
+++ /dev/null
@@ -1,53 +0,0 @@
-graph
- g {
-graph [layout=neato,epsilon=0.000001];
-node [shape=plaintext,fontsize=10,fontname="century schoolbook"];
-0 [label="0,2,4,7"];
-1 [label="0,2,7,10"];
-2 [label="0,2,4,9"];
-3 [label="1,3,5,8"];
-4 [label="1,3,8,11"];
-5 [label="1,3,5,10"];
-6 [label="2,4,6,9"];
-7 [label="2,4,6,11"];
-8 [label="0,5,7,9"];
-9 [label="2,5,7,9"];
-10 [label="1,6,8,10"];
-11 [label="3,6,8,10"];
-12 [label="2,7,9,11"];
-13 [label="4,7,9,11"];
-14 [label="0,3,8,10"];
-15 [label="0,5,8,10"];
-16 [label="1,4,9,11"];
-17 [label="1,6,9,11"];
-18 [label="0,2,5,10"];
-19 [label="1,3,6,11"];
-20 [label="3,5,7,10"];
-21 [label="4,6,8,11"];
-22 [label="0,3,5,7"];
-23 [label="1,4,6,8"];
-0 -- 1;
-0 -- 2;
-2 -- 6;
-3 -- 4;
-3 -- 5;
-5 -- 20;
-6 -- 7;
-7 -- 21;
-8 -- 9;
-9 -- 12;
-10 -- 11;
-12 -- 13;
-14 -- 11;
-14 -- 15;
-16 -- 13;
-16 -- 17;
-18 -- 1;
-18 -- 15;
-19 -- 4;
-19 -- 17;
-22 -- 8;
-22 -- 20;
-23 -- 10;
-23 -- 21;
-}
diff --git a/data/dot/tj_oh_p125.dot b/data/dot/tj_oh_p125.dot
deleted file mode 100644
--- a/data/dot/tj_oh_p125.dot
+++ /dev/null
@@ -1,72 +0,0 @@
-graph
- g {
-graph [layout=neato,epsilon=0.000001];
-node [shape=plaintext,fontsize=10,fontname="century schoolbook"];
-0 [label="0,4,11"];
-1 [label="0,5,11"];
-2 [label="1,4,11"];
-3 [label="0,5,10"];
-4 [label="0,6,10"];
-5 [label="1,5,10"];
-6 [label="0,6,9"];
-7 [label="0,7,9"];
-8 [label="1,6,9"];
-9 [label="0,7,8"];
-10 [label="1,7,8"];
-11 [label="1,3,11"];
-12 [label="2,3,11"];
-13 [label="1,4,10"];
-14 [label="2,4,10"];
-15 [label="1,5,9"];
-16 [label="2,5,9"];
-17 [label="1,6,8"];
-18 [label="2,6,8"];
-19 [label="2,3,10"];
-20 [label="2,4,9"];
-21 [label="3,4,9"];
-22 [label="2,5,8"];
-23 [label="3,5,8"];
-24 [label="2,6,7"];
-25 [label="3,6,7"];
-26 [label="3,4,8"];
-27 [label="3,5,7"];
-28 [label="4,5,7"];
-29 [label="4,5,6"];
-0 -- 1;
-0 -- 2;
-3 -- 1;
-3 -- 4;
-3 -- 5;
-6 -- 4;
-6 -- 7;
-6 -- 8;
-9 -- 7;
-9 -- 10;
-11 -- 2;
-11 -- 12;
-13 -- 2;
-13 -- 5;
-13 -- 14;
-15 -- 5;
-15 -- 8;
-15 -- 16;
-17 -- 8;
-17 -- 10;
-17 -- 18;
-19 -- 12;
-19 -- 14;
-20 -- 14;
-20 -- 16;
-20 -- 21;
-22 -- 16;
-22 -- 18;
-22 -- 23;
-24 -- 18;
-24 -- 25;
-26 -- 21;
-26 -- 23;
-27 -- 23;
-27 -- 25;
-27 -- 28;
-29 -- 28;
-}
diff --git a/data/dot/tj_oh_p131.dot b/data/dot/tj_oh_p131.dot
deleted file mode 100644
--- a/data/dot/tj_oh_p131.dot
+++ /dev/null
@@ -1,26 +0,0 @@
-graph
- g {
-graph [layout=neato,epsilon=0.000001];
-node [shape=plaintext,fontsize=10,fontname="century schoolbook"];
-0 [label="6,10,14"];
-1 [label="6,11,13"];
-2 [label="7,9,14"];
-3 [label="7,10,13"];
-4 [label="7,11,12"];
-5 [label="8,9,13"];
-6 [label="8,10,12"];
-7 [label="9,10,11"];
-0 -- 1;
-0 -- 2;
-0 -- 3;
-1 -- 3;
-1 -- 4;
-2 -- 3;
-2 -- 5;
-3 -- 4;
-3 -- 5;
-3 -- 6;
-4 -- 6;
-5 -- 6;
-6 -- 7;
-}
diff --git a/data/dot/tj_oh_p162.dot b/data/dot/tj_oh_p162.dot
deleted file mode 100644
--- a/data/dot/tj_oh_p162.dot
+++ /dev/null
@@ -1,83 +0,0 @@
-graph
- g {
-edge [len=1.75];
-graph [layout=neato,epsilon=0.000001];
-node [shape=plaintext,fontsize=10,fontname="century schoolbook"];
-0 [label="0,1,2,6"];
-1 [label="0,2,5,6"];
-2 [label="1,2,4,6"];
-3 [label="1,2,6,8"];
-4 [label="0,1,3,5"];
-5 [label="0,1,5,7"];
-6 [label="1,3,4,5"];
-7 [label="1,3,5,8"];
-8 [label="0,1,4,8"];
-9 [label="0,4,5,8"];
-10 [label="1,4,5,7"];
-11 [label="1,5,7,8"];
-12 [label="0,2,3,4"];
-13 [label="0,2,3,8"];
-14 [label="0,2,4,7"];
-15 [label="0,3,4,6"];
-16 [label="2,3,4,8"];
-17 [label="0,2,7,8"];
-18 [label="0,3,6,8"];
-19 [label="0,4,6,7"];
-20 [label="2,4,7,8"];
-21 [label="2,4,5,6"];
-22 [label="2,5,6,8"];
-23 [label="0,6,7,8"];
-24 [label="3,4,6,8"];
-25 [label="4,6,7,8"];
-26 [label="1,2,3,7"];
-27 [label="1,3,6,7"];
-28 [label="2,3,5,7"];
-29 [label="3,5,6,7"];
-0 -- 1;
-0 -- 2;
-0 -- 3;
-1 -- 21;
-1 -- 22;
-2 -- 3;
-2 -- 21;
-3 -- 22;
-4 -- 5;
-4 -- 6;
-4 -- 7;
-5 -- 10;
-5 -- 11;
-6 -- 7;
-6 -- 10;
-7 -- 11;
-8 -- 9;
-10 -- 11;
-12 -- 13;
-12 -- 14;
-12 -- 15;
-12 -- 16;
-13 -- 16;
-13 -- 17;
-13 -- 18;
-14 -- 17;
-14 -- 19;
-14 -- 20;
-15 -- 18;
-15 -- 19;
-15 -- 24;
-16 -- 20;
-16 -- 24;
-17 -- 20;
-17 -- 23;
-18 -- 23;
-18 -- 24;
-19 -- 23;
-19 -- 25;
-20 -- 25;
-21 -- 22;
-23 -- 25;
-24 -- 25;
-26 -- 27;
-26 -- 28;
-27 -- 29;
-28 -- 29;
-}
diff --git a/data/scl/dr_itb_etude_1.scl b/data/scl/dr_itb_etude_1.scl
deleted file mode 100644
--- a/data/scl/dr_itb_etude_1.scl
+++ /dev/null
@@ -1,41 +0,0 @@
-! dr_itb_etude_1.scl
-!
-...
-36
-!
-1/1
-1/1
-1/1
-1/1
-4/3
-16/11
-16/11
-8/5
-8/5
-16/9
-16/9
-2/1
-2/1
-16/7
-16/7
-16/7
-8/3
-8/3
-3/1
-16/5
-16/5
-32/9
-32/9
-4/1
-4/1
-9/2
-9/2
-5/1
-16/3
-11/2
-6/1
-32/5
-32/5
-7/1
-7/1
-8/1
diff --git a/data/scl/ew_1357_3.scl b/data/scl/ew_1357_3.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_1357_3.scl
@@ -0,0 +1,28 @@
+! ew_1357_3.scl
+!
+EW, 1-3-5-7-9Genus.pdf, P.3
+23
+!
+81/80
+21/20
+35/32
+9/8
+7/6
+189/160
+5/4
+81/64
+21/16
+27/20
+45/32
+35/24
+3/2
+243/160
+63/40
+5/3
+27/16
+7/4
+567/320
+15/8
+35/18
+63/32
+2/1
diff --git a/data/scl/ew_Pelogflute_2.scl b/data/scl/ew_Pelogflute_2.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_Pelogflute_2.scl
@@ -0,0 +1,14 @@
+! ew_Pelogflute_2.scl
+!
+EW, Pelogflute.pdf, P.2
+9
+!
+16/15
+64/55
+5/4
+4/3
+16/11
+8/5
+128/75
+20/11
+2/1
diff --git a/data/scl/ew_el12_12.scl b/data/scl/ew_el12_12.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_el12_12.scl
@@ -0,0 +1,17 @@
+! ew_el12_12.scl
+!
+EW, earlylattices12.pdf, P.12
+12
+!
+45/44
+12/11
+7/6
+5/4
+14/11
+15/11
+35/24
+14/9
+35/22
+56/33
+15/8
+2/1
diff --git a/data/scl/ew_el12_7.scl b/data/scl/ew_el12_7.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_el12_7.scl
@@ -0,0 +1,17 @@
+! ew_el12_7.scl
+!
+EW, earlylattices12.pdf, P.7
+12
+!
+80/77
+8/7
+77/64
+847/640
+11/8
+10/7
+16/11
+847/512
+128/77
+121/64
+77/40
+2/1
diff --git a/data/scl/ew_hel_12.scl b/data/scl/ew_hel_12.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_hel_12.scl
@@ -0,0 +1,27 @@
+! ew_hel_12.scl
+!
+EW, hel.pdf, P.12
+22
+!
+135/128
+13/12
+10/9
+9/8
+7/6
+11/9
+5/4
+81/64
+4/3
+11/8
+45/32
+17/12
+3/2
+405/256
+13/8
+5/3
+27/16
+7/4
+11/6
+15/8
+23/12
+2/1
diff --git a/data/scl/ew_novarotreediamond_1.scl b/data/scl/ew_novarotreediamond_1.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_novarotreediamond_1.scl
@@ -0,0 +1,28 @@
+! ew_novarotreediamond_1.scl
+!
+EW, novavotreediamond.pdf, P.1
+23
+!
+21/20
+16/15
+10/9
+9/8
+8/7
+7/6
+6/5
+5/4
+21/16
+4/3
+7/5
+10/7
+3/2
+32/21
+8/5
+5/3
+12/7
+7/4
+16/9
+9/5
+15/8
+40/21
+2/1
diff --git a/data/scl/ew_poole.scl b/data/scl/ew_poole.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_poole.scl
@@ -0,0 +1,27 @@
+! ew_poole.scl
+!
+EW, 2010/10/scale-for-rod-poole.html
+22
+!
+33/32
+21/20
+13/12
+9/8
+7/6
+11/9
+5/4
+14/11
+4/3
+11/8
+7/5
+13/9
+3/2
+14/9
+44/27
+5/3
+27/16
+7/4
+11/6
+15/8
+21/11
+2/1
diff --git a/data/scl/ew_two_22_7.scl b/data/scl/ew_two_22_7.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_two_22_7.scl
@@ -0,0 +1,27 @@
+! ew_two_22_7.scl
+!
+EW, 2018/03/an-unusual-22-tone-7-limit-tuning.html
+22
+!
+36/35
+16/15
+35/32
+9/8
+7/6
+6/5
+315/256
+245/192
+21/16
+27/20
+7/5
+735/512
+189/128
+49/32
+63/40
+5/3
+12/7
+16/9
+64/35
+15/8
+35/18
+2/1
diff --git a/data/scl/ew_xen3b_3.scl b/data/scl/ew_xen3b_3.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_xen3b_3.scl
@@ -0,0 +1,22 @@
+! ew_xen3b_3.scl
+!
+EW, xen3b.pdf, P.3
+17
+!
+256/243
+12/11
+9/8
+32/27
+5/4
+81/64
+4/3
+1024/729
+16/11
+3/2
+128/81
+5/3
+27/16
+16/9
+15/8
+243/128
+2/1
diff --git a/data/scl/ew_xen456_9.scl b/data/scl/ew_xen456_9.scl
new file mode 100644
--- /dev/null
+++ b/data/scl/ew_xen456_9.scl
@@ -0,0 +1,24 @@
+! ew_xen456_9.scl
+!
+EW, xen456.pdf, P.9
+19
+!
+45/44
+16/15
+12/11
+8/7
+32/27
+40/33
+14/11
+4/3
+15/11
+64/45
+16/11
+32/21
+8/5
+18/11
+12/7
+16/9
+20/11
+21/11
+2/1
diff --git a/data/scl/hs17.scl b/data/scl/hs17.scl
deleted file mode 100644
--- a/data/scl/hs17.scl
+++ /dev/null
@@ -1,22 +0,0 @@
-! hs17.scl
-!
-17 tone harmonic series
-17
-!
-2/1
-3/1
-4/1
-5/1
-6/1
-7/1
-8/1
-9/1
-10/1
-11/1
-12/1
-13/1
-14/1
-15/1
-16/1
-17/1
-2/1
diff --git a/data/scl/hs19.scl b/data/scl/hs19.scl
deleted file mode 100644
--- a/data/scl/hs19.scl
+++ /dev/null
@@ -1,24 +0,0 @@
-! hs19.scl
-!
-19 tone harmonic series
-19
-!
-2/1
-3/1
-4/1
-5/1
-6/1
-7/1
-8/1
-9/1
-10/1
-11/1
-12/1
-13/1
-14/1
-15/1
-16/1
-17/1
-18/1
-19/1
-2/1
diff --git a/data/scl/hs21.scl b/data/scl/hs21.scl
deleted file mode 100644
--- a/data/scl/hs21.scl
+++ /dev/null
@@ -1,26 +0,0 @@
-! hs21.scl
-!
-21 tone harmonic series
-21
-!
-2/1
-3/1
-4/1
-5/1
-6/1
-7/1
-8/1
-9/1
-10/1
-11/1
-12/1
-13/1
-14/1
-15/1
-16/1
-17/1
-18/1
-19/1
-20/1
-21/1
-2/1
diff --git a/data/scl/hs23.scl b/data/scl/hs23.scl
deleted file mode 100644
--- a/data/scl/hs23.scl
+++ /dev/null
@@ -1,28 +0,0 @@
-! hs23.scl
-!
-23 tone harmonic series
-23
-!
-2/1
-3/1
-4/1
-5/1
-6/1
-7/1
-8/1
-9/1
-10/1
-11/1
-12/1
-13/1
-14/1
-15/1
-16/1
-17/1
-18/1
-19/1
-20/1
-21/1
-22/1
-23/1
-2/1
diff --git a/hmt.cabal b/hmt.cabal
--- a/hmt.cabal
+++ b/hmt.cabal
@@ -1,82 +1,78 @@
+cabal-version:     2.4
 Name:              hmt
-Version:           0.16
+Version:           0.20
 Synopsis:          Haskell Music Theory
-Description:       Haskell music theory library
-License:           GPL
+Description:       Haskell library for Music Theory
+License:           GPL-3.0-only
 Category:          Music
-Copyright:         Rohan Drape, 2006-2017
+Copyright:         Rohan Drape, 2006-2022
 Author:            Rohan Drape
-Maintainer:        rd@slavepianos.org
+Maintainer:        rd@rohandrape.net
 Stability:         Experimental
-Homepage:          http://rd.slavepianos.org/t/hmt
-Tested-With:       GHC == 8.0.1
+Homepage:          http://rohandrape.net/t/hmt
+Tested-With:       GHC == 9.2.4
 Build-Type:        Simple
-Cabal-Version:     >= 1.8
 
-Data-files:        README
+Data-files:        README.md
                    data/csv/mnd/*.csv
-                   data/dot/*.dot
+                   data/dot/euler/*.dot
                    data/scl/*.scl
 
 Library
-  Build-Depends:   aeson,
-                   array,
-                   base >= 4.8 && < 5,
+  Build-Depends:   array,
+                   base >= 4.9 && < 5,
                    bytestring,
                    colour,
                    containers,
+                   data-memocombinators,
                    data-ordlist,
                    directory,
                    fgl,
                    filepath,
+                   hmt-base == 0.20.*,
                    lazy-csv,
                    logict,
-                   modular-arithmetic,
                    multiset-comb,
                    parsec,
-                   permutation,
                    primes,
+                   process,
                    random,
                    safe,
                    split,
-                   text
+                   strict,
+                   text,
+                   time
+  Default-Language:Haskell2010
   GHC-Options:     -Wall -fwarn-tabs
-  Exposed-modules: Music.Theory.Array
-                   Music.Theory.Array.Cell_Ref
-                   Music.Theory.Array.CSV
-                   Music.Theory.Array.CSV.Midi.MND
+  Exposed-modules: Music.Theory.Array.Csv.Midi.Cli
+                   Music.Theory.Array.Csv.Midi.Mnd
+                   Music.Theory.Array.Csv.Midi.Skini
                    Music.Theory.Array.Direction
-                   Music.Theory.Array.MD
-                   Music.Theory.Bits
+                   Music.Theory.Array.Square
                    Music.Theory.Bjorklund
                    Music.Theory.Block_Design.Johnson_2007
                    Music.Theory.Braille
-                   Music.Theory.Byte
                    Music.Theory.Clef
-                   Music.Theory.Combinations
                    Music.Theory.Contour.Polansky_1992
-                   Music.Theory.DB.Common
-                   Music.Theory.DB.CSV
-                   Music.Theory.DB.JSON
-                   Music.Theory.DB.Plain
-                   Music.Theory.Directory
+                   Music.Theory.Db.Cli
+                   Music.Theory.Db.Common
+                   Music.Theory.Db.Csv
+                   Music.Theory.Db.Plain
                    Music.Theory.Duration
                    Music.Theory.Duration.Annotation
-                   Music.Theory.Duration.CT
+                   Music.Theory.Duration.ClickTrack
+                   Music.Theory.Duration.Hollos2014
                    Music.Theory.Duration.Name
                    Music.Theory.Duration.Name.Abbreviation
-                   Music.Theory.Duration.RQ
-                   Music.Theory.Duration.RQ.Division
-                   Music.Theory.Duration.RQ.Tied
+                   Music.Theory.Duration.Rq
+                   Music.Theory.Duration.Rq.Division
+                   Music.Theory.Duration.Rq.Tied
                    Music.Theory.Duration.Sequence.Notate
                    Music.Theory.Dynamic_Mark
-                   Music.Theory.Either
-                   Music.Theory.Enum
-                   Music.Theory.Function
                    Music.Theory.Gamelan
                    Music.Theory.Graph.Deacon_1934
                    Music.Theory.Graph.Dot
-                   Music.Theory.Graph.FGL
+                   Music.Theory.Graph.Fgl
                    Music.Theory.Graph.Johnson_2014
                    Music.Theory.Instrument.Choir
                    Music.Theory.Instrument.Names
@@ -84,25 +80,21 @@
                    Music.Theory.Interval.Barlow_1987
                    Music.Theory.Interval.Name
                    Music.Theory.Interval.Spelling
-                   Music.Theory.IO
                    Music.Theory.Key
-                   Music.Theory.List
-                   Music.Theory.Map
-                   Music.Theory.Math
-                   Music.Theory.Math.Convert
-                   Music.Theory.Math.OEIS
-                   Music.Theory.Maybe
+                   Music.Theory.List.Logic
+                   Music.Theory.Math.Convert.Fx
+                   Music.Theory.Math.Nichomachus
+                   Music.Theory.Math.Oeis
+                   Music.Theory.Math.Prime
                    Music.Theory.Meter.Barlow_1987
                    Music.Theory.Metric.Buchler_1998
                    Music.Theory.Metric.Morris_1980
                    Music.Theory.Metric.Polansky_1996
-                   Music.Theory.Monad
-                   Music.Theory.Ord
                    Music.Theory.Parse
-                   Music.Theory.Permutations
                    Music.Theory.Permutations.List
                    Music.Theory.Permutations.Morris_1984
                    Music.Theory.Pitch
+                   Music.Theory.Pitch.Bark
                    Music.Theory.Pitch.Chord
                    Music.Theory.Pitch.Name
                    Music.Theory.Pitch.Note
@@ -112,70 +104,74 @@
                    Music.Theory.Pitch.Spelling.Key
                    Music.Theory.Pitch.Spelling.Table
                    Music.Theory.Random.I_Ching
-                   Music.Theory.Read
+                   Music.Theory.Random.Jones_1981
                    Music.Theory.Set.List
                    Music.Theory.Set.Set
-                   Music.Theory.Show
-                   Music.Theory.String
                    Music.Theory.Tempo_Marking
                    Music.Theory.Tiling.Canon
                    Music.Theory.Tiling.Johnson_2004
                    Music.Theory.Tiling.Johnson_2009
                    Music.Theory.Time.Bel1990.R
-                   Music.Theory.Time.Duration
-                   Music.Theory.Time.Notation
+                   Music.Theory.Time.KeyKit
+                   Music.Theory.Time.KeyKit.Basic
+                   Music.Theory.Time.KeyKit.Parser
                    Music.Theory.Time.Seq
                    Music.Theory.Time_Signature
-                   Music.Theory.Tuple
                    Music.Theory.Tuning
                    Music.Theory.Tuning.Alves_1997
-                   Music.Theory.Tuning.DB
-                   Music.Theory.Tuning.DB.Alves
-                   Music.Theory.Tuning.DB.Gann
-                   Music.Theory.Tuning.DB.Microtonal_Synthesis
-                   Music.Theory.Tuning.DB.Riley
-                   Music.Theory.Tuning.DB.Werckmeister
-                   Music.Theory.Tuning.ET
-                   Music.Theory.Tuning.Euler
+                   Music.Theory.Tuning.Anamark
+                   Music.Theory.Tuning.Db
+                   Music.Theory.Tuning.Db.Alves
+                   Music.Theory.Tuning.Db.Gann
+                   Music.Theory.Tuning.Db.Microtonal_Synthesis
+                   Music.Theory.Tuning.Db.Riley
+                   Music.Theory.Tuning.Db.Werckmeister
+                   Music.Theory.Tuning.Efg
+                   Music.Theory.Tuning.Et
                    Music.Theory.Tuning.Gann_1993
+                   Music.Theory.Tuning.Graph.Euler
+                   Music.Theory.Tuning.Graph.Iset
+                   Music.Theory.Tuning.Hs
                    Music.Theory.Tuning.Load
                    Music.Theory.Tuning.Meyer_1929
+                   Music.Theory.Tuning.Midi
+                   Music.Theory.Tuning.Partch
                    Music.Theory.Tuning.Polansky_1978
                    Music.Theory.Tuning.Polansky_1984
                    Music.Theory.Tuning.Polansky_1985c
                    Music.Theory.Tuning.Polansky_1990
                    Music.Theory.Tuning.Rosenboom_1979
                    Music.Theory.Tuning.Scala
+                   Music.Theory.Tuning.Scala.Cli
+                   Music.Theory.Tuning.Scala.Functions
                    Music.Theory.Tuning.Scala.Interval
+                   Music.Theory.Tuning.Scala.Kbm
+                   Music.Theory.Tuning.Scala.Meta
                    Music.Theory.Tuning.Scala.Mode
                    Music.Theory.Tuning.Sethares_1994
                    Music.Theory.Tuning.Syntonic
-                   Music.Theory.Unicode
+                   Music.Theory.Tuning.Type
+                   Music.Theory.Tuning.Wilson
                    Music.Theory.Wyschnegradsky
                    Music.Theory.Xenakis.S4
                    Music.Theory.Xenakis.Sieve
                    Music.Theory.Z
                    Music.Theory.Z.Boros_1990
+                   Music.Theory.Z.Castren_1994
                    Music.Theory.Z.Clough_1979
                    Music.Theory.Z.Drape_1999
+                   Music.Theory.Z.Drape_1999.Cli
                    Music.Theory.Z.Forte_1973
+                   Music.Theory.Z.Lewin_1980
+                   Music.Theory.Z.Literature
+                   Music.Theory.Z.Morris_1974
+                   Music.Theory.Z.Morris_1987
+                   Music.Theory.Z.Morris_1987.Parse
+                   Music.Theory.Z.Rahn_1980
                    Music.Theory.Z.Read_1978
-                   Music.Theory.Z.TTO
-                   Music.Theory.Z.SRO
-                   Music.Theory.Z12
-                   Music.Theory.Z12.Castren_1994
-                   Music.Theory.Z12.Drape_1999
-                   Music.Theory.Z12.Forte_1973
-                   Music.Theory.Z12.Lewin_1980
-                   Music.Theory.Z12.Literature
-                   Music.Theory.Z12.Morris_1974
-                   Music.Theory.Z12.Morris_1987
-                   Music.Theory.Z12.Morris_1987.Parse
-                   Music.Theory.Z12.Rahn_1980
-                   Music.Theory.Z12.Read_1978
-                   Music.Theory.Z12.SRO
-                   Music.Theory.Z12.TTO
+                   Music.Theory.Z.Tto
+                   Music.Theory.Z.Sro
 
 Source-Repository  head
-  Type:            darcs
-  Location:        http://rd.slavepianos.org/sw/hmt
+  Type:            git
+  Location:        https://gitlab.com/rd--/hmt