diff --git a/Music/Theory/Array.hs b/Music/Theory/Array.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array.hs
@@ -0,0 +1,119 @@
+-- | Array & table functions
+module Music.Theory.Array where
+
+import Data.List {- base -}
+import qualified Data.Array as A {- array -}
+
+import qualified Music.Theory.List as T {- hmt-base -}
+
+-- * Association List (List Array)
+
+-- | 'T.minmax' of /k/.
+larray_bounds :: Ord k => [(k,v)] -> (k,k)
+larray_bounds = T.minmax . map fst
+
+-- | 'A.array' of association list.
+larray :: A.Ix k => [(k,v)] -> A.Array k v
+larray a = A.array (larray_bounds a) a
+
+-- * List Table
+
+-- | 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]]
+
+-- | Table row count.
+tbl_rows :: Table t -> Int
+tbl_rows = length
+
+-- | Table column count, assumes table is regular.
+tbl_columns :: Table t -> Int
+tbl_columns tbl =
+  case tbl of
+    [] -> 0
+    r0:_ -> length r0
+
+-- | Determine is table is regular, ie. all rows have the same number of columns.
+--
+-- > tbl_is_regular [[0..3],[4..7],[8..11]] == True
+tbl_is_regular :: Table t -> Bool
+tbl_is_regular = (== 1) . length . nub . map length
+
+-- | Map /f/ at table, padding short rows with /k/.
+tbl_make_regular :: (t -> u,u) -> Table t -> Table u
+tbl_make_regular (f,k) tbl =
+    let z = maximum (map length tbl)
+    in map (T.pad_right k z . map f) tbl
+
+-- | Append a sequence of /nil/ (or default) values to each row of /tbl/
+-- so to make it regular (ie. all rows of equal length).
+tbl_make_regular_nil :: t -> Table t -> Table t
+tbl_make_regular_nil k = tbl_make_regular (id,k)
+
+-- * 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_at 3 1 == [(0,1),(1,1),(2,1)]
+column_indices_at :: (Enum t, Num t) => t -> t -> [Ix t]
+column_indices_at 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/Cell_Ref.hs b/Music/Theory/Array/Cell_Ref.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Cell_Ref.hs
@@ -0,0 +1,233 @@
+-- | Cell references & indexing.
+module Music.Theory.Array.Cell_Ref where
+
+import Data.Char {- base -}
+import Data.Function {- base -}
+import Data.Maybe {- base -}
+
+import qualified Data.Array as A {- array -}
+
+-- | @A@ indexed case-insensitive column references.  The column following @Z@ is @AA@.
+newtype Column_Ref = Column_Ref {column_ref_string :: String}
+
+{-
+--import Data.String {- base -}
+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"]
+-- > 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
+
+-- | 'isJust' of 'parse_cell_ref'.
+is_cell_ref :: String -> Bool
+is_cell_ref = isJust . parse_cell_ref
+
+-- | 'fromJust' of '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 ((Column_Ref "AA",1),(Column_Ref "ZZ",999)) (Column_Ref "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)
+
+-- | 'cell_index' of 'parse_cell_ref_err'
+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)]
+-- > 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)]
+-- > 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)]
+-- > 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.hs b/Music/Theory/Array/Csv.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Csv.hs
@@ -0,0 +1,235 @@
+-- | Regular matrix array data, Csv, column & row indexing.
+module Music.Theory.Array.Csv where
+
+import Data.List {- base -}
+
+import qualified Data.Array as A {- array -}
+import qualified Safe {- safe -}
+import qualified Text.CSV.Lazy.String as C {- lazy-csv -}
+
+import qualified Music.Theory.Array as T {- hmt-base -}
+import qualified Music.Theory.Array.Cell_Ref as R {- hmt-base -}
+import qualified Music.Theory.Io as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
+
+-- * Field / Quote
+
+-- | Quoting is required is the string has a double-quote, comma newline or carriage-return.
+csv_requires_quote :: String -> Bool
+csv_requires_quote = any (`elem` "\",\n\r")
+
+-- | Quoting places double-quotes at the start and end and escapes double-quotes.
+csv_quote :: String -> String
+csv_quote fld =
+  let esc s =
+        case s of
+          [] -> []
+          '"':s' -> '"' : '"' : esc s'
+          c:s' -> c : esc s'
+  in '"' : esc fld ++ "\""
+
+-- | Quote field if required.
+csv_quote_if_req :: String -> String
+csv_quote_if_req fld = if csv_requires_quote fld then csv_quote fld else fld
+
+-- * 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)
+
+-- | CSV table, ie. a 'Table' with 'Maybe' a header.
+type Csv_Table a = (Maybe [String],T.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 'T.Table' only with 'def_csv_opt'.
+csv_table_read_def :: (String -> a) -> FilePath -> IO (T.Table a)
+csv_table_read_def f = fmap snd . csv_table_read def_csv_opt f
+
+-- | Read plain CSV 'T.Table'.
+csv_table_read_plain :: FilePath -> IO (T.Table String)
+csv_table_read_plain = csv_table_read_def id
+
+-- | 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 -> T.Table String -> T.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 -> T.Table a -> IO ()
+csv_table_write_def f fn tbl = csv_table_write f def_csv_opt fn (Nothing,tbl)
+
+-- | Write plain CSV 'Table'.
+csv_table_write_plain :: FilePath -> T.Table String -> IO ()
+csv_table_write_plain = csv_table_write_def id
+
+-- | @0@-indexed (row,column) cell lookup.
+table_lookup :: T.Table a -> (Int,Int) -> a
+table_lookup t (r,c) = let ix = Safe.atNote "table_lookup" in (t `ix` r) `ix` c
+
+-- | Row data.
+table_row :: T.Table a -> R.Row_Ref -> [a]
+table_row t r = Safe.atNote "table_row" t (R.row_index r)
+
+-- | Column data.
+table_column :: T.Table a -> R.Column_Ref -> [a]
+table_column t c = Safe.atNote "table_column" (transpose t) (R.column_index c)
+
+-- | Lookup value across columns.
+table_column_lookup :: Eq a => T.Table a -> (R.Column_Ref,R.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 :: T.Table a -> R.Cell_Ref -> a
+table_cell t (c,r) =
+    let (r',c') = (R.row_index r,R.column_index c)
+    in table_lookup t (r',c')
+
+-- | @0@-indexed (row,column) cell lookup over column range.
+table_lookup_row_segment :: T.Table a -> (Int,(Int,Int)) -> [a]
+table_lookup_row_segment t (r,(c0,c1)) =
+    let r' = Safe.atNote "table_lookup_row_segment" t r
+    in take (c1 - c0 + 1) (drop c0 r')
+
+-- | Range of cells from row.
+table_row_segment :: T.Table a -> (R.Row_Ref,R.Column_Range) -> [a]
+table_row_segment t (r,c) =
+    let (r',c') = (R.row_index r,R.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 :: T.Table a -> A.Array R.Cell_Ref a
+table_to_array t =
+    let nr = length t
+        nc = length (Safe.atNote "table_to_array" t 0)
+        bnd = (R.cell_ref_minima,(toEnum (nc - 1),nr))
+        asc = zip (R.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 R.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))
+
+csv_write_irregular :: (a -> String) -> Csv_Opt -> FilePath -> Csv_Table a -> IO ()
+csv_write_irregular f opt fn (hdr,tbl) =
+  let tbl' = T.tbl_make_regular_nil "" (map (map f) tbl)
+  in T.write_file_utf8 fn (csv_table_pp id opt (hdr,tbl'))
+
+csv_write_irregular_def :: (a -> String) -> FilePath -> T.Table a -> IO ()
+csv_write_irregular_def f fn tbl = csv_write_irregular f def_csv_opt fn (Nothing,tbl)
+
+-- * Tuples
+
+type P2_Parser t1 t2 = (String -> t1,String -> t2)
+
+csv_table_read_p2 :: P2_Parser t1 t2 -> Csv_Opt -> FilePath -> IO (Maybe (String,String),[(t1,t2)])
+csv_table_read_p2 f opt fn = do
+  (hdr,dat) <- csv_table_read opt id fn
+  return (fmap T.t2_from_list hdr,map (T.p2_from_list f) dat)
+
+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)
+
+csv_table_read_t9 :: (String -> t) -> Csv_Opt -> FilePath -> IO (Maybe [String],[T.T9 t])
+csv_table_read_t9 f opt fn = do
+  (hdr,dat) <- csv_table_read opt id fn
+  return (hdr,map (T.t9_from_list . map f) dat)
+
diff --git a/Music/Theory/Array/Text.hs b/Music/Theory/Array/Text.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Array/Text.hs
@@ -0,0 +1,127 @@
+-- | Regular array data as plain text tables.
+module Music.Theory.Array.Text where
+
+import Data.List {- base -}
+
+import qualified Data.List.Split as Split {- split -}
+
+import qualified Music.Theory.Array 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.String as T {- hmt-base -}
+
+-- | Tabular text.
+type Text_Table = [[String]]
+
+-- | Split table at indicated places.
+--
+-- > let tbl = [["1","2","3","4"],["A","B","E","F"],["C","D","G","H"]]
+-- > table_split [2,2] tbl
+table_split :: [Int] -> Text_Table -> [Text_Table]
+table_split pl dat = transpose (map (Split.splitPlaces pl) dat)
+
+-- | Join tables left to right.
+--
+-- > table_concat [[["1","2"],["A","B"],["C","D"]],[["3","4"],["E","F"],["G","H"]]]
+table_concat :: [Text_Table] -> Text_Table
+table_concat sq = map concat (transpose sq)
+
+-- | Add a row number column at the front of the table.
+--
+-- > table_number_rows 0 tbl
+table_number_rows :: Int -> Text_Table -> Text_Table
+table_number_rows k = zipWith (\i r -> show i : r) [k ..]
+
+{- | (HEADER,PAD-LEFT,EQ-WIDTH,COL-SEP,TBL-DELIM).
+
+Options are:
+ has header
+ pad text with space to left instead of right,
+ make all columns equal width,
+ column separator string,
+ print table delimiters
+-}
+type Text_Table_Opt = (Bool,Bool,Bool,String,Bool)
+
+-- | Options for @plain@ layout.
+table_opt_plain :: Text_Table_Opt
+table_opt_plain = (False,True,False," ",False)
+
+-- | Options for @simple@ layout.
+table_opt_simple :: Text_Table_Opt
+table_opt_simple = (True,True,False," ",True)
+
+-- | Options for @pipe@ layout.
+table_opt_pipe :: Text_Table_Opt
+table_opt_pipe = (True,True,False," | ",False)
+
+-- | Pretty-print table.  Table is in row order.
+--
+-- > let tbl = [["1","2","3","4"],["a","bc","def"],["ghij","klm","no","p"]]
+-- > putStrLn$unlines$"": table_pp (True,True,True," ",True) tbl
+-- > putStrLn$unlines$"": table_pp (False,False,True," ",False) tbl
+table_pp :: Text_Table_Opt -> Text_Table -> [String]
+table_pp (has_hdr,pad_left,eq_width,col_sep,print_eot) dat =
+    let c = transpose (T.tbl_make_regular_nil "" dat)
+        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 = concat . intersperse col_sep
+        m = jn (map (`replicate` '-') n)
+        w = map jn (transpose (zipWith (map . ext) n c))
+        d = map T.delete_trailing_whitespace w
+        pr x = if print_eot then T.bracket (m,m) x else x
+    in case d of
+         [] -> error "table_pp"
+         d0:dr -> if has_hdr then d0 : pr dr else pr d
+
+-- | Variant relying on 'Show' instances.
+--
+-- > table_pp_show table_opt_simple [[1..4],[5..8],[9..12]]
+table_pp_show :: Show t => Text_Table_Opt -> T.Table t -> [String]
+table_pp_show opt = table_pp opt . map (map show)
+
+-- | Variant in column order (ie. 'transpose').
+--
+-- > table_pp_column_order table_opt_simple [["a","bc","def"],["ghij","klm","no"]]
+table_pp_column_order :: Text_Table_Opt -> Text_Table -> [String]
+table_pp_column_order opt = table_pp opt . transpose
+
+{- | 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 = table_matrix h (map (map show) [[1,2,3,4],[2,3,4,1],[3,4,1,2]])
+
+>>> putStrLn $ unlines $ table_pp table_opt_simple t
+- - - - -
+  e f g h
+a 1 2 3 4
+b 2 3 4 1
+c 3 4 1 2
+- - - - -
+
+-}
+table_matrix :: ([String],[String]) -> Text_Table -> Text_Table
+table_matrix (r,c) t = table_concat [[""] : map return r,c : t]
+
+-- | Variant that takes a 'show' function and a /header decoration/ function.
+--
+-- > table_matrix_opt show id ([1,2,3],[4,5,6]) [[7,8,9],[10,11,12],[13,14,15]]
+table_matrix_opt :: (a -> String) -> (String -> String) -> ([a],[a]) -> T.Table a -> Text_Table
+table_matrix_opt show_f hd_f nm t =
+    let nm' = T.bimap1 (map (hd_f . show_f)) nm
+        t' = map (map show_f) t
+    in table_matrix nm' t'
+
+{-
+-- | Two-tuple 'show' variant.
+table_table_p2 :: (Show a,Show b) => Text_Table_Opt -> Maybe [String] -> ([a],[b]) -> [String]
+table_table_p2 opt hdr (p,q) = table_table' opt hdr [map show p,map show q]
+
+-- | Three-tuple 'show' variant.
+table_table_p3 :: (Show a,Show b,Show c) => Text_Table_Opt -> Maybe [String] -> ([a],[b],[c]) -> [String]
+table_table_p3 opt hdr (p,q,r) = table_table' opt hdr [map show p,map show q,map show r]
+
+-}
diff --git a/Music/Theory/Bits.hs b/Music/Theory/Bits.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Bits.hs
@@ -0,0 +1,39 @@
+-- | Bits functions.
+module Music.Theory.Bits where
+
+import Data.Bits {- base -}
+
+-- | 'True' = 1, 'False' = 0
+bit_pp :: Bool -> Char
+bit_pp b = if b then '1' else '0'
+
+-- | 'map' 'bit_pp'
+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 =
+    foldl (\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/Bool.hs b/Music/Theory/Bool.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Bool.hs
@@ -0,0 +1,28 @@
+-- | Boolean functions.
+module Music.Theory.Bool where
+
+import Data.List {- base -}
+
+{- | If-then-else as a function.
+
+> ifThenElse True "true" "false" == "true"
+-}
+ifThenElse :: Bool -> a -> a -> a
+ifThenElse p q r = if p then q else r
+
+{- | Case analysis as a function.
+     Find first key that is True else elseValue.
+
+> caseElse "z" [(True,"x"),(False,"y")] == "x"
+> caseElse "z" [(False,"x"),(False,"y")] == "z"
+-}
+caseElse :: t -> [(Bool, t)] -> t
+caseElse elseValue = maybe elseValue snd . find fst
+
+{- | Case-of analysis as a function.
+     Find first key that compares equal to selectValue else elseValue.
+
+> caseOfElse "z" 'b' [('a',"x"),('b',"y")] == "y"
+-}
+caseOfElse :: Eq k => v -> k -> [(k, v)] -> v
+caseOfElse elseValue selectValue = maybe elseValue snd . find ((== selectValue) . fst)
diff --git a/Music/Theory/Byte.hs b/Music/Theory/Byte.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Byte.hs
@@ -0,0 +1,166 @@
+-- | Byte functions.
+module Music.Theory.Byte where
+
+import Control.Monad.ST {- base -}
+import Data.Char {- base -}
+import Data.Maybe {- base -}
+import Data.Word {- base -}
+import Numeric {- base -}
+
+import Data.Array.ST {- array -}
+import Data.Array.Unsafe {- array -}
+
+import qualified Data.ByteString as B {- bytestring -}
+import qualified Data.List.Split as Split {- split -}
+
+import qualified Music.Theory.Math.Convert as T {- hmt-base -}
+import qualified Music.Theory.Read as T {- hmt-base -}
+
+{-
+import Data.Int {- base -}
+import qualified Data.ByteString.Lazy as L {- bytestring -}
+
+-- * LBS
+
+-- | Section function for 'L.ByteString', ie. from (n,m).
+--
+-- > lbs_slice 4 5 (L.pack [1..10]) == L.pack [5,6,7,8,9]
+lbs_slice :: Int64 -> Int64 -> L.ByteString -> L.ByteString
+lbs_slice n m = L.take m . L.drop n
+
+-- | Variant of slice with start and end indices (zero-indexed).
+--
+-- > lbs_section 4 8 (L.pack [1..]) == L.pack [5,6,7,8,9]
+lbs_section :: Int64 -> Int64 -> L.ByteString -> L.ByteString
+lbs_section l r = L.take (r - l + 1) . L.drop l
+-}
+
+-- * Enumerations & Char
+
+-- | 'toEnum' of 'T.word8_to_int'
+word8_to_enum :: Enum e => Word8 -> e
+word8_to_enum = toEnum . T.word8_to_int
+
+-- | 'T.int_to_word8_maybe' of 'fromEnum'
+enum_to_word8 :: Enum e => e -> Maybe Word8
+enum_to_word8 = T.int_to_word8_maybe . fromEnum
+
+-- | Type-specialised 'word8_to_enum'
+--
+-- > map word8_to_char [60,62] == "<>"
+word8_to_char :: Word8 -> Char
+word8_to_char = word8_to_enum
+
+-- | 'T.int_to_word8' of 'fromEnum'
+char_to_word8 :: Char -> Word8
+char_to_word8 = T.int_to_word8 . fromEnum
+
+-- | 'T.int_to_word8' of 'digitToInt'
+digit_to_word8 :: Char -> Word8
+digit_to_word8 = T.int_to_word8 . digitToInt
+
+-- | 'intToDigit' of 'T.word8_to_int'
+word8_to_digit :: Word8 -> Char
+word8_to_digit = intToDigit . T.word8_to_int
+
+-- * Indexing
+
+-- | 'at' of 'T.word8_to_int'
+word8_at :: [t] -> Word8 -> t
+word8_at l = (!!) l . T.word8_to_int
+
+-- * Text
+
+-- | 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
+
+-- | 'byte_hex_pp_err' either plain (ws = False) or with spaces (ws = True).
+--   Plain is the same format written by xxd -p and read by xxd -r -p.
+--
+-- > byte_seq_hex_pp True [0x0F,0xF0] == "0F F0"
+byte_seq_hex_pp :: (Integral i, Show i) => Bool -> [i] -> String
+byte_seq_hex_pp ws = (if ws then unwords else concat) . map byte_hex_pp_err
+
+-- | Read two character hexadecimal string.
+--
+-- > mapMaybe read_hex_byte (Split.chunksOf 2 "0FF0F") == [0x0F,0xF0]
+read_hex_byte :: (Eq t, Integral t) => String -> Maybe t
+read_hex_byte s =
+    case s of
+      [_,_] -> T.reads_to_read_precise readHex s
+      _ -> Nothing
+
+-- | Erroring variant.
+read_hex_byte_err :: (Eq t, Integral t) => String -> t
+read_hex_byte_err = fromMaybe (error "read_hex_byte") . read_hex_byte
+
+-- | Sequence of 'read_hex_byte_err'
+--
+-- > read_hex_byte_seq "000FF0FF" == [0x00,0x0F,0xF0,0xFF]
+read_hex_byte_seq :: (Eq t, Integral t) => String -> [t]
+read_hex_byte_seq = map read_hex_byte_err . Split.chunksOf 2
+
+-- | Variant that filters white space.
+--
+-- > read_hex_byte_seq_ws "00 0F F0 FF" == [0x00,0x0F,0xF0,0xFF]
+read_hex_byte_seq_ws :: (Eq t, Integral t) => String -> [t]
+read_hex_byte_seq_ws = read_hex_byte_seq . filter (not . isSpace)
+
+-- * IO
+
+-- | 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 binary 'U8' sequence to file.
+store_byte_seq :: Integral i => FilePath -> [i] -> IO ()
+store_byte_seq fn = B.writeFile fn . B.pack . map fromIntegral
+
+-- | Load hexadecimal text 'U8' sequences from file.
+load_hex_byte_seq :: Integral i => FilePath -> IO [[i]]
+load_hex_byte_seq = fmap (map read_hex_byte_seq . lines) . readFile
+
+-- | Store 'U8' sequences as hexadecimal text, one sequence per line.
+store_hex_byte_seq :: (Integral i,Show i) => FilePath -> [[i]] -> IO ()
+store_hex_byte_seq fn = writeFile fn . unlines . map (byte_seq_hex_pp False)
+
+{-
+
+import qualified Data.ByteString.Base64 as Base64 {- base64-bytestring -}
+let fn = "/home/rohan/sw/hsc3-data/data/yamaha/dx7/rom/ROM1A.syx"
+b <- load_byte_seq fn :: IO [Word8]
+let e = B.unpack (Base64.encode (B.pack b))
+let r = B.unpack (Base64.decodeLenient (B.pack e))
+(length b,length e,length r,b == r) == (4104,5472,4104,True)
+map word8_to_char e
+
+-}
+
+-- * Cast
+
+-- > castFloatToWord32 3.141 == 1078527525
+castFloatToWord32 :: Float -> Word32
+castFloatToWord32 d = runST ((flip readArray 0 =<< castSTUArray =<< newArray (0, 0::Int) d) :: ST s Word32)
+
+-- > castWord32ToFloat 1078527525 == 3.141
+castWord32ToFloat :: Word32 -> Float
+castWord32ToFloat d = runST ((flip readArray 0 =<< castSTUArray =<< newArray (0, 0::Int) d) :: ST s Float)
+
+-- > castDoubleToWord64 3.141 == 4614255322014802772
+castDoubleToWord64 :: Double -> Word64
+castDoubleToWord64 d = runST ((flip readArray 0 =<< castSTUArray =<< newArray (0, 0::Int) d) :: ST s Word64)
+
+-- > castWord64ToDouble 4614255322014802772 == 3.141
+castWord64ToDouble :: Word64 -> Double
+castWord64ToDouble d = runST ((flip readArray 0 =<< castSTUArray =<< newArray (0, 0::Int) d) :: ST s Double)
diff --git a/Music/Theory/Combinations.hs b/Music/Theory/Combinations.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Combinations.hs
@@ -0,0 +1,81 @@
+-- | Combination functions.
+module Music.Theory.Combinations where
+
+import Data.List {- base -}
+
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Permutations as T {- hmt-base -}
+
+-- | Number of /k/ element combinations of a set of /n/ elements.
+--
+-- > map (uncurry nk_combinations) [(4,2),(5,3),(6,3),(13,3)] == [6,10,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 3 "xyzw" == ["xyz","xyw","xzw","yzw"]
+combinations :: Int -> [a] -> [[a]]
+combinations k s =
+    case (k,s) of
+      (0,_) -> [[]]
+      (_,[]) -> []
+      (_,e:s') -> map (e :) (combinations (k - 1) s') ++ combinations k s'
+
+-- * Dyck
+
+-- | <http://www.acta.sapientia.ro/acta-info/C1-1/info1-9.pdf> (P.110)
+--
+-- > dyck_words_lex 3 == [[0,0,0,1,1,1],[0,0,1,0,1,1],[0,0,1,1,0,1],[0,1,0,0,1,1],[0,1,0,1,0,1]]
+dyck_words_lex :: (Num t, Ord t) => t -> [[t]]
+dyck_words_lex n =
+  let gen x i n0 n1 =
+        let d0 = gen (x ++ [0]) (i + 1) (n0 + 1) n1
+            d1 = gen (x ++ [1]) (i + 1) n0 (n1 + 1)
+        in if (n0 < n) && (n1 < n) && (n0 > n1)
+        then concat [d0,d1]
+        else if ((n0 < n) && (n1 < n) && (n0 == n1)) || ((n0 < n) && (n1 == n))
+             then d0
+             else if (n0 == n) && (n1 < n)
+                  then d1
+                  else if (n0 == n1) && (n1 == n)
+                       then [x]
+                       else error "?"
+  in gen [0] (1::Int) 1 0
+
+-- | Translate 01 to [].
+--
+-- > unwords (map dyck_word_to_str (dyck_words_lex 3)) == "[[[]]] [[][]] [[]][] [][[]] [][][]"
+dyck_word_to_str :: Integral n => [n] -> [Char]
+dyck_word_to_str = map (\n -> if n == 0 then '[' else if n == 1 then ']' else undefined)
+
+-- | Translate [] to 01
+dyck_word_from_str :: Integral n => [Char] -> [n]
+dyck_word_from_str = map (\x -> if x == '[' then 0 else if x == ']' then 1 else undefined)
+
+-- | Is /x/ a segment of a lattice word.
+is_lattice_segment :: Integral n => [n] -> Bool
+is_lattice_segment x =
+  let h = T.histogram x
+      f (i,j) = case lookup (i + 1) h of
+                  Nothing -> True
+                  Just k -> j >= k
+  in all f h
+
+-- | Is /x/ a lattice word.
+--
+-- is_lattice_word [1,1,1,2,2,1,2,1] == True
+is_lattice_word :: Integral n => [n] -> Bool
+is_lattice_word = all is_lattice_segment . inits
+
+-- | 'is_lattice_word' of 'reverse'.
+is_yamanouchi_word :: Integral n => [n] -> Bool
+is_yamanouchi_word = is_lattice_word . reverse
+
+-- | 'is_lattice_word' of 'dyck_word_from_str'
+--
+-- > is_dyck_word "[][[][[[][]]]]" == True
+is_dyck_word :: String -> Bool
+is_dyck_word = is_lattice_word . (dyck_word_from_str :: String -> [Int])
diff --git a/Music/Theory/Concurrent.hs b/Music/Theory/Concurrent.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Concurrent.hs
@@ -0,0 +1,26 @@
+module Music.Theory.Concurrent where
+
+import Control.Concurrent {- base -}
+
+-- | Pause current thread for the indicated duration (in seconds), see 'pauseThreadLimit'.
+threadDelaySeconds :: RealFrac n => n -> IO ()
+threadDelaySeconds = threadDelay . floor . (*) 1e6
+
+{- | The number of seconds that 'threadDelaySeconds' can wait for.
+Values larger than this require a different thread delay mechanism, see 'threadSleepForSeconds'.
+The value is the number of microseconds in @maxBound::Int@.
+For 64-bit architectures this is not likely to be an issue, however for 32-bit it can be.
+
+> round ((2 ** 31) / (60 * 60) / 1e6) == 1 -- hours
+> round ((2 ** 63) / (60 * 60 * 24 * 365 * 100) / 1e6) == 2925 -- years
+-}
+threadDelaySecondsLimit :: Fractional n => n
+threadDelaySecondsLimit = fromIntegral ((maxBound::Int) - 1) / 1e6
+
+-- | Sleep current thread for the indicated duration (in seconds).
+--   Divides long sleeps into parts smaller than 'threadSleepForSeconds'.
+threadSleepForSeconds :: RealFrac n => n -> IO ()
+threadSleepForSeconds n =
+    if n < threadDelaySecondsLimit
+    then threadDelaySeconds n
+    else threadDelaySeconds (threadDelaySecondsLimit :: Double) >> threadSleepForSeconds (n - threadDelaySecondsLimit)
diff --git a/Music/Theory/Directory.hs b/Music/Theory/Directory.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Directory.hs
@@ -0,0 +1,158 @@
+-- | Directory functions.
+module Music.Theory.Directory where
+
+import Control.Monad {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import qualified System.Environment {- base -}
+
+import qualified Data.List.Split {- split -}
+import System.Directory {- directory -}
+import System.FilePath {- filepath -}
+
+import qualified Music.Theory.Monad {- hmt-base -}
+
+{- | 'takeDirectory' gives different answers depending on whether there is a trailing separator.
+
+> x = ["x/y","x/y/","x","/"]
+> map parent_dir x == ["x","x",".","/"]
+> map takeDirectory x == ["x","x/y",".","/"]
+-}
+parent_dir :: FilePath -> FilePath
+parent_dir = takeDirectory . dropTrailingPathSeparator
+
+-- | Colon separated path list.
+path_split :: String -> [FilePath]
+path_split = Data.List.Split.splitOn ":"
+
+{- | Read environment variable and split path.
+     Error if enviroment variable not set.
+
+> path_from_env "PATH"
+> path_from_env "NONPATH" -- error
+-}
+path_from_env :: String -> IO [FilePath]
+path_from_env k = do
+  p <- System.Environment.lookupEnv k
+  maybe (error ("Environment variable not set: " ++ k)) (return . path_split) p
+
+{- | Expand a path to include all subdirectories recursively.
+
+> p = ["/home/rohan/sw/hmt-base/Music", "/home/rohan/sw/hmt/Music"]
+> r <- path_recursive p
+> length r == 44
+-}
+path_recursive :: [FilePath] -> IO [FilePath]
+path_recursive p = do
+  p' <- mapM dir_subdirs_recursively p
+  return (p ++ concat p')
+
+{- | Scan a list of directories until a file is located, or not.
+Stop once a file is located, do not traverse any sub-directory structure.
+
+> mapM (path_scan ["/sbin","/usr/bin"]) ["fsck","ghc"]
+-}
+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
+
+-- | Erroring variant.
+path_scan_err :: [FilePath] -> FilePath -> IO FilePath
+path_scan_err p x =
+    let err = error (concat ["path_scan: ",show p,": ",x])
+    in fmap (fromMaybe err) (path_scan p x)
+
+{- | Scan a list of directories and return all located files.
+Do not traverse any sub-directory structure.
+Since 1.2.1.0 there is also findFiles.
+
+> let path = ["/home/rohan/sw/hmt-base","/home/rohan/sw/hmt"]
+> path_search path "README.md"
+> findFiles path "README.md"
+-}
+path_search :: [FilePath] -> FilePath -> IO [FilePath]
+path_search p fn = do
+  let fq = map (\dir -> dir </> fn) p
+      chk q = doesFileExist q >>= \x -> return (if x then Just q else Nothing)
+  fmap catMaybes (mapM chk fq)
+
+-- | Get sorted list of files at /dir/ with /ext/, ie. ls dir/*.ext
+--
+-- > dir_list_ext "/home/rohan/rd/j/" ".hs"
+dir_list_ext :: FilePath -> String -> IO [FilePath]
+dir_list_ext dir ext = do
+  l <- listDirectory dir
+  let fn = filter ((==) ext . takeExtension) l
+  return (sort fn)
+
+-- | Post-process 'dir_list_ext' to gives file-names with /dir/ prefix.
+--
+-- > dir_list_ext_path "/home/rohan/rd/j/" ".hs"
+dir_list_ext_path :: FilePath -> String -> IO [FilePath]
+dir_list_ext_path dir ext = fmap (map (dir </>)) (dir_list_ext dir ext)
+
+-- | Subset of files in /dir/ with an extension in /ext/.
+--   Extensions include the leading dot and are case-sensitive.
+--   Results are relative to /dir/.
+dir_subset_rel :: [String] -> FilePath -> IO [FilePath]
+dir_subset_rel ext dir = do
+  let f nm = takeExtension nm `elem` ext
+  c <- getDirectoryContents dir
+  return (sort (filter f c))
+
+-- | Variant of dir_subset_rel where results have dir/ prefix.
+--
+-- > dir_subset [".hs"] "/home/rohan/sw/hmt/cmd"
+dir_subset :: [String] -> FilePath -> IO [FilePath]
+dir_subset ext dir = fmap (map (dir </>)) (dir_subset_rel ext dir)
+
+-- | Subdirectories (relative) of /dir/.
+dir_subdirs_rel :: FilePath -> IO [FilePath]
+dir_subdirs_rel dir =
+  let sel fn = doesDirectoryExist (dir </> fn)
+  in listDirectory dir >>= filterM sel
+
+-- | Subdirectories of /dir/.
+dir_subdirs :: FilePath -> IO [FilePath]
+dir_subdirs dir = fmap (map (dir </>)) (dir_subdirs_rel dir)
+
+{- | Recursive form of 'dir_subdirs'.
+
+> dir_subdirs_recursively "/home/rohan/sw/hmt-base/Music"
+-}
+dir_subdirs_recursively :: FilePath -> IO [FilePath]
+dir_subdirs_recursively dir = do
+  subdirs <- dir_subdirs dir
+  case subdirs of
+    [] -> return []
+    _ -> do
+      subdirs' <- mapM dir_subdirs_recursively subdirs
+      return (subdirs ++ concat subdirs')
+
+-- | 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
+
+-- | If /i/ is an existing file then /j/ else /k/.
+if_file_exists :: (FilePath,IO t,IO t) -> IO t
+if_file_exists (i,j,k) = Music.Theory.Monad.m_if (doesFileExist i,j,k)
+
+-- | 'createDirectoryIfMissing' (including parents) and then 'writeFile'
+writeFile_mkdir :: FilePath -> String -> IO ()
+writeFile_mkdir fn s = do
+  let dir = takeDirectory fn
+  createDirectoryIfMissing True dir
+  writeFile fn s
+
+-- | 'writeFile_mkdir' only if file does not exist.
+writeFile_mkdir_x :: FilePath -> String -> IO ()
+writeFile_mkdir_x fn txt = if_file_exists (fn,return (),writeFile_mkdir fn txt)
diff --git a/Music/Theory/Directory/Find.hs b/Music/Theory/Directory/Find.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Directory/Find.hs
@@ -0,0 +1,73 @@
+-- | Directory functions using 'find' system utility.
+module Music.Theory.Directory.Find where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified System.Process {- process -}
+
+{- | Find files having indicated filename.
+This runs the system utility /find/, so is Unix only.
+
+> dir_find "DX7-ROM1A.syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
+-}
+dir_find :: FilePath -> FilePath -> IO [FilePath]
+dir_find fn dir = fmap lines (System.Process.readProcess "find" [dir,"-name",fn] "")
+
+{- | Require that exactly one file is located, else error.
+
+> dir_find_1 "DX7-ROM1A.syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
+-}
+dir_find_1 :: FilePath -> FilePath -> IO FilePath
+dir_find_1 fn dir = do
+  r <- dir_find fn dir
+  case r of
+    [x] -> return x
+    _ -> error "dir_find_1?"
+
+{- | Recursively find files having case-insensitive filename extension.
+This runs the system utility /find/, so is Unix only.
+
+> dir_find_ext ".syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
+-}
+dir_find_ext :: String -> FilePath -> IO [FilePath]
+dir_find_ext ext dir = fmap lines (System.Process.readProcess "find" [dir,"-iname",'*' : ext] "")
+
+{- | Post-process 'dir_find_ext' to delete starting directory.
+
+> dir_find_ext_rel ".syx" "/home/rohan/sw/hsc3-data/data/yamaha/"
+-}
+dir_find_ext_rel :: String -> FilePath -> IO [FilePath]
+dir_find_ext_rel ext dir =
+  let f = fromMaybe (error "dir_find_ext_rel?") . stripPrefix dir
+  in fmap (map f) (dir_find_ext ext dir)
+
+{- | Scan each directory on path recursively for file.
+Stop once a file is located.
+Runs 'dir_find' so is Unix only.
+
+> path_scan_recursively ["/home/rohan/sw/hmt-base"] "Directory.hs"
+-}
+path_scan_recursively :: [FilePath] -> FilePath -> IO (Maybe FilePath)
+path_scan_recursively p fn =
+  case p of
+    [] -> return Nothing
+    dir:p' -> do
+      r <- dir_find fn dir
+      case r of
+        [] -> path_scan_recursively p' fn
+        x:_ -> return (Just x)
+
+{- | Search each directory on path recursively for file.
+Runs 'dir_find' so is Unix only.
+
+> path_search_recursively ["/home/rohan/sw"] "README.md"
+-}
+path_search_recursively :: [FilePath] -> FilePath -> IO [FilePath]
+path_search_recursively p fn =
+  case p of
+    [] -> return []
+    dir:p' -> do
+      r <- dir_find fn dir
+      r' <- path_search_recursively p' fn
+      return (r ++ r')
diff --git a/Music/Theory/Either.hs b/Music/Theory/Either.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Either.hs
@@ -0,0 +1,61 @@
+-- | Either
+module Music.Theory.Either where
+
+import Data.Maybe {- base -}
+
+-- | Maybe 'Left' of 'Either'.
+from_left :: Either a b -> Maybe a
+from_left e =
+    case e of
+      Left x -> Just x
+      _ -> Nothing
+
+-- | 'fromJust' of 'from_left'
+from_left_err :: Either t e -> t
+from_left_err = fromMaybe (error "from_left_err") . from_left
+
+-- | Maybe 'Right' of 'Either'.
+from_right :: Either x t -> Maybe t
+from_right e =
+    case e of
+      Left _ -> Nothing
+      Right r -> Just r
+
+-- | 'fromJust' of 'from_right'
+from_right_err :: Either e t -> t
+from_right_err = fromMaybe (error "from_right_err") . from_right
+
+-- | Flip from right to left, ie. 'either' 'Right' 'Left'
+either_swap :: Either a b -> Either b a
+either_swap = either Right Left
+
+{- | 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
+
+-- | Lower 'Either' to 'Maybe' by discarding 'Left'.
+either_to_maybe :: Either a b -> Maybe b
+either_to_maybe = either (const Nothing) Just
+
+-- | Data.Either.isLeft, which however hugs doesn't know of.
+is_left :: Either a b -> Bool
+is_left e = case e of { Left  _ -> True; Right _ -> False }
+
+-- | Data.Either.isRight, which however hugs doesn't know of.
+is_right :: Either a b -> Bool
+is_right e = case e of { Left  _ -> False; Right _ -> True }
+
+-- | Data.Either.partitionEithers, which however hugs doesn't know of.
+partition_eithers :: [Either a b] -> ([a],[b])
+partition_eithers =
+  let left  a ~(l, r) = (a:l, r)
+      right a ~(l, r) = (l, a:r)
+  in foldr (either left right) ([],[])
diff --git a/Music/Theory/Enum.hs b/Music/Theory/Enum.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Enum.hs
@@ -0,0 +1,54 @@
+-- | Enumeration functions.
+module Music.Theory.Enum where
+
+import Data.List {- base -}
+
+-- | 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]
+
+-- | List of 'Enum' values not in sorted input list.
+--
+-- > enum_list_gaps "abdh" == "cefg"
+enum_list_gaps :: (Enum t,Eq t) => [t] -> [t]
+enum_list_gaps l =
+  let e0 = head l
+      eN = last l
+      f x = x `notElem` l
+  in filter f [e0 .. eN]
+
+-- | 'enum_list_gaps' of 'sort'
+enum_set_gaps :: (Enum t,Eq t,Ord t) => [t] -> [t]
+enum_set_gaps = enum_list_gaps . sort
diff --git a/Music/Theory/Function.hs b/Music/Theory/Function.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Function.hs
@@ -0,0 +1,109 @@
+-- | "Data.Function" related functions.
+module Music.Theory.Function where
+
+import Data.Bifunctor {- base -}
+import Data.Function {- base -}
+
+-- | Unary operator.
+type UOp t = t -> t
+
+-- | Binary operator.
+type BinOp t = t -> t -> t
+
+-- | Iterate the function /f/ /n/ times, the inital value is /x/.
+--
+-- > 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)
+
+-- | '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, ie. do predicates /f/ and /g/ both hold at /x/.
+predicate_and :: (t -> Bool) -> (t -> Bool) -> t -> Bool
+predicate_and f g x = f x && g x
+
+-- | List variant of 'predicate_and', ie. 'foldr1'
+--
+-- > let r = [False,False,True,False,True,False]
+-- > map (predicate_all [(> 0),(< 5),even]) [0..5] == r
+predicate_all :: [t -> Bool] -> t -> Bool
+predicate_all = foldr1 predicate_and
+--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]
+-- > map (predicate_any [(== 0),(== 5),even]) [0..5] == r
+predicate_any :: [t -> Bool] -> t -> Bool
+predicate_any p x = any ($ x) p
+
+-- | '==' 'on'.
+eq_on :: Eq t => (u -> t) -> u -> u -> Bool
+eq_on f = (==) `on` f
+
+-- * Function composition.
+
+-- | 'fmap' '.' 'fmap', ie. @(t -> c) -> (a -> b -> t) -> a -> b -> c@.
+fmap2 :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
+fmap2 = fmap . fmap
+
+-- | fmap of fmap2, ie. @(t -> d) -> (a -> b -> c -> t) -> a -> b -> c -> d@.
+fmap3 :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
+fmap3 = fmap . fmap2
+
+-- | fmap of fmap3.
+fmap4 :: (Functor f, Functor g, Functor h, Functor i) => (a -> b) -> f (g (h (i a))) -> f (g (h (i b)))
+fmap4 = fmap . fmap3
+
+-- | fmap of fmap4
+fmap5 :: (Functor f, Functor g, Functor h, Functor i, Functor j) => (a -> b) -> f (g (h (i (j a)))) -> f (g (h (i (j b))))
+fmap5 = fmap . fmap4
+
+-- | fmap of fmap5
+fmap6 :: (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)))))
+fmap6 = fmap . fmap5
+
+-- . is infixr 9, this allows f . g .: h
+infixr 8 .:, .::, .:::, .::::, .:::::
+
+-- | Operator name for fmap2.
+(.:) :: (Functor f, Functor g) => (a -> b) -> f (g a) -> f (g b)
+(.:) = fmap2
+
+-- | Operator name for fmap3.
+(.::) :: (Functor f, Functor g, Functor h) => (a -> b) -> f (g (h a)) -> f (g (h b))
+(.::) = fmap3
+
+-- | Operator name for fmap4.
+(.:::) :: (Functor f, Functor g, Functor h,Functor i) => (a -> b) -> f (g (h (i a))) -> f (g (h (i b)))
+(.:::) = fmap4
+
+-- | Operator name for fmap5.
+(.::::) :: (Functor f, Functor g, Functor h,Functor i,Functor j) => (a -> b) -> f (g (h (i (j a)))) -> f (g (h (i (j b))))
+(.::::) = fmap5
+
+-- | Operator name for fmap6.
+(.:::::) :: (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)))))
+(.:::::) = fmap6
+
+-- * Bimap
+
+-- | Apply f to both sides of p, , ie. 'Data.Bifunctor.bimap' /f/ /f/.  This is the generic version of bimap1.
+bimap1f :: Bifunctor p => (a -> b) -> p a a -> p b b
+bimap1f f = bimap f f
+
+-- | Apply /f/ to both elements of a two-tuple.  Type-specialised bimap1f.
+bimap1 :: (t -> u) -> (t,t) -> (u,u)
+bimap1 = bimap1f
diff --git a/Music/Theory/Graph/Bliss.hs b/Music/Theory/Graph/Bliss.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/Bliss.hs
@@ -0,0 +1,47 @@
+-- | <http://www.tcs.hut.fi/Software/bliss/fileformat.shtml>
+module Music.Theory.Graph.Bliss where
+
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+
+-- | Problem is (n-vertices,n-edges)
+bliss_parse_problem :: String -> (Int,Int)
+bliss_parse_problem txt =
+  case words txt of
+    ["p","edge",n,e] -> (read n,read e)
+    _ -> error "bliss_parse_problem"
+
+-- | Vertex colour is (vertex,colour)
+bliss_parse_vertex_colour :: String -> (Int,Int)
+bliss_parse_vertex_colour txt =
+  case words txt of
+    ["n",v,e] -> (read v,read e)
+    _ -> error "bliss_parse_vertex_color"
+
+-- | Edge is (vertex,vertex)
+bliss_parse_edge :: String -> (Int,Int)
+bliss_parse_edge txt =
+  case words txt of
+    ["e",v1,v2] -> (read v1,read v2)
+    _ -> error "bliss_parse_edge"
+
+-- | (problem,vertex-colours,edges)
+--   Bliss data is one-indexed.
+type Bliss = ((Int,Int), [(Int,Int)], [(Int,Int)])
+
+-- | Parse 'Bliss'
+bliss_parse :: String -> Bliss
+bliss_parse txt =
+  let c0_is x = (== x) . head
+      ln = dropWhile (c0_is 'c') (lines txt) -- c = comment
+      ([p],r1) = span (c0_is 'p') ln -- p = problem
+      (n,r2) = span (c0_is 'n') r1 -- n = vertex colour
+      (e,_) = span (c0_is 'e') r2 -- e = edge
+  in (bliss_parse_problem p,map bliss_parse_vertex_colour n,map bliss_parse_edge e)
+
+-- | 'bliss_parse' of 'readFile'
+bliss_load :: FilePath -> IO Bliss
+bliss_load = fmap bliss_parse . readFile
+
+-- | 'Bliss' (one-indexed) to 'T.G' (zero-indexed)
+bliss_to_g :: Bliss -> T.G
+bliss_to_g ((k,_),_,e) = ([0 .. k - 1],map (\(i,j) -> (i - 1,j - 1)) e)
diff --git a/Music/Theory/Graph/G6.hs b/Music/Theory/Graph/G6.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/G6.hs
@@ -0,0 +1,95 @@
+{- | graph6 graph encoding
+
+<http://users.cecs.anu.edu.au/~bdm/nauty/>
+<https://users.cecs.anu.edu.au/~bdm/data/formats.html>
+-}
+module Music.Theory.Graph.G6 where
+
+import Data.Bifunctor {- base -}
+
+import qualified Data.List.Split as Split {- split -}
+import qualified System.Process as Process {- process -}
+
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+
+-- * G6 (graph6)
+
+-- | Load Graph6 file, discard optional header if present.
+g6_load :: FilePath -> IO [String]
+g6_load fn = do
+  s <- readFile fn
+  let s' = if take 6 s == ">>graph6<<" then drop 6 s else s
+  return (lines s')
+
+-- | Load G6 file variant where each line is "Description\tG6"
+g6_dsc_load :: FilePath -> IO [(String,String)]
+g6_dsc_load fn = do
+  s <- readFile fn
+  let r = map (T.split_on_1_err "\t") (lines s)
+  return r
+
+-- | Call nauty-listg to transform a sequence of G6. (debian = nauty)
+g6_to_edg :: [String] -> IO [T.Edg]
+g6_to_edg g6 = do
+  r <- Process.readProcess "nauty-listg" ["-q","-l0","-e"] (unlines g6)
+  return (map T.edg_parse (Split.chunksOf 2 (lines r)))
+
+-- | 'T.edg_to_g' of 'g6_to_edg'
+g6_to_g :: [String] -> IO [T.G]
+g6_to_g = fmap (map T.edg_to_g) . g6_to_edg
+
+-- | 'g6_to_edg' of 'g6_dsc_load'.
+g6_dsc_load_edg :: FilePath -> IO [(String,T.Edg)]
+g6_dsc_load_edg fn = do
+  dat <- g6_dsc_load fn
+  let (dsc,g6) = unzip dat
+  gr <- g6_to_edg g6
+  return (zip dsc gr)
+
+-- | 'T.edg_to_g' of 'g6_dsc_load_edg'
+g6_dsc_load_gr :: FilePath -> IO [(String,T.G)]
+g6_dsc_load_gr = fmap (map (second T.edg_to_g)) . g6_dsc_load_edg
+
+{- | Generate the text format read by nauty-amtog.
+
+> e = ((4,3),[(0,3),(1,3),(2,3)])
+> m = T.edg_to_adj_mtx_undir (0,1) e
+> putStrLn (adj_mtx_to_am m)
+
+-}
+adj_mtx_to_am :: T.Adj_Mtx Int -> String
+adj_mtx_to_am (nv,mtx) =
+  unlines ["n=" ++ show nv
+          ,"m"
+          ,unlines (map (unwords . map show) mtx)]
+
+-- | Call nauty-amtog to transform a sequence of Adj_Mtx to G6.
+--
+-- > adj_mtx_to_g6 [m,m]
+adj_mtx_to_g6 :: [T.Adj_Mtx Int] -> IO [String]
+adj_mtx_to_g6 adj = do
+  r <- Process.readProcess "nauty-amtog" ["-q"] (unlines (map adj_mtx_to_am adj))
+  return (lines r)
+
+-- | 'adj_mtx_to_g6' of 'T.g_to_adj_mtx_undir'
+g_to_g6 :: [T.G] -> IO [String]
+g_to_g6 = adj_mtx_to_g6 . map (T.g_to_adj_mtx_undir (0,1))
+
+-- | 'writeFile' of 'g_to_g6'
+g_store_g6 :: FilePath -> [T.G] -> IO ()
+g_store_g6 fn gr = g_to_g6 gr >>= writeFile fn . unlines
+
+-- | Call nauty-labelg to canonise a set of graphs.
+g6_labelg :: [String] -> IO [String]
+g6_labelg = fmap lines . Process.readProcess "nauty-labelg" ["-q"] . unlines
+
+{- | 'g6_to_g' of 'g6_labelg' of 'g_to_g6'
+
+> g1 = ([0,1,2,3],[(0,3),(3,1),(3,2),(1,2)])
+> g2 = ([0,1,2,3],[(1,0),(0,3),(0,2),(2,3)])
+> [g3,g4] <- g_labelg [g1,g2]
+> (g1 == g2,g3 == g4)
+-}
+g_labelg :: [T.G] -> IO [T.G]
+g_labelg g = g_to_g6 g >>= g6_labelg >>= g6_to_g
diff --git a/Music/Theory/Graph/Lcf.hs b/Music/Theory/Graph/Lcf.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/Lcf.hs
@@ -0,0 +1,114 @@
+{- | Lcf (Lederberg/Coxeter/Frucht) notation
+
+The notation only applies to Hamiltonian graphs, since it achieves its
+symmetry and conciseness by placing a Hamiltonian cycle in a circular
+embedding and then connecting specified pairs of nodes with edges. (EW)
+
+-}
+module Music.Theory.Graph.Lcf where
+
+import Data.Complex {- base -}
+import Data.List {- base -}
+
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+
+-- | Lcf notation (/l/,/k/). ([3,-3],4) is the cubical graph.
+type Lcf = ([Int],Int)
+
+-- | Real, alias for 'Double'
+type R = Double
+
+-- | Sequence, ie. /l/ /k/ times.
+lcf_seq :: Lcf -> [Int]
+lcf_seq (l,k) = concat (replicate k l)
+
+-- | Length of 'lcf_seq', ie. |l|k
+lcf_degree :: Lcf -> Int
+lcf_degree (l,k) = length l * k
+
+-- | 'Lcf' to 'T.Edg' (an edge list)
+lcf_to_edg :: Lcf -> T.Edg
+lcf_to_edg (l,k) =
+  let v_n = length l * k
+      add i j = (i + j) `mod` v_n
+      v = [0 .. v_n - 1]
+  in ((v_n,v_n + (v_n `div` 2))
+     ,concat [[(i,i `add` 1) | i <- v]
+             ,nub (sort (zipWith (curry T.e_sort) v (zipWith add v (lcf_seq (l,k)))))])
+
+-- | Lcf edge-list to graph labeled with circular co-ordinates.
+edg_circ_gr :: R -> T.Edg -> T.Lbl (R,R) ()
+edg_circ_gr rad ((n,_),e) =
+  let polar_to_rectangular (mg,ph) = let c = mkPolar mg ph in (realPart c,imagPart c)
+      ph_incr = (2 * pi) / fromIntegral n
+      v = zip [0 .. n - 1] (map (curry polar_to_rectangular rad) [0, ph_incr ..])
+  in (v,zip e (repeat ()))
+
+{- | Lcf graph set given at <http://mathworld.wolfram.com/LcfNotation.html>
+
+> length lcf_mw_set == 57
+> length (nub (map snd lcf_mw_set)) == 57 -- IE. UNIQ
+-}
+lcf_mw_set :: [(String, Lcf)]
+lcf_mw_set =
+  [("Tetrahedral graph",([2,-2],2)) -- ([2],4)
+  ,("Utility graph",([3],6)) -- ([3,-3],3)
+  ,("3-prism graph",([-3,-2,2],2))
+  ,("Cubical graph",([3,-3],4))
+  ,("Wagner graph",([4],8))
+  ,("3-matchstick graph",([-2,-2,2,2],2))
+  ,("4-Möbius ladder",([-4],8))
+  ,("5-Möbius ladder",([-5],10))
+  ,("5-prism graph",([-5,3,-4,4,-3],2))
+  ,("Bidiakis cube",([6,4,-4],4))
+  ,("Franklin graph",([5,-5],6))
+  ,("Frucht graph",([-5,-2,-4,2,5,-2,2,5,-2,-5,4,2],1))
+  ,("Truncated tetrahedral graph",([2,6,-2],4))
+  ,("Generalized Petersen graph (6,2)",([-5,2,4,-2,-5,4,-4,5,2,-4,-2,5],1))
+  ,("6-Möbius ladder",([-6],12))
+  ,("6-prism graph",([-3,3],6))
+  ,("Heawood graph",([5,-5],7))
+  ,("Generalized Petersen graph (7,2)",([-7,-5,4,-6,-5,4,-4,-7,4,-4,5,6,-4,5],1))
+  ,("7-Möbius ladder",([-7],14))
+  ,("7-prism graph",([-7,5,3,-6,6,-3,-5],2))
+  ,("Cubic vertex-transitive graph Ct19",([-7,7],8))
+  ,("Möbius-Kantor graph",([5,-5],8))
+  ,("8-Möbius ladder",([-8],16))
+  ,("8-prism graph",([-3,3],8))
+  ,("Pappus graph",([5,7,-7,7,-7,-5],3))
+  ,("Cubic vertex-transitive graph Ct20",([-7,7],9)) -- ([5,-5],9)
+  ,("Cubic vertex-transitive graph Ct23",([-9,-2,2],6))
+  ,("Generalized Petersen graph (9,2)",([-9,-8,-4,-9,4,8],3))
+  ,("Generalized Petersen graph (9,3)",([-9,-6,2,5,-2,-9,5,-9,-5,-9,2,-5,-2,6,-9,2,-9,-2],1))
+  ,("9-Möbius ladder",([-9],18))
+  ,("9-prism graph",([-9,7,5,3,-8,8,-3,-5,-7],2))
+  ,("Desargues graph",([5,-5,9,-9],5))
+  ,("Dodecahedral graph",([10,7,4,-4,-7,10,-4,7,-7,4],2))
+  ,("Cubic vertex-transitive graph Ct25",([-7,7],10))
+  ,("Cubic vertex-transitive graph Ct28",([-6,-6,6,6],5))
+  ,("Cubic vertex-transitive graph Ct29",([-9,9],10))
+  ,("Generalized Petersen graph (10,4)",([-10,-7,5,-5,7,-6,-10,-5,5,6],2))
+  ,("Largest cubic nonplanar graph with diameter 3",([-10,-7,-5,4,7,-10,-7,-4,5,7,-10,-7,6,-5,7,-10,-7,5,-6,7],1))
+  ,("10-Möbius ladder",([-10],20))
+  ,("10-prism graph",([-3,3],10))
+  ,("McGee graph",([12,7,-7],8))
+  ,("Truncated cubical graph",([2,9,-2,2,-9,-2],4))
+  ,("Truncated octahedral graph",([3,-7,7,-3],6))
+  ,("Nauru graph",([5,-9,7,-7,9,-5],4))
+  ,("F26A graph",([-7,7],13))
+  ,("Tutte-Coxeter graph",([-13,-9,7,-7,9,13],5))
+  ,("Dyck graph",([5,-5,13,-13],8))
+  ,("Gray graph",([-25,7,-7,13,-13,25],9))
+  ,("Truncated dodecahedral graph",([30,-2,2,21,-2,2,12,-2,2,-12,-2,2,-21,-2,2,30,-2,2,-12,-2,2,21,-2,2,-21,-2,2,12,-2,2],2))
+  ,("Harries graph",([-29,-19,-13,13,21,-27,27,33,-13,13,19,-21,-33,29],5))
+  ,("Harries-Wong graph",([9,25,31,-17,17,33,9,-29,-15,-9,9,25,-25,29,17,-9,9,-27,35,-9,9,-17,21,27,-29,-9,-25,13,19,-9,-33,-17,19,-31,27,11,-25,29,-33,13,-13,21,-29,-21,25,9,-11,-19,29,9,-27,-19,-13,-35,-9,9,17,25,-9,9,27,-27,-21,15,-9,29,-29,33,-9,-25],1))
+  ,("Balaban 10-cage",([-9,-25,-19,29,13,35,-13,-29,19,25,9,-29,29,17,33,21,9,-13,-31,-9,25,17,9,-31,27,-9,17,-19,-29,27,-17,-9,-29,33,-25,25,-21,17,-17,29,35,-29,17,-17,21,-25,25,-33,29,9,17,-27,29,19,-17,9,-27,31,-9,-17,-25,9,31,13,-9,-21,-33,-17,-29,29],1))
+  ,("Foster graph",([17,-9,37,-37,9,-17],15))
+  ,("Biggs-Smith graph",([16,24,-38,17,34,48,-19,41,-35,47,-20,34,-36,21,14,48,-16,-36,-43,28,-17,21,29,-43,46,-24,28,-38,-14,-50,-45,21,8,27,-21,20,-37,39,-34,-44,-8,38,-21,25,15,-34,18,-28,-41,36,8,-29,-21,-48,-28,-20,-47,14,-8,-15,-27,38,24,-48,-18,25,38,31,-25,24,-46,-14,28,11,21,35,-39,43,36,-38,14,50,43,36,-11,-36,-24,45,8,19,-25,38,20,-24,-14,-21,-8,44,-31,-38,-28,37],1))
+  ,("Balaban 11-cage",([44,26,-47,-15,35,-39,11,-27,38,-37,43,14,28,51,-29,-16,41,-11,-26,15,22,-51,-35,36,52,-14,-33,-26,-46,52,26,16,43,33,-15,17,-53,23,-42,-35,-28,30,-22,45,-44,16,-38,-16,50,-55,20,28,-17,-43,47,34,-26,-41,11,-36,-23,-16,41,17,-51,26,-33,47,17,-11,-20,-30,21,29,36,-43,-52,10,39,-28,-17,-52,51,26,37,-17,10,-10,-45,-34,17,-26,27,-21,46,53,-10,29,-50,35,15,-47,-29,-41,26,33,55,-17,42,-26,-36,16],1))
+  ,("Ljubljana graph",([47,-23,-31,39,25,-21,-31,-41,25,15,29,-41,-19,15,-49,33,39,-35,-21,17,-33,49,41,31,-15,-29,41,31,-15,-25,21,31,-51,-25,23,9,-17,51,35,-29,21,-51,-39,33,-9,-51,51,-47,-33,19,51,-21,29,21,-31,-39],2))
+  ,("Tutte 12-cage",([17,27,-13,-59,-35,35,-11,13,-53,53,-27,21,57,11,-21,-57,59,-17],7))]
+
+-- Local Variables:
+-- truncate-lines:t
+-- End:
diff --git a/Music/Theory/Graph/Lgl.hs b/Music/Theory/Graph/Lgl.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/Lgl.hs
@@ -0,0 +1,99 @@
+{- | LGL = Large Graph Layout (NCOL, LGL)
+
+<http://lgl.sourceforge.net/#FileFormat>
+-}
+module Music.Theory.Graph.Lgl where
+
+import Data.Bifunctor {- base -}
+import Data.List {- base -}
+
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+import qualified Music.Theory.Show as T {- hmt-base -}
+import qualified Music.Theory.Tuple as T {- hmt-base -}
+
+-- * Ncol
+
+-- | (edge,weight)
+type Ncol_Ent t = ((t,t),Maybe Double)
+
+-- | [ncol-entry]
+type Ncol t = [Ncol_Ent t]
+
+-- | Parse 'Ncol_Ent' from 'String'
+ncol_parse :: Read t => String -> Ncol_Ent t
+ncol_parse s =
+  case words s of
+    [i,j] -> ((read i,read j),Nothing)
+    [i,j,k] -> ((read i,read j),read k)
+    _ -> error "ncol_parse"
+
+-- | Load 'Ncol' from .ncol file.
+ncol_load :: Read t => FilePath -> IO (Ncol t)
+ncol_load = fmap (map ncol_parse . lines) . readFile
+
+-- | Type-specialised.
+ncol_load_int :: FilePath -> IO (Ncol Int)
+ncol_load_int = ncol_load
+
+{- | Format Ncol_Ent.
+
+> ncol_ent_format 4 ((0,1),Nothing) == "0 1"
+> ncol_ent_format 4 ((0,1),Just 2.0) == "0 1 2.0000"
+-}
+ncol_ent_format :: Show t => Int -> Ncol_Ent t -> String
+ncol_ent_format k ((i,j),w) = unwords (map show [i,j]) ++ maybe "" ((' ':) . T.double_pp k) w
+
+-- | Store 'Ncol' of 'Int' to .ncol file
+ncol_store :: Show t => Int -> FilePath -> Ncol t -> IO ()
+ncol_store k fn dat = writeFile fn (unlines (map (ncol_ent_format k) dat))
+
+-- | Type-specialised.
+ncol_store_int :: Int -> FilePath -> Ncol Int -> IO ()
+ncol_store_int = ncol_store
+
+-- | Ncol data must be un-directed and have no self-arcs.
+--   This function sorts edges (i,j) so that i <= j and deletes edges where i == j.
+ncol_rewrite_eset :: Ord t => [(t,t)] -> [(t,t)]
+ncol_rewrite_eset e = filter (uncurry (/=)) (nub (sort (map T.t2_sort e)))
+
+-- | eset (edge-set) to Ncol (runs 'ncol_rewrite_eset')
+eset_to_ncol :: Ord t => [(t,t)] -> Ncol t
+eset_to_ncol = map (\e -> (e,Nothing)) . ncol_rewrite_eset
+
+-- | Inverse of 'eset_to_ncol', 'error' if 'Ncol' is weighted
+ncol_to_eset :: Ncol t -> [(t,t)]
+ncol_to_eset = map (\(e,w) -> case w of {Nothing -> e;_ -> error "ncol_to_eset?"})
+
+-- | 'ncol_store' of 'eset_to_ncol'
+ncol_store_eset :: (Ord t,Show t) => FilePath -> [(t,t)] -> IO ()
+ncol_store_eset fn = ncol_store undefined fn . eset_to_ncol
+
+-- * Lgl
+
+-- | Lgl is an adjaceny set with optional weights.
+type Lgl t = [(t,[(t,Maybe Double)])]
+
+-- | Format 'Lgl', k is floating point precision for optional weights.
+lgl_format :: Show t => Int -> Lgl t -> String
+lgl_format k =
+  let f (i,j) = show i ++ maybe "" ((' ' :) . T.double_pp k) j
+      g (i,j) = unlines (('#' : ' ' : show i) : map f j)
+  in concatMap g
+
+-- | 'writeFile' of 'lgl_format'
+lgl_store :: Show t => Int -> FilePath -> Lgl t -> IO ()
+lgl_store k fn = writeFile fn . lgl_format k
+
+-- | adj (adjaceny-set) to 'Lgl'.
+adj_to_lgl :: T.Adj t -> Lgl t
+adj_to_lgl = map (\(i,j) -> (i,zip j (repeat Nothing)))
+
+-- | Inverse of 'adj_to_lgl', 'error' if 'Lgl' is weighted
+lgl_to_adj :: Lgl t -> T.Adj t
+lgl_to_adj = map (second (map (\(k,w) -> case w of {Nothing -> k;_ -> error "lgl_to_adj?"})))
+
+-- | 'lgl_store' of 'adj_to_lgl'
+lgl_store_adj :: Show t => FilePath -> T.Adj t -> IO ()
+lgl_store_adj fn = lgl_store undefined fn . adj_to_lgl
+
+-- > putStrLn $ lgl_format 4 $ adj_to_lgl [(0,[1,2,3]),(1,[2,3]),(2,[3])]
diff --git a/Music/Theory/Graph/Planar.hs b/Music/Theory/Graph/Planar.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/Planar.hs
@@ -0,0 +1,141 @@
+-- | <https://users.cecs.anu.edu.au/~bdm/plantri/plantri-guide.txt>
+module Music.Theory.Graph.Planar where
+
+import System.FilePath {- filepath -}
+import System.Process {- process -}
+import Text.Printf {- base -}
+
+import qualified Data.ByteString as B {- bytestring -}
+import qualified Data.List.Split as S {- split -}
+
+import qualified Music.Theory.Graph.G6 as G6 {- hmt-base -}
+import qualified Music.Theory.Graph.Type as T {- hmt-base -}
+
+-- | The 15-character header text indicating a Planar-Code file.
+plc_header_txt :: String
+plc_header_txt = ">>planar_code<<"
+
+-- | Read Plc header
+plc_header :: B.ByteString -> String
+plc_header = map (toEnum . fromIntegral) . B.unpack . B.take 15
+
+-- | Read Plc data as list of 'Int'
+plc_data :: B.ByteString -> [Int]
+plc_data = map fromIntegral . B.unpack . B.drop 15
+
+-- | Calculate length of Plc data given (n-vertices,n-edges).
+plc_length :: (Int,Int) -> Int
+plc_length (v,e) = v + 1 + 2 * e
+
+-- | Scan Plc data and segment after /k/ zeros.
+plc_scanner :: Int -> [Int] -> ([Int],[Int])
+plc_scanner =
+  let f r k i = case i of
+                  0:j -> if k == 1 then (reverse (0 : r),j) else f (0 : r) (k - 1) j
+                  e:j -> f (e : r) k j
+                  _ -> error "plc_scanner?"
+  in f []
+
+-- | (n-vertices,clockwise-edge-sequences)
+type Plc = (Int,[[Int]])
+
+plc_n_vertices :: Plc -> Int
+plc_n_vertices (k,_) = k
+
+-- | Group Plc data into Plc structure.
+plc_group :: Int -> [Int] -> Plc
+plc_group k i =
+  let c = S.endBy [0] i
+  in if length c == k then (k,c) else error "plc_group?"
+
+-- | Segment input data into sequence of Plc.
+plc_segment :: [Int] -> [Plc]
+plc_segment i =
+  case i of
+    [] -> []
+    k:j -> case plc_scanner k j of
+             (r,[]) -> [plc_group k r]
+             (r,l) -> plc_group k r : plc_segment l
+
+plc_parse :: B.ByteString -> [Plc]
+plc_parse b =
+  if plc_header b == plc_header_txt
+  then plc_segment (plc_data b)
+  else error "plc_load?"
+
+-- | Load sequence of Plc from binary Planar-Code file.
+plc_load :: FilePath -> IO [Plc]
+plc_load = fmap plc_parse . B.readFile
+
+-- | All edges (one-indexed) at Plc
+plc_edge_set :: Plc -> [(Int,Int)]
+plc_edge_set (k,n) =
+  let v = [1 .. k]
+      f (i,j) = map (\x -> (i,x)) j
+  in concatMap f (zip v n)
+
+-- | Element in /x/ after /i/, the element after the last is the first.
+--
+-- > map (plc_next_elem "abcd") "abcd" == "bcda"
+plc_next_elem :: Eq t => [t] -> t -> t
+plc_next_elem x i =
+  case dropWhile (/= i) x of
+    [] -> error "plc_next_elem?"
+    [_] -> head x
+    _:j:_ -> j
+
+-- | The next edge in Plc following /e/.
+plc_next_edge :: Plc -> (Int,Int) -> (Int,Int)
+plc_next_edge (_,e) (i,j) = let k = plc_next_elem (e !! (j - 1)) i in (j,k)
+
+-- | The face of Plc starting at /e/ (one-indexed edges).
+plc_face_from :: Plc -> (Int,Int) -> [(Int,Int)]
+plc_face_from p e = e : takeWhile (/= e) (tail (iterate (plc_next_edge p) e))
+
+-- | The set of all faces at Plc (one-indexed edges).
+plc_face_set :: Plc -> [[(Int,Int)]]
+plc_face_set p =
+  let f r e =
+        case e of
+          [] -> reverse r
+          e0:eN -> if any (e0 `elem`) r
+                   then f r eN
+                   else f (plc_face_from p e0 : r) eN
+  in f [] (plc_edge_set p)
+
+-- | Translate 'Plc' into un-directed 'T.G'.  Plc is one-indexed, G is zero-indexed.
+plc_to_g :: Plc -> T.G
+plc_to_g p =
+  let (k,_) = p
+      v = [0 .. k - 1]
+      f (i,j) = (i - 1,j - 1)
+      g (i,j) = i <= j
+  in (v,filter g (map f (plc_edge_set p)))
+
+plc_stat :: FilePath -> IO (Int, [(Int, Int, Int)])
+plc_stat plc_fn = do
+  p_seq <- plc_load plc_fn
+  let f p = (plc_n_vertices p,length (plc_edge_set p) `div` 2,length (plc_face_set p))
+  return (length p_seq,map f p_seq)
+
+plc_stat_txt :: FilePath -> (Int, [(Int, Int, Int)]) -> [String]
+plc_stat_txt fn (k,g) =
+  let hdr = printf "%s G=%d" (takeBaseName fn) k
+      gr ix (v,e,f) = printf " %d: V=%d E=%d F=%d" ix v e f
+  in hdr : zipWith gr [1::Int ..] g
+
+-- | Run "nauty-planarg" to convert (if possible) a set of G6 graphs to Planar-Code.
+g6_planarg :: [String] -> IO B.ByteString
+g6_planarg =
+  -- else see process-extras:readProcessWithExitCode
+  let str_to_b :: String -> B.ByteString
+      str_to_b = B.pack . map (fromIntegral . fromEnum)
+  in fmap str_to_b . readProcess "nauty-planarg" ["-q"] . unlines
+
+-- | 'plc_parse' of 'g6_planarg' of 'G6.g_to_g6'
+g_to_plc :: [T.G] -> IO [Plc]
+g_to_plc g = fmap plc_parse (G6.g_to_g6 g >>= g6_planarg)
+
+-- | Run "nauty-planarg" to translate named G6 file to named PL file.
+g6_to_pl_wr :: FilePath -> FilePath -> IO ()
+g6_to_pl_wr g6_fn pl_fn = callProcess "nauty-planarg" ["-q","-p",g6_fn,pl_fn]
diff --git a/Music/Theory/Graph/Type.hs b/Music/Theory/Graph/Type.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Graph/Type.hs
@@ -0,0 +1,337 @@
+-- | Graph types.
+module Music.Theory.Graph.Type where
+
+import Data.Bifunctor {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+
+import qualified Data.Graph as Graph {- containers -}
+
+import qualified Music.Theory.List as T {- hmt-base -}
+
+-- * Vertices
+
+v_is_normal :: [Int] -> Maybe Int
+v_is_normal v = let k = length v in if v == [0 .. k - 1] then Just k else Nothing
+
+v_is_normal_err :: [Int] -> Int
+v_is_normal_err = fromMaybe (error "v_is_normal?") . v_is_normal
+
+-- * Edge
+
+-- | Un-directed edge equality.
+--
+-- > e_eq_undir (0,1) (1,0) == True
+e_eq_undir :: Eq t => (t,t) -> (t,t) -> Bool
+e_eq_undir e0 e1 =
+  let swap (i,j) = (j,i)
+  in e0 == e1 || e0 == swap e1
+
+-- | Sort edge.
+--
+-- > map e_sort [(0,1),(1,0)] == [(0,1),(0,1)]
+e_sort :: Ord t => (t, t) -> (t, t)
+e_sort (i,j) = (min i j,max i j)
+
+-- * (vertices,edges) graph
+
+-- | (vertices,edges)
+type Gr t = ([t],[(t,t)])
+
+-- | 'Gr' is a functor.
+gr_map :: (t -> u) -> Gr t -> Gr u
+gr_map f (v,e) = (map f v,map (bimap f f) e)
+
+-- | (|V|,|E|)
+gr_degree :: Gr t -> (Int,Int)
+gr_degree (v,e) = (length v,length e)
+
+-- | Re-label graph given table.
+gr_relabel :: Eq t => [(t,u)] -> Gr t -> Gr u
+gr_relabel tbl (v,e) =
+  let get z = T.lookup_err z tbl
+  in (map get v,map (bimap get get) e)
+
+-- | If (i,j) and (j,i) are both in E delete (j,i) where i < j.
+gr_mk_undir :: Ord t => Gr t -> Gr t
+gr_mk_undir (v,e) = (v,nub (sort (map e_sort e)))
+
+-- | List of E to G, derives V from E.
+eset_to_gr :: Ord t => [(t,t)] -> Gr t
+eset_to_gr e =
+  let v = sort (nub (concatMap (\(i,j) -> [i,j]) e))
+  in (v,e)
+
+-- | Sort v and e.
+gr_sort :: Ord t => Gr t -> Gr t
+gr_sort (v,e) = (sort v,sort e)
+
+-- | Complete k-graph (un-directed) given list of vertices
+--
+-- > gr_complete_graph "xyz" == ("xyz",[('x','y'),('x','z'),('y','z')])
+gr_complete_graph :: Ord t => [t] -> Gr t
+gr_complete_graph v = let e = [(i,j) | i <- v,j <- v,i < j] in (v,e)
+
+-- * Int graph
+
+-- | 'Gr' of 'Int'
+type G = Gr Int
+
+-- | Simple text representation of 'G'.  Requires (and checks) that vertices are (0 .. |v|-1).
+--   The first line is the number of vertices, following lines are edges.
+g_to_text :: G -> String
+g_to_text (v,e) =
+  let k = v_is_normal_err v
+      f (i,j) = unwords (map show [i,j])
+  in unlines (show k : map f e)
+
+-- | 'Graph.Graph' to 'G'.
+graph_to_g :: Graph.Graph -> G
+graph_to_g gr = (Graph.vertices gr,Graph.edges gr)
+
+-- | 'G' to 'Graph.Graph'
+--
+-- > g = ([0,1,2],[(0,1),(0,2),(1,2)])
+-- > g == gr_sort (graph_to_g (g_to_graph g))
+g_to_graph :: G -> Graph.Graph
+g_to_graph (v,e) = Graph.buildG (minimum v,maximum v) e
+
+-- | Unlabel graph, make table.
+--
+-- > gr_unlabel ("xyz",[('x','y'),('x','z')]) == (([0,1,2],[(0,1),(0,2)]),[(0,'x'),(1,'y'),(2,'z')])
+gr_unlabel :: Eq t => Gr t -> (G,[(Int,t)])
+gr_unlabel (v1,e1) =
+  let n = length v1
+      v2 = [0 .. n - 1]
+      tbl = zip v2 v1
+      get k = T.reverse_lookup_err k tbl
+      e2 = map (bimap get get) e1
+  in ((v2,e2),tbl)
+
+-- | 'fst' of 'gr_unlabel'
+gr_to_g :: Eq t => Gr t -> G
+gr_to_g = fst . gr_unlabel
+
+-- | 'g_to_graph' of 'gr_unlabel'.
+--
+-- > gr = ("abc",[('a','b'),('a','c'),('b','c')])
+-- > (g,tbl) = gr_to_graph gr
+gr_to_graph :: Eq t => Gr t -> (Graph.Graph,[(Int,t)])
+gr_to_graph gr =
+  let ((v,e),tbl) = gr_unlabel gr
+  in (Graph.buildG (0,length v - 1) e,tbl)
+
+-- | Complete k-graph (un-directed).
+--
+-- > g_complete_graph 3 == ([0,1,2],[(0,1),(0,2),(1,2)])
+g_complete_graph :: Int -> G
+g_complete_graph k = gr_complete_graph [0 .. k - 1]
+
+-- * Edg = edge list (zero-indexed)
+
+-- | ((|V|,|E|),[E])
+type Edg = ((Int,Int), [(Int,Int)])
+
+-- | Requires (and checks) that vertices are (0 .. |v| - 1).
+g_to_edg :: G -> Edg
+g_to_edg (v,e) = ((v_is_normal_err v,length e),e)
+
+-- | Requires (but does not check) that vertices of 'Edg' are all in (0,|v| - 1).
+edg_to_g :: Edg -> G
+edg_to_g ((nv,ne),e) =
+  let v = [0 .. nv - 1]
+  in if ne /= length e
+     then error (show ("edg_to_g",nv,ne,length e))
+     else (v,e)
+
+-- | Parse Edg as printed by nauty-listg.
+edg_parse :: [String] -> Edg
+edg_parse ln =
+  let parse_int_list = map read . words
+      parse_int_pairs = T.adj2 2 . parse_int_list
+      parse_int_pair = T.unlist1_err . parse_int_pairs
+  in case ln of
+       [m,e] -> (parse_int_pair m,parse_int_pairs e)
+       _ -> error "edg_parse"
+
+-- * Adjacencies
+
+-- | Adjacency list [(left-hand-side,[right-hand-side])]
+type Adj t = [(t,[t])]
+
+-- | 'Adj' to edge set.
+adj_to_eset :: Ord t => Adj t -> [(t,t)]
+adj_to_eset = concatMap (\(i,j) -> zip (repeat i) j)
+
+-- | 'Adj' to 'Gr'
+adj_to_gr :: Ord t => Adj t -> Gr t
+adj_to_gr = eset_to_gr . adj_to_eset
+
+-- | 'Gr' to 'Adj' (selection-function)
+gr_to_adj :: Ord t => (t -> (t,t) -> Maybe t) -> Gr t -> Adj t
+gr_to_adj sel_f (v,e) =
+  let f k = (k,sort (mapMaybe (sel_f k) e))
+  in filter (\(_,a) -> a /= []) (map f v)
+
+-- | 'Gr' to 'Adj' (directed)
+--
+-- > g = ([0,1,2,3],[(0,1),(2,1),(0,3),(3,0)])
+-- > r = [(0,[1,3]),(2,[1]),(3,[0])]
+-- > gr_to_adj_dir g == r
+gr_to_adj_dir :: Ord t => Gr t -> Adj t
+gr_to_adj_dir =
+  let sel_f k (i,j) = if i == k then Just j else Nothing
+  in gr_to_adj sel_f
+
+-- | 'Gr' to 'Adj' (un-directed)
+--
+-- > g = ([0,1,2,3],[(0,1),(2,1),(0,3),(3,0)])
+-- > gr_to_adj_undir g == [(0,[1,3,3]),(1,[2])]
+gr_to_adj_undir :: Ord t => Gr t -> Adj t
+gr_to_adj_undir =
+  let sel_f k (i,j) =
+        if i == k && j >= k
+        then Just j
+        else if j == k && i >= k
+             then Just i
+             else Nothing
+  in gr_to_adj sel_f
+
+-- | Adjacency matrix, (|v|,mtx)
+type Adj_Mtx t = (Int,[[t]])
+
+{- | Edg to Adj_Mtx for un-directed graph.
+
+> e = ((4,3),[(0,3),(1,3),(2,3)])
+> edg_to_adj_mtx_undir (0,1) e == (4,[[0,0,0,1],[0,0,0,1],[0,0,0,1],[1,1,1,0]])
+
+> e = ((4,4),[(0,1),(0,3),(1,2),(2,3)])
+> edg_to_adj_mtx_undir (0,1) e == (4,[[0,1,0,1],[1,0,1,0],[0,1,0,1],[1,0,1,0]])
+
+-}
+edg_to_adj_mtx_undir :: (t,t) -> Edg -> Adj_Mtx t
+edg_to_adj_mtx_undir (false,true) ((nv,_ne),e) =
+  let v = [0 .. nv - 1]
+      f i j = case find (e_eq_undir (i,j)) e of
+                Nothing -> false
+                _ -> true
+  in (nv,map (\i -> map (f i) v) v)
+
+-- | 'edg_to_adj_mtx_undir' of 'g_to_edg'
+g_to_adj_mtx_undir :: (t,t) -> G -> Adj_Mtx t
+g_to_adj_mtx_undir o = edg_to_adj_mtx_undir o . g_to_edg
+
+-- | Lookup 'Adj_Mtx' to find connected vertices.
+adj_mtx_con :: Eq t => (t,t) -> Adj_Mtx t -> Int -> [Int]
+adj_mtx_con (false,true) (_,mx) e =
+  let f i j = if i == true then Just j else if i == false then Nothing else error "adj_mtx_con?"
+  in catMaybes (zipWith f (mx !! e) [0..])
+
+-- * Labels
+
+-- | Labelled graph, distinct vertex and edge labels.
+type Lbl_Gr v v_lbl e_lbl = ([(v,v_lbl)],[((v,v),e_lbl)])
+
+-- | 'Lbl_Gr' of 'Int'
+type Lbl v e = Lbl_Gr Int v e
+
+-- | 'Lbl' with () edge labels.
+type Lbl_ v = Lbl v ()
+
+-- | Number of vertices and edges.
+lbl_degree :: Lbl v e -> (Int,Int)
+lbl_degree (v,e) = (length v,length e)
+
+-- | Apply /v/ at vertex labels and /e/ at edge labels.
+lbl_bimap :: (v -> v') -> (e -> e') -> Lbl v e -> Lbl v' e'
+lbl_bimap v_f e_f (v,e) = (map (fmap v_f) v,map (fmap e_f) e)
+
+-- | Merge two 'Lbl' graphs, do not share vertices, vertex indices at /g1/ are stable.
+lbl_merge :: Lbl v e -> Lbl v e -> Lbl v e
+lbl_merge (v1,e1) (v2,e2) =
+  let m = maximum (map fst v1) + 1
+      v3 = map (\(i,j) -> (i + m,j)) v2
+      e3 = map (\((i,j),k) -> ((i + m,j + m),k)) e2
+  in (v1 ++ v3,e1 ++ e3)
+
+-- | 'foldl1' of 'lbl_merge'
+lbl_merge_seq :: [Lbl v e] -> Lbl v e
+lbl_merge_seq = foldl1 lbl_merge
+
+-- | Re-write graph so vertex indices are (0 .. n-1) and vertex labels are unique.
+lbl_canonical :: (Eq v,Ord v) => Lbl v e -> Lbl v e
+lbl_canonical (v1,e1) =
+  let v2 = zip [0..] (nub (map snd v1))
+      reix i = T.reverse_lookup_err (T.lookup_err i v1) v2
+      e2 = map (\((i,j),k) -> ((reix i,reix j),k)) e1
+  in (v2,e2)
+
+-- | Re-write edges so that vertex indices are ascending.
+lbl_undir :: Lbl v e -> Lbl v e
+lbl_undir (v,e) = (v,map (\((i,j),k) -> ((min i j,max i j),k)) e)
+
+-- | 'Lbl' path graph.
+lbl_path_graph :: [x] -> Lbl_ x
+lbl_path_graph v =
+  let n = length v - 1
+  in (zip [0 .. n] v
+     ,zip (zip [0 .. n - 1] [1 .. n]) (repeat ()))
+
+-- | 'Lbl' complete graph (undirected, no self-edges)
+lbl_complete_graph :: [x] -> Lbl_ x
+lbl_complete_graph v =
+  let n = length v - 1
+      u = [0 .. n]
+  in (zip u v
+     ,zip [(i,j) | i <- u, j <- u, i < j] (repeat ()))
+
+-- | Lookup vertex label with default value.
+v_label :: v -> Lbl v e -> Int -> v
+v_label def (tbl,_) v = fromMaybe def (lookup v tbl)
+
+-- | 'v_label' with 'error' as default.
+v_label_err :: Lbl v e -> Int -> v
+v_label_err = v_label (error "v_label")
+
+-- | Lookup edge label with default value.
+e_label :: e -> Lbl v e -> (Int,Int) -> e
+e_label def (_,tbl) e = fromMaybe def (lookup e tbl)
+
+-- | 'e_label' with 'error' as default.
+e_label_err :: Lbl v e -> (Int,Int) -> e
+e_label_err = e_label (error "e_label")
+
+-- | Convert from 'Lbl_Gr' to 'Lbl'
+lbl_gr_to_lbl :: Eq v => Lbl_Gr v v_lbl e_lbl -> Lbl v_lbl e_lbl
+lbl_gr_to_lbl (v,e) =
+  let n = length v
+      v' = [0 .. n - 1]
+      tbl = zip v' (map fst v)
+      get k = T.reverse_lookup_err k tbl
+      e' = map (\((p,q),r) -> ((get p,get q),r)) e
+  in (zip v' (map snd v),e')
+
+-- | Convert from 'Gr' to 'Lbl'.
+--
+-- > gr_to_lbl ("ab",[('a','b')]) == ([(0,'a'),(1,'b')],[((0,1),('a','b'))])
+gr_to_lbl :: Eq t => Gr t -> Lbl t (t,t)
+gr_to_lbl (v,e) = lbl_gr_to_lbl (zip v v,zip e e)
+
+-- | Delete edge labels from 'Lbl', replacing with '()'
+lbl_delete_edge_labels :: Lbl v e -> Lbl_ v
+lbl_delete_edge_labels (v,e) = (v,map (\(x,_) -> (x,())) e)
+
+-- | 'lbl_delete_edge_labels' of 'gr_to_lbl'
+gr_to_lbl_ :: Eq t => Gr t -> Lbl_ t
+gr_to_lbl_ = lbl_delete_edge_labels . gr_to_lbl
+
+-- | Construct Lbl from set of E, derives V from E.
+eset_to_lbl :: Ord t => [(t,t)] -> Lbl_ t
+eset_to_lbl e =
+  let v = nub (sort (concatMap (\(i,j) -> [i,j]) e))
+      get_ix z = fromMaybe (error "eset_to_lbl") (elemIndex z v)
+  in (zip [0..] v, map (\(i,j) -> ((get_ix i,get_ix j),())) e)
+
+-- | Unlabel 'Lbl' graph.
+lbl_to_g :: Lbl v e -> G
+lbl_to_g (v,e) = (map fst v,map fst e)
diff --git a/Music/Theory/Io.hs b/Music/Theory/Io.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Io.hs
@@ -0,0 +1,62 @@
+-- | "System.IO" related functions.
+module Music.Theory.Io where
+
+import Control.Monad {- base -}
+import System.IO {- base -}
+
+import qualified Data.ByteString as B {- bytestring -}
+import qualified System.Directory as D {- directory -}
+
+import qualified Control.Monad.Loops as Loop {- monad-loops -}
+
+import qualified Data.Text as T {- text -}
+import qualified Data.Text.Encoding as T {- text -}
+import qualified Data.Text.IO as T {- text -}
+
+-- | 'T.decodeUtf8' of 'B.readFile', implemented via "Data.Text".
+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 'T.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 'T.Text' for local encoding.
+read_file_locale :: FilePath -> IO String
+read_file_locale = fmap T.unpack . T.readFile
+
+-- | Interact with files.  Like Prelude.interact, but with named files.
+interactWithFiles :: FilePath -> FilePath -> (String -> String) -> IO ()
+interactWithFiles inputFile outputFile process = do
+  input <- readFile inputFile
+  writeFile outputFile (process input)
+
+-- | Get line from stdin if there is any input, else Nothing.
+getLineFromStdinIfReady :: IO (Maybe String)
+getLineFromStdinIfReady = do
+  r <- hReady stdin
+  if r then fmap Just (hGetLine stdin) else return Nothing
+
+-- | Wait for input to be available, and then get lines while input remains available.
+getAvailableLinesFromStdin :: IO [String]
+getAvailableLinesFromStdin = do
+  _ <- hWaitForInput stdin (-1)
+  Loop.unfoldM getLineFromStdinIfReady
+
+-- | Interact with stdin and stdout.  Like Prelude.interact, but with pipes.
+interactWithStdio :: (String -> String) -> IO ()
+interactWithStdio strFunc = forever (getAvailableLinesFromStdin >>= \ln -> hPutStrLn stdout (strFunc (unlines ln)) >> hFlush stdout)
diff --git a/Music/Theory/List.hs b/Music/Theory/List.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/List.hs
@@ -0,0 +1,1532 @@
+-- | List functions.
+module Music.Theory.List where
+
+import Data.Bifunctor {- base -}
+import Data.Function {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ord {- base -}
+
+import qualified Data.IntMap as Map {- containers -}
+import qualified Data.List.Ordered as O {- data-ordlist -}
+import qualified Data.List.Split as S {- split -}
+import qualified Data.Tree as Tree {- containers -}
+
+import qualified Music.Theory.Either as T {- hmt-base -}
+
+-- | '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]
+
+-- | 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
+
+-- | The first & middle & last elements of a list.
+--
+-- > map unbracket_el ["","{12}"] == [(Nothing,"",Nothing),(Just '{',"12",Just '}')]
+unbracket_el :: [a] -> (Maybe a,[a],Maybe a)
+unbracket_el 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.
+--
+-- > map unbracket ["","{12}"] == [Nothing,Just ('{',"12",'}')]
+unbracket :: [t] -> Maybe (t,[t],t)
+unbracket x =
+    case unbracket_el x of
+      (Just l,m,Just r) -> Just (l,m,r)
+      _ -> Nothing
+
+-- | Erroring variant.
+unbracket_err :: [t] -> (t,[t],t)
+unbracket_err = fromMaybe (error "unbracket") . unbracket
+
+-- * Split
+
+-- | Relative of 'S.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 []
+
+-- | Variant of 'S.splitWhen' that keeps delimiters at left.
+--
+-- > split_when_keeping_left (== 'r') "rab rcd re rf r" == ["","rab ","rcd ","re ","rf ","r"]
+split_when_keeping_left :: (a -> Bool) -> [a] -> [[a]]
+split_when_keeping_left = S.split . S.keepDelimsL . S.whenElt
+
+{- | Split before the indicated element, keeping it at the left of the sub-sequence it begins.
+     'split_when_keeping_left' of '=='
+
+> 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 'r' "rab rcd re rf r" == ["","rab ","rcd ","re ","rf ","r"]
+-}
+split_before :: Eq a => a -> [a] -> [[a]]
+split_before x = split_when_keeping_left (== x)
+
+-- | Split before any of the indicated set of delimiters.
+--
+-- > split_before_any ",;" ";a,b,c;d;" == ["",";a",",b",",c",";d",";"]
+split_before_any :: Eq a => [a] -> [a] -> [[a]]
+split_before_any = S.split . S.keepDelimsL . S.oneOf
+
+-- | Singleton variant of 'S.splitOn'.
+--
+-- > split_on_1 ":" "graph:layout" == Just ("graph","layout")
+split_on_1 :: Eq t => [t] -> [t] -> Maybe ([t],[t])
+split_on_1 e l =
+    case S.splitOn e l of
+      [p,q] -> Just (p,q)
+      _ -> Nothing
+
+-- | Erroring variant.
+split_on_1_err :: Eq t => [t] -> [t] -> ([t],[t])
+split_on_1_err e = fromMaybe (error "split_on_1") . split_on_1 e
+
+-- | Split function that splits only once, ie. a variant of 'break'.
+--
+-- > split1 ' ' "three word sentence" == Just ("three","word sentence")
+split1 :: Eq a => a -> [a] -> Maybe ([a],[a])
+split1 c l =
+    case break (== c) l of
+      (lhs,_:rhs) -> Just (lhs,rhs)
+      _ -> Nothing
+
+-- | Erroring variant.
+split1_err :: (Eq a, Show a) => a -> [a] -> ([a], [a])
+split1_err e s = fromMaybe (error (show ("split1",e,s))) (split1 e s)
+
+{- | If length is not even the second "half" is longer.
+
+> split_into_halves [] == ([],[])
+> split_into_halves [1] == ([],[1])
+> split_into_halves [1 .. 2] == ([1],[2])
+> split_into_halves [1 .. 8] == ([1,2,3,4],[5,6,7,8])
+> split_into_halves [1 .. 9] == ([1,2,3,4],[5,6,7,8,9])
+-}
+split_into_halves :: [t] -> ([t], [t])
+split_into_halves l =
+  let n = length l `div` 2
+      m = if n == 1 then 1 else n + (n `mod` 2) -- the two element list is a special case
+  in (take m l, drop m l)
+
+-- * 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.  Therefore negative n rotate right.
+
+> rotate 1 [1..3] == [2,3,1]
+> rotate 8 [1..5] == [4,5,1,2,3]
+> (rotate (-1) "ABCD",rotate 1 "ABCD") == ("DABC","BCDA")
+-}
+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_trunc 4 1 "adjacent" == ["adja","djac","jace","acen","cent"]
+-- > adj_trunc 3 2 "adjacent" == ["adj","jac","cen"]
+adj_trunc :: Int -> Int -> [a] -> [[a]]
+adj_trunc n k l =
+    let r = take n l
+    in if length r == n then r : adj_trunc n k (drop k l) else []
+
+-- | 'adj_trunc' of 'close' by /n/-1.
+--
+-- > adj_cyclic_trunc 3 1 "adjacent" == ["adj","dja","jac","ace","cen","ent","nta","tad"]
+adj_cyclic_trunc :: Int -> Int -> [a] -> [[a]]
+adj_cyclic_trunc n k = adj_trunc n k . close (n - 1)
+
+-- | 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 /n/-elements to end of list.
+--
+-- > close 1 [1..3] == [1,2,3,1]
+close :: Int -> [a] -> [a]
+close k x = x ++ take k x
+
+-- | 'adj2' '.' 'close' 1.
+--
+-- > adj2_cyclic 1 [1..3] == [(1,2),(2,3),(3,1)]
+adj2_cyclic :: Int -> [t] -> [(t,t)]
+adj2_cyclic n = adj2 n . close 1
+
+-- | Adjacent triples.
+--
+-- > adj3 3 [1..6] == [(1,2,3),(4,5,6)]
+adj3 :: Int -> [t] -> [(t,t,t)]
+adj3 n l =
+  case l of
+      p:q:r:_ -> (p,q,r) : adj3 n (drop n l)
+      _ -> []
+
+-- | 'adj3' '.' 'close' 2.
+--
+-- > adj3_cyclic 1 [1..4] == [(1,2,3),(2,3,4),(3,4,1),(4,1,2)]
+adj3_cyclic :: Int -> [t] -> [(t,t,t)]
+adj3_cyclic n = adj3 n . close 2
+
+{- | Adjacent quadruples.
+
+> adj4 2 [1..8] == [(1,2,3,4),(3,4,5,6),(5,6,7,8)]
+> adj4 4 [1..8] == [(1,2,3,4),(5,6,7,8)]
+-}
+adj4 :: Int -> [t] -> [(t,t,t,t)]
+adj4 n l =
+  case l of
+      p:q:r:s:_ -> (p,q,r,s) : adj4 n (drop n l)
+      _ -> []
+
+-- | Interleave elements of /p/ and /q/.  If not of equal length elements are discarded.
+--
+-- > 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 = concat . zipWith (\i j -> [i, j]) p -- concatMap (\(i, j) -> [i, j]) . zip p
+
+-- | 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)
+
+-- | 'unzip', apply /f1/ and /f2/ and 'zip'.
+rezip :: ([t] -> [u]) -> ([v] -> [w]) -> [(t,v)] -> [(u,w)]
+rezip f1 f2 l = let (p,q) = unzip l in zip (f1 p) (f2 q)
+
+-- | Generalised histogram, with equality function for grouping and comparison function for sorting.
+generic_histogram_by :: Integral i => (a -> a-> Bool) -> Maybe (a -> a-> Ordering) -> [a] -> [(a,i)]
+generic_histogram_by eq_f cmp_f x =
+    let g = groupBy eq_f (maybe x (`sortBy` x) cmp_f)
+    in zip (map head g) (map genericLength g)
+
+-- | Type specialised 'generic_histogram_by'.
+histogram_by :: (a -> a-> Bool) -> Maybe (a -> a-> Ordering) -> [a] -> [(a,Int)]
+histogram_by = generic_histogram_by
+
+-- | Count occurences of elements in list, 'histogram_by' of '==' and 'compare'.
+generic_histogram :: (Ord a,Integral i) => [a] -> [(a,i)]
+generic_histogram = generic_histogram_by (==) (Just compare)
+
+-- | Type specialised 'generic_histogram'.  Elements will be in ascending order.
+--
+-- > map histogram ["","hohoh","yxx"] == [[],[('h',3),('o',2)],[('x',2),('y',1)]]
+histogram :: Ord a => [a] -> [(a,Int)]
+histogram = generic_histogram
+
+-- | Join two histograms, which must be sorted.
+--
+-- > histogram_join (zip "ab" [1,1]) (zip "bc" [1,1]) == zip "abc" [1,2,1]
+histogram_join :: Ord a => [(a,Int)] -> [(a,Int)] -> [(a,Int)]
+histogram_join p q =
+  let f (e1,n1) (e2,n2) = if e1 == e2 then Just (e1,n1 + n2) else Nothing
+  in case (p,q) of
+       (_,[]) -> p
+       ([],_) -> q
+       (p1:p',q1:q') -> case f p1 q1 of
+                          Just r -> r : histogram_join p' q'
+                          Nothing -> if p1 < q1
+                                     then p1 : histogram_join p' q
+                                     else q1 : histogram_join p q'
+
+-- | 'foldr' of 'histogram_join'.
+--
+-- > let f x = zip x (repeat 1) in histogram_merge (map f ["ab","bcd","de"]) == zip "abcde" [1,2,1,2,1]
+histogram_merge :: Ord a => [[(a,Int)]] -> [(a,Int)]
+histogram_merge = foldr histogram_join []
+
+-- | Given (k,#) histogram where k is enumerable generate filled histogram with 0 for empty k.
+--
+-- > histogram_fill (histogram "histogram") == zip ['a'..'t'] [1,0,0,0,0,0,1,1,1,0,0,0,1,0,1,0,0,1,1,1]
+histogram_fill :: (Ord a, Enum a) => [(a,Int)] -> [(a,Int)]
+histogram_fill h =
+  let k = map fst h
+      e = [minimum k .. maximum k]
+      f x = fromMaybe 0 (lookup x h)
+  in zip e (map f e)
+
+{- | Given two histograms p & q (sorted by key) make composite
+histogram giving for all keys the counts for (p,q).
+
+> r = zip "ABCDE" (zip [4,3,2,1,0] [2,3,4,0,5])
+> histogram_composite (zip "ABCD" [4,3,2,1]) (zip "ABCE" [2,3,4,5]) == r
+-}
+histogram_composite :: Ord a => [(a,Int)] -> [(a,Int)] -> [(a,(Int,Int))]
+histogram_composite p q =
+  case (p,q) of
+    ([],_) -> map (\(k,n) -> (k,(0,n))) q
+    (_,[]) -> map (\(k,n) -> (k,(n,0))) p
+    ((k1,n1):p',(k2,n2):q') -> case compare k1 k2 of
+                                 LT -> (k1,(n1,0)) : histogram_composite p' q
+                                 EQ -> (k1,(n1,n2)) : histogram_composite p' q'
+                                 GT -> (k2,(0,n2)) : histogram_composite p q'
+
+{- | Apply '-' at count of 'histogram_composite', ie. 0 indicates
+equal number at p and q, negative indicates more elements at p than
+q and positive more elements at q than p.
+
+> histogram_diff (zip "ABCD" [4,3,2,1]) (zip "ABCE" [2,3,4,5]) == zip "ABCDE" [-2,0,2,-1,5]
+-}
+histogram_diff :: Ord a => [(a,Int)] -> [(a,Int)] -> [(a,Int)]
+histogram_diff p = map (\(k,(n,m)) -> (k,m - n)) . histogram_composite p
+
+-- | Elements that appear more than once in the input given equality predicate.
+duplicates_by :: Ord a => (a -> a -> Bool) -> [a] -> [a]
+duplicates_by f = map fst . filter (\(_,n) -> n > 1) . histogram_by f (Just compare)
+
+-- | 'duplicates_by' of '=='.
+--
+-- > 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
+
+-- | 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 = map (\e -> if f e then Just e else Nothing)
+
+{- | Select only the elements from the list that lie in the indicated range, which is (inclusive, exclusive).
+
+> filterInRange (3, 5) [1, 1.5 .. 9] == [3.0,3.5,4.0,4.5]
+-}
+filterInRange :: Ord a => (a, a) -> [a] -> [a]
+filterInRange (lhs, rhs) = filter (\n -> n >= lhs && n < rhs)
+
+-- | 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
+
+-- | Data.List.stripPrefix, which however hugs doesn't know of.
+strip_prefix :: Eq a => [a] -> [a] -> Maybe [a]
+strip_prefix lhs rhs =
+  case (lhs,rhs) of
+    ([], ys) -> Just ys
+    (_, []) -> Nothing
+    (x:xs, y:ys) -> if x == y then strip_prefix xs ys else Nothing
+
+-- | 'error' of 'stripPrefix'
+strip_prefix_err :: Eq t => [t] -> [t] -> [t]
+strip_prefix_err pfx = fromMaybe (error "strip_prefix") . strip_prefix pfx
+
+-- * Association lists
+
+-- | Equivalent to 'groupBy' /eq/ 'on' /f/.
+--
+-- > group_by_on (==) snd (zip [0..] "abbc") == [[(0,'a')],[(1,'b'),(2,'b')],[(3,'c')]]
+group_by_on :: (x -> x -> Bool) -> (t -> x) -> [t] -> [[t]]
+group_by_on eq f = groupBy (eq `on` f)
+
+-- | 'group_by_on' of '=='.
+--
+-- > r = [[(1,'a'),(1,'b')],[(2,'c')],[(3,'d'),(3,'e')],[(4,'f')]]
+-- > group_on fst (zip [1,1,2,3,3,4] "abcdef") == r
+group_on :: Eq x => (a -> x) -> [a] -> [[a]]
+group_on = group_by_on (==)
+
+-- | Given an equality predicate and accesors for /key/ and /value/ collate adjacent values.
+collate_by_on_adjacent :: (k -> k -> Bool) -> (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
+collate_by_on_adjacent eq f g =
+    let h l = case l of
+                [] -> error "collate_by_on_adjacent"
+                l0:_ -> (f l0,map g l)
+    in map h . group_by_on eq f
+
+-- | 'collate_by_on_adjacent' of '=='
+collate_on_adjacent :: Eq k => (a -> k) -> (a -> v) -> [a] -> [(k,[v])]
+collate_on_adjacent = collate_by_on_adjacent (==)
+
+-- | 'collate_on_adjacent' of 'fst' and 'snd'.
+--
+-- > collate_adjacent (zip "TDD" "xyz") == [('T',"x"),('D',"yz")]
+collate_adjacent :: Eq a => [(a,b)] -> [(a,[b])]
+collate_adjacent = collate_on_adjacent fst snd
+
+-- | Data.List.sortOn, which however hugs doesn't know of.
+sort_on :: Ord b => (a -> b) -> [a] -> [a]
+sort_on f = map snd . sortBy (comparing fst) . map (\x -> let y = f x in y `seq` (y, x))
+
+-- | 'sortOn' prior to 'collate_on_adjacent'.
+--
+-- > r = [('A',"a"),('B',"bd"),('C',"ce"),('D',"f")]
+-- > 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 . sort_on 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)
+
+-- | Left biased merge of association lists /p/ and /q/.
+--
+-- > assoc_merge [(5,"a"),(3,"b")] [(5,"A"),(7,"C")] == [(5,"a"),(3,"b"),(7,"C")]
+assoc_merge :: Eq k => [(k,v)] -> [(k,v)] -> [(k,v)]
+assoc_merge p q =
+    let p_k = map fst p
+        q' = filter ((`notElem` p_k) . fst) q
+    in p ++ q'
+
+-- | Keys are in ascending order, the entry retrieved is the rightmose with
+--   a key less than or equal to the key requested.
+--   If the key requested is less than the initial key, or the list is empty, returns 'Nothing'.
+--
+-- > let m = [(1,'a'),(4,'x'),(4,'b'),(5,'c')]
+-- > mapMaybe (ord_map_locate m) [1 .. 6] == [(1,'a'),(1,'a'),(1,'a'),(4,'b'),(5,'c'),(5,'c')]
+-- > ord_map_locate m 0 == Nothing
+ord_map_locate :: Ord k => [(k,v)] -> k -> Maybe (k,v)
+ord_map_locate mp i =
+    let f (k0,v0) xs =
+          case xs of
+            [] -> if i >= k0 then Just (k0,v0) else error "ord_map_locate?"
+            ((k1,v1):xs') -> if i >= k0 && i < k1 then Just (k0,v0) else f (k1,v1) xs'
+    in case mp of
+         [] -> Nothing
+         (k0,v0):mp' -> if i < k0 then Nothing else f (k0,v0) mp'
+
+-- * Δ
+
+-- | 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'"
+
+-- | Integration with /f/, ie. apply flip of /f/ between elements of /l/.
+--
+-- > d_dx_by (,) "abcd" == [('b','a'),('c','b'),('d','c')]
+-- > d_dx_by (-) [0,2,4,1,0] == [2,2,-3,-1]
+-- > d_dx_by (-) [2,3,0,4,1] == [1,-3,4,-3]
+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 = filter (`notElem` q) p
+
+-- | Is /p/ a subset of /q/, ie. is 'intersect' of /p/ and /q/ '==' /p/.
+--
+-- > map (is_subset [1,2]) [[1],[1,2],[1,2,3]] == [False,True,True]
+is_subset :: Eq a => [a] -> [a] -> Bool
+is_subset p q = p `intersect` q == p
+
+-- | Is /p/ a proper subset of /q/, 'is_subset' and 'not' equal.
+--
+-- > map (is_proper_subset [1,2]) [[1],[1,2],[1,2,3]] == [False,False,True]
+is_proper_subset :: Eq a => [a] -> [a] -> Bool
+is_proper_subset p q = is_subset p q && p /= p `union` q
+
+-- | 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
+
+-- | Erroring variant of 'findIndex'.
+findIndex_err :: (a -> Bool) -> [a] -> Int
+findIndex_err f = fromMaybe (error "findIndex?") . findIndex f
+
+-- | Erroring variant of 'elemIndex'.
+elemIndex_err :: Eq a => a -> [a] -> Int
+elemIndex_err x = fromMaybe (error "ix_of") . elemIndex x
+
+-- | 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 and key.
+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
+
+-- | If /l/ is empty 'Nothing', else 'Just' /l/.
+non_empty :: [t] -> Maybe [t]
+non_empty l = if null l then Nothing else Just l
+
+-- | Variant on 'filter' that selects all matches.
+--
+-- > lookup_set 1 (zip [1,2,3,4,1] "abcde") == Just "ae"
+lookup_set :: Eq k => k -> [(k,v)] -> Maybe [v]
+lookup_set k = non_empty . map snd . filter ((== k) . fst)
+
+-- | Erroring variant.
+lookup_set_err :: Eq k => k -> [(k,v)] -> [v]
+lookup_set_err k = fromMaybe (error "lookup_set?") . lookup_set k
+
+-- | Reverse lookup.
+--
+-- > reverse_lookup 'c' [] == Nothing
+-- > reverse_lookup 'b' (zip [1..] ['a'..]) == Just 2
+-- > lookup 2 (zip [1..] ['a'..]) == Just 'b'
+reverse_lookup :: Eq v => v -> [(k,v)] -> Maybe k
+reverse_lookup k = fmap fst . find ((== k) . snd)
+
+-- | Erroring variant.
+reverse_lookup_err :: Eq v => v -> [(k,v)] -> k
+reverse_lookup_err k = fromMaybe (error "reverse_lookup") . reverse_lookup k
+
+{-
+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'
+-}
+
+-- | Erroring variant of 'find'.
+find_err :: (t -> Bool) -> [t] -> t
+find_err f = fromMaybe (error "find") . find f
+
+-- | Basis of 'find_bounds_scl', indicates if /x/ is to the left or
+-- right of the list, and if 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_cmp compare [(0,1),(1,2)]) [-1,0,1,2,3]
+find_bounds_cmp :: (t -> s -> Ordering) -> [(t,t)] -> s -> Either ((t,t),Ordering) (t,t)
+find_bounds_cmp f l x =
+    let g (p,q) = f p x /= GT && f q x == GT
+    in case l of
+         [] -> error "find_bounds_cmp: 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_cmp f l' x
+
+-- | Decide if value is nearer the left or right value of a range, return 'fst' or 'snd'.
+decide_nearest_f :: Ord o => Bool -> (p -> o) -> (p,p) -> ((x,x) -> x)
+decide_nearest_f bias_left f (p,q) =
+  case compare (f p) (f q) of
+    LT -> fst
+    EQ -> if bias_left then fst else snd
+    GT -> snd
+
+-- | 'decide_nearest_f' with 'abs' of '-' as measure.
+--
+-- > (decide_nearest True 2 (1,3)) ("left","right") == "left"
+decide_nearest :: (Num o,Ord o) => Bool -> o -> (o,o) -> ((x,x) -> x)
+decide_nearest bias_left x = decide_nearest_f bias_left (abs . (x -))
+
+-- | /sel_f/ gets comparison key from /t/.
+find_nearest_by :: (Ord n,Num n) => (t -> n) -> Bool -> [t] -> n -> t
+find_nearest_by sel_f bias_left l x =
+  let cmp_f i j = compare (sel_f i) j
+  in case find_bounds_cmp cmp_f (adj2 1 l) x of
+       Left ((p,_),GT) -> p
+       Left ((_,q),_) -> q
+       Right (p,q) -> decide_nearest bias_left x (sel_f p,sel_f q) (p,q)
+
+-- | Find the number that is nearest the requested value in an
+-- ascending list of numbers.
+--
+-- > map (find_nearest_err True [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) => Bool -> [n] -> n -> n
+find_nearest_err = find_nearest_by id
+
+-- | 'find_nearest_err' allowing 'null' input list (which returns 'Nothing')
+find_nearest :: (Num n,Ord n) => Bool -> [n] -> n -> Maybe n
+find_nearest bias_left l x = if null l then Nothing else Just (find_nearest_err bias_left 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.
+--
+-- scl=special-case-last
+find_bounds_scl :: Bool -> (t -> s -> Ordering) -> [(t,t)] -> s -> Maybe (t,t)
+find_bounds_scl scl f l x =
+    case find_bounds_cmp 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
+
+-- | Data.List.dropWhileEnd, which however hugs doesn't know of.
+drop_while_end :: (a -> Bool) -> [a] -> [a]
+drop_while_end p = foldr (\x xs -> if p x && null xs then [] else x : xs) []
+
+{- | 'foldr' form of 'dropWhileRight'.
+
+> drop_while_right Data.Char.isDigit "A440" == "A"
+-}
+drop_while_right :: (a -> Bool) -> [a] -> [a]
+drop_while_right p = foldr (\x xs -> if p x && null xs then [] else x:xs) []
+
+-- | 'take' from right.
+--
+-- > take_right 3 "taking" == "ing"
+take_right :: Int -> [a] -> [a]
+take_right n = reverse . take n . reverse
+
+-- | 'takeWhile' from right.
+--
+-- > takeWhileRight Data.Char.isDigit "A440" == "440"
+takeWhileRight :: (a -> Bool) -> [a] -> [a]
+takeWhileRight p = reverse . takeWhile p . reverse
+
+{- | 'foldr' form of 'takeWhileRight'.
+
+> take_while_right Data.Char.isDigit "A440" == "440"
+-}
+take_while_right :: (a -> Bool) -> [a] -> [a]
+take_while_right p =
+  snd .
+  foldr (\x xys -> (if p x && fst xys then bimap id (x:) else bimap (const False) id) xys) (True, [])
+
+-- | Variant of 'take' that allows 'Nothing' to indicate the complete list.
+--
+-- > maybe_take (Just 5) [1 .. ] == [1 .. 5]
+-- > maybe_take Nothing [1 .. 9] == [1 .. 9]
+maybe_take :: Maybe Int -> [a] -> [a]
+maybe_take n l = maybe l (`take` l) n
+
+{- | Take until /f/ is true.  This is not the same as 'not' at
+     'takeWhile' because it keeps the last element. It is an error
+     if the predicate never succeeds.
+
+> take_until (== 'd') "tender" == "tend"
+> takeWhile (not . (== 'd')) "tend" == "ten"
+> take_until (== 'd') "seven" == undefined
+-}
+take_until :: (a -> Bool) -> [a] -> [a]
+take_until f l =
+  case l of
+    [] -> error "take_until?"
+    e:l' -> if f e then [e] else e : take_until f l'
+
+-- | 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
+
+-- | Head and tail of list.  Useful to avoid "incomplete-uni-patterns" warnings.  It's an error if the list is empty.
+headTail :: [a] -> (a, [a])
+headTail l = (head l, tail l)
+
+-- | First and second elements of list. Useful to avoid "incomplete-uni-patterns" warnings.  It's an error if the list has less than two elements.
+firstSecond :: [t] -> (t, t)
+firstSecond l = (l !! 0, l !! 1)
+
+-- | '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') = headTail 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 (== x) xs
+
+-- | Variant using 'nub'.
+all_eq :: Eq n => [n] -> Bool
+all_eq = (== 1) . length . nub
+
+-- | 'nubBy' '==' 'on' /f/.
+--
+-- > nub_on snd (zip "ABCD" "xxyy") == [('A','x'),('C','y')]
+nub_on :: Eq b => (a -> b) -> [a] -> [a]
+nub_on f = nubBy ((==) `on` f)
+
+-- | '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 . sort_on 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
+
+-- | Cons onto end of list.
+--
+-- > snoc 4 [1,2,3] == [1,2,3,4]
+snoc :: a -> [a] -> [a]
+snoc e 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
+
+-- | 'compare' 'on' of 'two_stage_compare'
+two_stage_compare_on :: (Ord i, Ord j) => (t -> i) -> (t -> j) -> t -> t -> Ordering
+two_stage_compare_on f g = two_stage_compare (compare `on` f) (compare `on` g)
+
+-- | 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
+
+-- | 'compare' 'on' of 'two_stage_compare'
+n_stage_compare_on :: Ord i => [t -> i] -> t -> t -> Ordering
+n_stage_compare_on l = n_stage_compare (map (compare `on`) l)
+
+-- | 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 . sort_on snd . zip e
+
+-- | 'flip' of 'sort_to'.
+--
+-- > sort_to_rev [1,4,2,3,5] "adbce" == "abcde"
+sort_to_rev :: Ord i => [i] -> [e] -> [e]
+sort_to_rev = flip sort_to
+
+-- | 'sortBy' of 'two_stage_compare'.
+sort_by_two_stage :: Compare_F a -> Compare_F a -> [a] -> [a]
+sort_by_two_stage f g = sortBy (two_stage_compare f g)
+
+-- | 'sortBy' of 'n_stage_compare'.
+sort_by_n_stage :: [Compare_F a] -> [a] -> [a]
+sort_by_n_stage f = sortBy (n_stage_compare f)
+
+-- | 'sortBy' of 'two_stage_compare_on'.
+sort_by_two_stage_on :: (Ord b,Ord c) => (a -> b) -> (a -> c) -> [a] -> [a]
+sort_by_two_stage_on f g = sortBy (two_stage_compare_on f g)
+
+-- | 'sortBy' of 'n_stage_compare_on'.
+sort_by_n_stage_on :: Ord b => [a -> b] -> [a] -> [a]
+sort_by_n_stage_on f = sortBy (n_stage_compare_on f)
+
+-- | Given a comparison function, merge two ascending lists. Alias for 'O.mergeBy'
+--
+-- > merge_by 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))
+
+-- | Alias for 'O.merge'
+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 (\x _ -> x) (compare `on` fst) [(0,'A'),(1,'B'),(4,'E')] (zip [1..] "bcd")
+-}
+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
+
+-- | Merge two sorted (ascending) sequences.
+--   Where elements compare equal, select element from left input.
+--
+-- > asc_seq_left_biased_merge_by (compare `on` fst) [(0,'A'),(1,'B'),(4,'E')] (zip [1..] "bcd")
+asc_seq_left_biased_merge_by :: (a -> a -> Ordering) -> [a] -> [a] -> [a]
+asc_seq_left_biased_merge_by = merge_by_resolve const
+
+-- | Find the first two adjacent elements for which /f/ is True.
+--
+-- > find_adj (>) [1,2,3,3,2,1] == Just (3,2)
+-- > find_adj (>=) [1,2,3,3,2,1] == Just (3,3)
+find_adj :: (a -> a -> Bool) -> [a] -> Maybe (a,a)
+find_adj f xs =
+    case xs of
+      p:q:xs' -> if f p q then Just (p,q) else find_adj f (q:xs')
+      _ -> Nothing
+
+-- | 'find_adj' of '>='
+--
+-- > filter is_ascending (words "A AA AB ABB ABC ABA") == words "A AB ABC"
+is_ascending :: Ord a => [a] -> Bool
+is_ascending = isNothing . find_adj (>=)
+
+-- | 'find_adj' of '>'
+--
+-- > filter is_non_descending (words "A AA AB ABB ABC ABA") == ["A","AA","AB","ABB","ABC"]
+is_non_descending :: Ord a => [a] -> Bool
+is_non_descending = isNothing . find_adj (>)
+
+-- | 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
+
+-- | 'zipWith' variant equivalent to 'mapMaybe' (ie. 'catMaybes' of 'zipWith')
+zip_with_maybe :: (a -> b -> Maybe c) -> [a] -> [b] -> [c]
+zip_with_maybe f lhs = catMaybes . zipWith f lhs
+
+-- | 'zipWith' variant that extends shorter side using given value.
+zip_with_ext :: t -> u -> (t -> u -> v) -> [t] -> [u] -> [v]
+zip_with_ext i j f p q =
+  case (p,q) of
+    ([],_) -> map (f i) q
+    (_,[]) -> map (`f` j) p
+    (x:p',y:q') -> f x y : zip_with_ext i j f p' q'
+
+{- | 'zip_with_ext' of ','
+
+> let f = zip_ext 'i' 'j'
+> f "" "" == []
+> f "p" "" == zip "p" "j"
+> f "" "q" == zip "i" "q"
+> f "pp" "q" == zip "pp" "qj"
+> f "p" "qq" == zip "pi" "qq"
+-}
+zip_ext :: t -> u -> [t] -> [u] -> [(t,u)]
+zip_ext i j = zip_with_ext i j (,)
+
+-- | 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'
+
+{- | Zip a list with a list of lists.
+Ordinarily the list has at least as many elements as there are elements at the list of lists.
+There is also a Traversable form of this called 'adopt_shape_2_zip_stream'.
+
+> zip_list_with_list_of_list [1 ..] ["a", "list", "of", "strings"]
+> zip_list_with_list_of_list [1 .. 9] ["a", "list", "of", "strings"]
+-}
+zip_list_with_list_of_list :: [p] -> [[q]] -> [[(p, q)]]
+zip_list_with_list_of_list s l =
+  case l of
+    [] -> []
+    e:l' ->
+      let n = length e
+      in zip (take n s) e : zip_list_with_list_of_list (drop n s) l'
+
+-- | 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
+
+-- | 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
+
+-- | 'minimum' and 'maximum' in one pass.
+--
+-- > minmax "minmax" == ('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
+
+-- | Append /k/ to the right of /l/ until result has /n/ places.
+--   Truncates long input lists.
+--
+-- > 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 '!' 3 "truncate" == "tru"
+pad_right :: a -> Int -> [a] -> [a]
+pad_right k n l = take n (l ++ repeat k)
+
+-- | Variant that errors if the input list has more than /n/ places.
+--
+-- > map (pad_right_err '!' 3) ["x","xy","xyz","xyz!"]
+pad_right_err :: t -> Int -> [t] -> [t]
+pad_right_err k n l = if length l > n then error "pad_right_err?" else pad_right k n l
+
+-- | Variant that will not truncate long inputs.
+--
+-- > pad_right_no_truncate '!' 3 "truncate" == "truncate"
+pad_right_no_truncate :: a -> Int -> [a] -> [a]
+pad_right_no_truncate k n l = if length l > n then l else pad_right k n l
+
+-- | 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 []
+
+-- | 'fromRight' of 'embedding'
+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 = T.is_right (embedding (p,q))
+
+-- * 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
+
+-- * 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"
+> let t = group_tree ((==) '{',(==) '}') l
+> 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.Tree (Maybe a)
+group_tree (open_f,close_f) =
+    let unit e = Tree.Node (Just e) []
+        nil = Tree.Node Nothing []
+        insert_e (Tree.Node t l) e = Tree.Node t (e:l)
+        reverse_n (Tree.Node t l) = Tree.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
+              [] -> Tree.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.
+
+> map (remove_ix 5) ["remove","removed"] == ["remov","removd"]
+> remove_ix 5 "short" -- error
+-}
+remove_ix :: Int -> [a] -> [a]
+remove_ix k l = let (p,q) = splitAt k l in p ++ tail q
+
+{- | Delete element at ix from list (c.f. remove_ix, this has a more specific error if index does not exist).
+
+> delete_at 3 "deleted" == "delted"
+> delete_at 8 "deleted" -- error
+-}
+delete_at :: (Eq t, Num t) => t -> [a] -> [a]
+delete_at ix l =
+  case (ix,l) of
+    (_,[]) -> error "delete_at: index does not exist"
+    (0,_:l') -> l'
+    (_,e:l') -> e : delete_at (ix - 1) l'
+
+-- | Select or remove elements at set of indices.
+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 elements at set of indices.
+--
+-- > select_ixs [1,3] "select" == "ee"
+select_ixs :: [Int] -> [a] -> [a]
+select_ixs = operate_ixs True
+
+-- | Remove elements at set of indices.
+--
+-- > 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) = splitAt i p
+        (s,t) = headTail r
+    in q ++ (f s : t)
+
+-- | List equality, ignoring indicated indices.
+--
+-- > list_eq_ignoring_indices [3,5] "abcdefg" "abc.e.g" == True
+list_eq_ignoring_indices :: (Eq t,Integral i) => [i] -> [t] -> [t] -> Bool
+list_eq_ignoring_indices x =
+  let f n p q =
+        case (p,q) of
+          ([],[]) -> True
+          ([],_) -> False
+          (_,[]) -> False
+          (p1:p',q1:q') -> (n `elem` x || p1 == q1) &&
+                           f (n + 1) p' q'
+  in f 0
+
+-- | Edit list to have /v/ at indices /k/.
+--   Replacement assoc-list must be ascending.
+--   All replacements must be in range.
+--
+-- > list_set_indices [(2,'C'),(4,'E')] "abcdefg" == "abCdEfg"
+-- > list_set_indices [] "abcdefg" == "abcdefg"
+-- > list_set_indices [(9,'I')] "abcdefg" == undefined
+list_set_indices :: (Eq ix, Num ix) => [(ix,t)] -> [t] -> [t]
+list_set_indices =
+  let f n r l =
+        case (r,l) of
+          ([],_) -> l
+          (_,[]) -> error "list_set_indices: out of range?"
+          ((k,v):r',l0:l') -> if n == k
+                              then v : f (n + 1) r' l'
+                              else l0 : f (n + 1) r l'
+  in f 0
+
+-- | Variant of 'list_set_indices' with one replacement.
+list_set_ix :: (Eq t, Num t) => t -> a -> [a] -> [a]
+list_set_ix k v = list_set_indices [(k,v)]
+
+-- | 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)
+
+{- | Index list from the end, assuming the list is longer than n + 1.
+
+atFromEnd [1 .. 30] 0 == 30
+atFromEnd [1..100] 15 == 85
+-}
+atFromEnd :: [t] -> Int -> t
+atFromEnd lst n =
+  let loop xs ys = last (zipWith const xs ys)
+  in loop lst (drop n lst)
+
diff --git a/Music/Theory/Map.hs b/Music/Theory/Map.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Map.hs
@@ -0,0 +1,17 @@
+-- | 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
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math.hs
@@ -0,0 +1,290 @@
+-- | Math functions.
+module Music.Theory.Math where
+
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ratio {- base -}
+
+import qualified Music.Theory.Math.Convert as T {- hmt-base -}
+
+-- | 'mod' 5.
+mod5 :: Integral i => i -> i
+mod5 n = n `mod` 5
+
+-- | 'mod' 7.
+mod7 :: Integral i => i -> i
+mod7 n = n `mod` 7
+
+-- | 'mod' 12.
+mod12 :: Integral i => i -> i
+mod12 n = n `mod` 12
+
+-- | 'mod' 16.
+mod16 :: Integral i => i -> i
+mod16 n = n `mod` 16
+
+-- | <http://reference.wolfram.com/mathematica/ref/FractionalPart.html>
+--   i.e. 'properFraction'
+--
+-- > integral_and_fractional_parts 1.5 == (1,0.5)
+integral_and_fractional_parts :: (Integral i, RealFrac t) => t -> (i,t)
+integral_and_fractional_parts = properFraction
+
+-- | 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 -}
+-- > plot_p1_ln [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
+
+-- | Type specialised 'round'
+round_int :: RealFrac t => t -> Int
+round_int = round
+
+-- | Type-specialised 'fromIntegral'
+from_integral_to_int :: Integral i => i -> Int
+from_integral_to_int = fromIntegral
+
+-- | Type-specialised 'id'
+int_id :: Int -> Int
+int_id = id
+
+-- | Is /r/ zero to /k/ decimal places.
+--
+-- > map (flip zero_to_precision 0.00009) [4,5] == [True,False]
+-- > map (zero_to_precision 4) [0.00009,1.00009] == [True,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>
+--
+-- > plot_p1_ln [map sawtooth_wave [-2.0,-1.99 .. 2.0]]
+sawtooth_wave :: RealFrac a => a -> a
+sawtooth_wave n = n - floor_f n
+
+-- | Predicate that is true if @n/d@ can be simplified, ie. where
+-- 'gcd' of @n@ and @d@ is not @1@.
+--
+-- > map rational_simplifies [(2,3),(4,6),(5,7)] == [False,True,False]
+rational_simplifies :: Integral a => (a,a) -> Bool
+rational_simplifies (n,d) = gcd n d /= 1
+
+-- | 'numerator' and 'denominator' of rational.
+rational_nd :: Integral t => 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
+
+-- | Sum of numerator & denominator.
+ratio_nd_sum :: Integral t => Ratio t -> t
+ratio_nd_sum r = numerator r + denominator r
+
+-- | Is /n/ a whole (integral) value.
+--
+-- > map real_is_whole [-1.0,-0.5,0.0,0.5,1.0] == [True,False,True,False,True]
+real_is_whole :: Real n => n -> Bool
+real_is_whole = (== 1) . denominator . toRational
+
+-- | '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
+
+-- | Variant of 'recip' that checks input for zero.
+--
+-- > map recip [1,1/2,0,-1]
+-- > map recip_m [1,1/2,0,-1] == [Just 1,Just 2,Nothing,Just (-1)]
+recip_m :: (Eq a, Fractional a) => a -> Maybe a
+recip_m x = if x == 0 then Nothing else Just (recip x)
+
+-- * 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 (sqrt) 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
+
+-- | Calculate /n/th root of /x/.
+--
+-- > 12 `nth_root` 2 == 1.0594630943592953
+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)
+        eq = uncurry (==)
+    in fst (until eq f (x, x/n))
+
+-- | Arithmetic mean (average) of a list.
+--
+-- > map arithmetic_mean [[-3..3],[0..5],[1..5],[3,5,7],[7,7],[3,9,10,11,12]] == [0,2.5,3,5,7,9]
+arithmetic_mean :: Fractional a => [a] -> a
+arithmetic_mean x = sum x / fromIntegral (length x)
+
+-- | Numerically stable mean
+--
+-- > map ns_mean [[-3..3],[0..5],[1..5],[3,5,7],[7,7],[3,9,10,11,12]] == [0,2.5,3,5,7,9]
+ns_mean :: Floating a => [a] -> a
+ns_mean =
+    let f (m,n) x = (m + (x - m) / (n + 1),n + 1)
+    in fst . foldl' f (0,0)
+
+-- | Square of /n/.
+--
+-- > square 5 == 25
+square :: Num a => a -> a
+square n = n * n
+
+-- | The totient function phi(n), also called Euler's totient function.
+--
+-- > import Sound.SC3.Plot {- hsc3-plot -}
+-- > plot_p1_stp [map totient [1::Int .. 100]]
+totient :: Integral i => i -> i
+totient n = genericLength (filter (==1) (map (gcd n) [1..n]))
+
+{- | The /n/-th order Farey sequence.
+
+> farey 1 == [0,                                                                                    1]
+> farey 2 == [0,                                        1/2,                                        1]
+> farey 3 == [0,                        1/3,            1/2,            2/3,                        1]
+> farey 4 == [0,                1/4,    1/3,            1/2,            2/3,    3/4,                1]
+> farey 5 == [0,            1/5,1/4,    1/3,    2/5,    1/2,    3/5,    2/3,    3/4,4/5,            1]
+> farey 6 == [0,        1/6,1/5,1/4,    1/3,    2/5,    1/2,    3/5,    2/3,    3/4,4/5,5/6,        1]
+> farey 7 == [0,    1/7,1/6,1/5,1/4,2/7,1/3,    2/5,3/7,1/2,4/7,3/5,    2/3,5/7,3/4,4/5,5/6,6/7,    1]
+> farey 8 == [0,1/8,1/7,1/6,1/5,1/4,2/7,1/3,3/8,2/5,3/7,1/2,4/7,3/5,5/8,2/3,5/7,3/4,4/5,5/6,6/7,7/8,1]
+-}
+farey :: Integral i => i -> [Ratio i]
+farey n =
+  let step (a,b,c,d) =
+        if c > n
+        then Nothing
+        else let k = (n + b) `quot` d in Just (c % d, (c,d,k * c - a,k * d - b))
+  in 0 : unfoldr step (0,1,1,n)
+
+-- | The length of the /n/-th order Farey sequence.
+--
+-- > map farey_length [1 .. 12] == [2,3,5,7,11,13,19,23,29,33,43,47]
+-- > map (length . farey) [1 .. 12] == map farey_length [1 .. 12]
+farey_length :: Integral i => i -> i
+farey_length n = if n == 0 then 1 else farey_length (n - 1) + totient n
+
+-- | Function to generate the Stern-Brocot tree from an initial row.
+--   '%' normalises so 1/0 cannot be written as a 'Rational', hence (n,d).
+stern_brocot_tree_f :: Num n => [(n,n)] -> [[(n,n)]]
+stern_brocot_tree_f =
+   let med_f (n1,d1) (n2,d2) = (n1 + n2,d1 + d2)
+       f x = concat (transpose [x, zipWith med_f x (tail x)])
+   in iterate f
+
+{- | The Stern-Brocot tree from (0/1,1/0).
+
+> let t = stern_brocot_tree
+> t !! 0 == [(0,1),(1,0)]
+> t !! 1 == [(0,1),(1,1),(1,0)]
+> t !! 2 == [(0,1),(1,2),(1,1),(2,1),(1,0)]
+> t !! 3 == [(0,1),(1,3),(1,2),(2,3),(1,1),(3,2),(2,1),(3,1),(1,0)]
+
+> map length (take 12 stern_brocot_tree) == [2,3,5,9,17,33,65,129,257,513,1025,2049] -- A000051
+-}
+stern_brocot_tree :: Num n => [[(n,n)]]
+stern_brocot_tree = stern_brocot_tree_f [(0,1),(1,0)]
+
+-- | Left-hand (rational) side of the the Stern-Brocot tree, ie, from (0/1,1/1).
+stern_brocot_tree_lhs :: Num n => [[(n,n)]]
+stern_brocot_tree_lhs = stern_brocot_tree_f [(0,1),(1,1)]
+
+{- | 'stern_brocot_tree_f' as 'Ratio's, for finite subsets.
+
+> let t = stern_brocot_tree_f_r [0,1]
+> t !! 1 == [0,1/2,1]
+> t !! 2 == [0,1/3,1/2,2/3,1]
+> t !! 3 == [0,1/4,1/3,2/5,1/2,3/5,2/3,3/4,1]
+> t !! 4 == [0,1/5,1/4,2/7,1/3,3/8,2/5,3/7,1/2,4/7,3/5,5/8,2/3,5/7,3/4,4/5,1]
+-}
+stern_brocot_tree_f_r :: Integral n => [Ratio n] -> [[Ratio n]]
+stern_brocot_tree_f_r = map (map (uncurry (%))) . stern_brocot_tree_f . map rational_nd
+
+{- | Outer product of vectors represented as lists, c.f. liftM2
+
+> outer_product (*) [2..5] [2..5] == [[4,6,8,10],[6,9,12,15],[8,12,16,20],[10,15,20,25]]
+> liftM2 (*) [2..5] [2..5] == [4,6,8,10,6,9,12,15,8,12,16,20,10,15,20,25]
+-}
+outer_product :: (a -> b -> c) -> [a] -> [b] -> [[c]]
+outer_product f xs ys = map (flip map ys . f) xs
diff --git a/Music/Theory/Math/Constant.hs b/Music/Theory/Math/Constant.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Constant.hs
@@ -0,0 +1,16 @@
+-- | IEE754 constants (c.f. Numeric.MathFunctions.Constants)
+module Music.Theory.Math.Constant where
+
+-- | The smallest 'Double' n such that 1 + n /= 1.
+epsilonValue :: Double
+epsilonValue =
+  let (signif, expo) = decodeFloat (1.0 :: Double)
+  in encodeFloat (signif + 1) expo - 1.0
+
+-- | Largest representable finite value.
+largestFiniteValue :: Double
+largestFiniteValue = 1.7976931348623157e308
+
+-- | The smallest representable positive normalized value.
+smallestNormalizedValue :: Double
+smallestNormalizedValue = 2.2250738585072014e-308
diff --git a/Music/Theory/Math/Convert.hs b/Music/Theory/Math/Convert.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Convert.hs
@@ -0,0 +1,1147 @@
+{- | 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 -}
+
+-- * Numerical conversions
+
+-- | Type specialised 'realToFrac'
+real_to_float :: Real t => t -> Float
+real_to_float = realToFrac
+
+-- | Type specialised 'realToFrac'
+--
+-- > let n = sqrt (-1) in (n,real_to_double n)
+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
+
+double_to_word8 :: (Double -> Word8) -> Double -> Word8
+double_to_word8 = id
+
+{- | Type-specialise /f/, ie. round, ceiling, truncate
+
+> map (double_to_int round) [0, 0.25 .. 1] == [0, 0, 0, 1, 1]
+> map (double_to_int ceiling) [0, 0.25 .. 1] == [0, 1, 1, 1, 1]
+> map (double_to_int floor) [0, 0.25 .. 1] == [0, 0, 0, 0, 1]
+> map (double_to_int truncate) [0, 0.25 .. 1] == [0, 0, 0, 0, 1]
+-}
+double_to_int :: (Double -> Int) -> Double -> Int
+double_to_int = id
+
+-- | Type specialised 'fromIntegral'
+int_to_rational :: Int -> Rational
+int_to_rational = fromIntegral
+
+-- 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_integral :: Integral i => Int -> i
+int_to_integral = 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/Histogram.hs b/Music/Theory/Math/Histogram.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Math/Histogram.hs
@@ -0,0 +1,38 @@
+-- | c.f. Statistics.Sample.Histogram (this is much slower but doesn't require any libraries)
+module Music.Theory.Math.Histogram where
+
+import Music.Theory.List {- hmt-base -}
+import Music.Theory.Math.Constant {- hmt-base -}
+
+{- | Calculate histogram on numBins places.  Returns the range of each bin and the number of elements in each.
+
+
+> map (snd . bHistogram 10) [[1 .. 10],[1,1,1,2,2,3,10]] == [[1,1,1,1,1,1,1,1,1,1],[3,2,1,0,0,0,0,0,0,1]]
+-}
+bHistogram :: Int -> [Double] -> ([(Double, Double)], [Int])
+bHistogram numBins xs =
+  let (lo, hi) = bHistogramRange numBins xs
+      d = (hi - lo) / fromIntegral numBins
+      step i = lo + d * fromIntegral i
+      lhs_seq = map step [0 .. numBins - 1]
+      rng_seq = map (\n -> (n, n + d)) lhs_seq
+      cnt_seq = map (\rng -> length (filterInRange rng xs)) rng_seq
+  in (rng_seq, cnt_seq)
+
+{- | Calculate range.
+
+> bHistogramRange 10 (replicate 10 1) == (0.9, 1.1)
+> bHistogramRange 10 (replicate 10 0) == (-1, 1)
+> bHistogramRange 10 [1 .. 10] == (0.5, 10.5)
+> bHistogramRange 25 [1 .. 10] == (0.8125,10.1875)
+-}
+bHistogramRange :: Int -> [Double] -> (Double, Double)
+bHistogramRange numBins xs =
+  let d = if numBins == 1 then 0 else (hi - lo) / ((fromIntegral numBins - 1) * 2)
+      (lo, hi) = minmax xs
+  in if numBins < 1 || null xs
+     then error "bHistogramRange: empty sample"
+     else if lo == hi
+          then let a = abs lo / 10
+               in if a < smallestNormalizedValue then (-1,1) else (lo - a, lo + a)
+          else (lo-d, hi+d)
diff --git a/Music/Theory/Maybe.hs b/Music/Theory/Maybe.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Maybe.hs
@@ -0,0 +1,91 @@
+-- | 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 '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
+
diff --git a/Music/Theory/Monad.hs b/Music/Theory/Monad.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Monad.hs
@@ -0,0 +1,22 @@
+-- | Monad functions.
+module Music.Theory.Monad where
+
+-- | 'sequence_' of 'repeat'.
+repeatM_ :: Monad m => m a -> m ()
+repeatM_ = sequence_ . repeat
+
+-- | Monadic variant of 'iterate'.
+iterateM_ :: Monad m => (st -> m st) -> st -> m ()
+iterateM_ f st = do
+  st' <- f st
+  iterateM_ f st'
+
+-- | 'fmap' of 'concat' of 'mapM'
+concatMapM :: (Functor m, Monad m) => (t -> m [u]) -> [t] -> m [u]
+concatMapM f = fmap concat . mapM f
+
+-- | If i then j else k.
+m_if :: Monad m => (m Bool,m t,m t) -> m t
+m_if (i,j,k) = do
+  r <- i
+  if r then j else k
diff --git a/Music/Theory/Opt.hs b/Music/Theory/Opt.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Opt.hs
@@ -0,0 +1,156 @@
+{- | Very simple command line interface option parser.
+
+Only allows options of the form --key=value, with the form --key equal to --key=True.
+
+A list of OptUsr describes the options and provides default values.
+
+'get_opt_arg' merges user and default values into a table with values for all options.
+
+To fetch options use 'opt_get' and 'opt_read'.
+
+-}
+module Music.Theory.Opt where
+
+import Control.Monad {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import System.Environment {- base -}
+import System.Exit {- base -}
+
+import qualified Data.List.Split as Split {- split -}
+
+import qualified Music.Theory.Either as T {- hmt-base -}
+import qualified Music.Theory.Read as T {- hmt-base -}
+
+{- | (Key,Value)
+
+Key does not include leading '--'.
+-}
+type Opt = (String,String)
+
+-- | (Key,Default-Value,Type,Note)
+type OptUsr = (String,String,String,String)
+
+-- | Re-write default values at OptUsr.
+opt_usr_rw_def :: [Opt] -> [OptUsr] -> [OptUsr]
+opt_usr_rw_def rw =
+  let f (k,v,ty,dsc) = case lookup k rw of
+                         Just v' -> (k,v',ty,dsc)
+                         Nothing -> (k,v,ty,dsc)
+  in map f
+
+-- | OptUsr to Opt.
+opt_plain :: OptUsr -> Opt
+opt_plain (k,v,_,_) = (k,v)
+
+-- | OptUsr to help string, indent is two spaces.
+opt_usr_help :: OptUsr -> String
+opt_usr_help (k,v,t,n) = concat ["  ",k,":",t," -- ",n,"; default=",if null v then "Nil" else v]
+
+-- | 'unlines' of 'opt_usr_help'
+opt_help :: [OptUsr] -> String
+opt_help = unlines . map opt_usr_help
+
+-- | Lookup Key in Opt, error if non-existing.
+opt_get :: [Opt] -> String -> String
+opt_get o k = fromMaybe (error ("opt_get: " ++ k)) (lookup k o)
+
+-- | Variant that returns Nothing if the result is the empty string, else Just the result.
+opt_get_nil :: [Opt] -> String -> Maybe String
+opt_get_nil o k = let r = opt_get o k in if null r then Nothing else Just r
+
+-- | 'read' of 'get_opt'
+opt_read :: Read t => [Opt] -> String -> t
+opt_read o = T.read_err . opt_get o
+
+-- | Parse k or k=v string, else error.
+opt_param_parse :: String -> Opt
+opt_param_parse p =
+  case Split.splitOn "=" p of
+    [lhs] -> (lhs,"True")
+    [lhs,rhs] -> (lhs,rhs)
+    _ -> error ("opt_param_parse: " ++ p)
+
+-- | Parse option string of form "--opt" or "--key=value".
+--
+-- > opt_parse "--opt" == Just ("opt","True")
+-- > opt_parse "--key=value" == Just ("key","value")
+opt_parse :: String -> Maybe Opt
+opt_parse s =
+  case s of
+    '-':'-':p -> Just (opt_param_parse p)
+    _ -> Nothing
+
+-- | Parse option sequence, collating options and non-options.
+--
+-- > opt_set_parse (words "--a --b=c d") == ([("a","True"),("b","c")],["d"])
+opt_set_parse :: [String] -> ([Opt],[String])
+opt_set_parse =
+  let f s = maybe (Right s) Left (opt_parse s)
+  in T.partition_eithers . map f
+
+-- | Left-biased Opt merge.
+opt_merge :: [Opt] -> [Opt] -> [Opt]
+opt_merge p q =
+  let x = map fst p
+  in p ++ filter (\(k,_) -> k `notElem` x) q
+
+-- | Process argument list.
+opt_proc :: [OptUsr] -> [String] -> ([Opt], [String])
+opt_proc def arg =
+  let (o,a) = opt_set_parse arg
+  in (opt_merge o (map opt_plain def),a)
+
+-- | Usage text
+type OptHelp = [String]
+
+-- | Format usage pre-amble and 'opt_help'.
+opt_help_pp :: OptHelp -> [OptUsr] -> String
+opt_help_pp usg def = unlines (usg ++ ["",opt_help def])
+
+-- | Print help and exit.
+opt_usage :: OptHelp -> [OptUsr] -> IO ()
+opt_usage usg def = putStrLn (opt_help_pp usg def)  >> exitWith ExitSuccess
+
+-- | Print help and error.
+opt_error :: OptHelp -> [OptUsr] -> t
+opt_error usg def = error (opt_help_pp usg def)
+
+-- | Verify that all Opt have keys that are in OptUsr
+opt_verify :: OptHelp -> [OptUsr] -> [Opt] -> IO ()
+opt_verify usg def =
+  let k_set = map (fst . opt_plain) def
+      f (k,_) = if k `elem` k_set
+                then return ()
+                else putStrLn ("Unknown Key: " ++ k ++ "\n") >> opt_usage usg def
+  in mapM_ f
+
+-- | 'opt_set_parse' and maybe 'opt_verify' and 'opt_merge' of 'getArgs'.
+--   If arguments include -h or --help run 'opt_usage'
+opt_get_arg :: Bool -> OptHelp -> [OptUsr] -> IO ([Opt],[String])
+opt_get_arg chk usg def = do
+  a <- getArgs
+  when ("-h" `elem` a || "--help" `elem` a) (opt_usage usg def)
+  let (o,p) = opt_set_parse a
+  when chk (opt_verify usg def o)
+  return (opt_merge o (map opt_plain def),p)
+
+-- | Parse param set, one parameter per line.
+--
+-- > opt_param_set_parse "a\nb=c" == [("a","True"),("b","c")]
+opt_param_set_parse :: String -> [Opt]
+opt_param_set_parse = map opt_param_parse . lines
+
+-- | Simple scanner over argument list.
+opt_scan :: [String] -> String -> Maybe String
+opt_scan a k =
+  let (o,_) = opt_set_parse a
+  in fmap snd (find ((== k) . fst) o)
+
+-- | Scanner with default value.
+opt_scan_def :: [String] -> (String,String) -> String
+opt_scan_def a (k,v) = fromMaybe v (opt_scan a k)
+
+-- | Reading scanner with default value.
+opt_scan_read :: Read t => [String] -> (String,t) -> t
+opt_scan_read a (k,v) = maybe v read (opt_scan a k)
diff --git a/Music/Theory/Ord.hs b/Music/Theory/Ord.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Ord.hs
@@ -0,0 +1,42 @@
+-- | 'Ordering' functions
+module Music.Theory.Ord where
+
+-- | Minimum by /f/.
+min_by :: Ord a => (t -> a) -> t -> t -> t
+min_by f p q = if f p <= f q then p else q
+
+-- | 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/Permutations.hs b/Music/Theory/Permutations.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Permutations.hs
@@ -0,0 +1,231 @@
+-- | Permutation functions.
+module Music.Theory.Permutations where
+
+import Data.List {- base -}
+import qualified Numeric {- base -}
+
+import qualified Music.Theory.List as L {- hmt-base -}
+
+-- | Factorial function.
+--
+-- > (factorial 20,maxBound::Int)
+factorial :: Integral n => n -> n
+factorial n = product [1..n]
+
+-- | Number of /k/ element permutations of a set of /n/ elements.
+--
+-- > let f = nk_permutations in (f 3 2,f 3 3,f 4 3,f 4 4,f 13 3,f 12 12) == (6,6,24,24,1716,479001600)
+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 12 == 479001600
+-- > n_permutations 16 `div` 1000000 == 20922789
+n_permutations :: (Integral a) => a -> a
+n_permutations n = nk_permutations n n
+
+-- | Permutation given as a zero-indexed list of destination indices.
+type Permutation = [Int]
+
+{- | Generate the permutation from /p/ to /q/, ie. the permutation
+     that, when applied to /p/, gives /q/.
+
+> p = permutation "abc" "bac"
+> p == [1,0,2]
+> apply_permutation p "abc" == "bac"
+-}
+permutation :: Eq t => [t] -> [t] -> Permutation
+permutation p q =
+    let f x = L.elem_index_unique x p
+    in map f q
+
+-- | Permutation to list of swaps, ie. 'zip' [0..]
+--
+-- > permutation_to_swaps [0,2,1,3] == [(0,0),(1,2),(2,1),(3,3)]
+permutation_to_swaps :: Permutation -> [(Int,Int)]
+permutation_to_swaps = zip [0..]
+
+-- | Inverse of 'permutation_to_swaps', ie. 'map' 'snd' '.' 'sort'
+swaps_to_permutation :: [(Int,Int)] -> Permutation
+swaps_to_permutation = map snd . sort
+
+-- | List of cycles to list of swaps.
+--
+-- > cycles_to_swaps [[0,2],[1],[3,4]] == [(0,2),(1,1),(2,0),(3,4),(4,3)]
+cycles_to_swaps :: [[Int]] -> [(Int,Int)]
+cycles_to_swaps = sort . concatMap (L.adj2_cyclic 1)
+
+-- > swaps_to_cycles [(0,2),(1,1),(2,0),(3,4),(4,3)] == [[0,2],[1],[3,4]]
+swaps_to_cycles :: [(Int, Int)] -> [[Int]]
+swaps_to_cycles s =
+  let z = length s
+      next k = L.lookup_err k s
+      trace k =
+        let f r i = let j = next i in if j == k then reverse r else f (j : r) j
+        in f [k] k
+      step r k =
+        if k == z
+        then reverse r
+        else if k `elem` concat r then step r (k + 1) else step (trace k : r) (k + 1)
+  in step [] 0
+
+{- | Apply permutation /f/ to /p/.
+
+> let p = permutation [1..4] [4,3,2,1]
+> p == [3,2,1,0]
+> apply_permutation p [1..4] == [4,3,2,1]
+-}
+apply_permutation :: Permutation -> [t] -> [t]
+apply_permutation f p = map (p !!) f
+
+-- | Composition of 'apply_permutation' and 'from_cycles_zero_indexed'.
+--
+-- > apply_permutation_c_zero_indexed [[0,3],[1,2]] [1..4] == [4,3,2,1]
+-- > apply_permutation_c_zero_indexed [[0,2],[1],[3,4]] [1..5] == [3,2,1,5,4]
+-- > apply_permutation_c_zero_indexed [[0,1,4],[2,3]] [1..5] == [2,5,4,3,1]
+-- > apply_permutation_c_zero_indexed [[0,1,3],[2,4]] [1..5] == [2,4,5,1,3]
+apply_permutation_c_zero_indexed :: [[Int]] -> [a] -> [a]
+apply_permutation_c_zero_indexed = apply_permutation . from_cycles_zero_indexed
+
+-- > p_inverse [2,7,4,9,8,3,5,0,6,1] == [7,9,0,5,2,6,8,1,4,3]
+p_inverse :: Permutation -> Permutation
+p_inverse = map snd . sort . flip zip [0..]
+
+p_cycles :: Permutation -> [[Int]]
+p_cycles = swaps_to_cycles . permutation_to_swaps
+
+{- | True if the inverse of /p/ is /p/.
+
+> non_invertible [1,0,2] == True
+> non_invertible [2,7,4,9,8,3,5,0,6,1] == False
+
+> let p = permutation [1..4] [4,3,2,1]
+> non_invertible p == True && p_cycles p == [[0,3],[1,2]]
+-}
+non_invertible :: Permutation -> Bool
+non_invertible p = p == p_inverse p
+
+-- | Generate a permutation from the cycles /c/ (zero-indexed)
+--
+-- > apply_permutation (from_cycles_zero_indexed [[0,1,2,3]]) [1..4] == [2,3,4,1]
+from_cycles_zero_indexed :: [[Int]] -> Permutation
+from_cycles_zero_indexed = swaps_to_permutation . cycles_to_swaps
+
+from_cycles_one_indexed :: [[Int]] -> Permutation
+from_cycles_one_indexed = from_cycles_zero_indexed . map (map (subtract 1))
+
+-- | Generate all permutations of size /n/ (naive)
+--
+-- > let r = [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
+-- > map one_line (permutations_n 3) == r
+permutations_n :: Int -> [Permutation]
+permutations_n n =
+  let minus [] _ = []
+      minus (x:xs) i = if x < i then x : minus xs i else xs
+      f [] = [[]]
+      f xs = [i : ys | i <- xs , ys <- f (xs `minus` i)]
+  in case n of
+       0 -> []
+       1 -> [[0]]
+       _ -> f [0 .. n - 1]
+
+p_size :: Permutation -> Int
+p_size = length
+
+{- | Composition of /q/ then /p/.
+
+> let p = from_cycles_zero_indexed [[0,2],[1],[3,4]]
+> let q = from_cycles_zero_indexed [[0,1,4],[2,3]]
+> let r = p `compose` q
+> apply_permutation r [1,2,3,4,5] == [2,4,5,1,3]
+-}
+compose :: Permutation -> Permutation -> Permutation
+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
+
+-- | One-indexed 'p_cycles'
+cycles_one_indexed :: Permutation -> [[Int]]
+cycles_one_indexed = map (map (+ 1)) . p_cycles
+
+{- | 'flip' of 'compose'
+
+> cycles_one_indexed (from_cycles_one_indexed [[1,5],[2,3,6],[4]] `permutation_mul` from_cycles_one_indexed [[1,6,4],[2],[3,5]])
+-}
+permutation_mul :: Permutation -> Permutation -> Permutation
+permutation_mul p q = compose q p
+
+-- | Two line notation of /p/.
+--
+-- > two_line (permutation [0,1,3] [1,0,3]) == ([1,2,3],[2,1,3])
+two_line :: Permutation -> ([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]
+--
+-- > let r = [[1,2,3],[1,3,2],[2,1,3],[2,3,1],[3,1,2],[3,2,1]]
+-- > map one_line (permutations_n 3) == r
+one_line :: Permutation -> [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
+-- > unwords (map one_line_compact p) == "123 132 213 231 312 321"
+one_line_compact :: Permutation -> String
+one_line_compact =
+    let f n = if n >= 0 && n <= 15
+              then Numeric.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 -> [[Permutation]]
+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)
+
+import Data.List {- base -}
+partition not (map non_invertible (permutations_n 4))
+putStrLn $ unlines $ map unwords $ permutations ["A0","A1","B0"]
+
+-}
diff --git a/Music/Theory/Read.hs b/Music/Theory/Read.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Read.hs
@@ -0,0 +1,197 @@
+-- | Read functions.
+module Music.Theory.Read where
+
+import Data.Char {- base -}
+import Data.List {- base -}
+import Data.Maybe {- base -}
+import Data.Ratio {- base -}
+import Data.Word {- 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'.
+--
+-- > read_maybe "1.0" :: Maybe Int
+-- > read_maybe "1.0" :: Maybe Float
+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 = fromMaybe x (read_maybe s)
+
+-- | Variant of 'read_maybe' that errors on 'Nothing', printing message.
+read_err_msg :: Read a => String -> String -> a
+read_err_msg msg s = fromMaybe (error ("read_err: " ++ msg ++ ": " ++ s)) (read_maybe s)
+
+-- | Default message.
+read_err :: Read a => String -> a
+read_err = read_err_msg "read_maybe failed"
+
+-- | 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]
+-- > map read_integral_allow_commas_maybe ["123456","123,456","1234,56","123,456,789"] == r
+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 (/= ',') 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)
+
+-- | Type specialised.
+--
+-- > map read_int_allow_commas ["123456","123,456","123,456,789"] == [123456,123456,123456789]
+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","x"] == [Just 2,Nothing,Just 2,Nothing]
+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
+
+-- | Read binary integer.
+--
+-- > mapMaybe read_bin (words "000 001 010 011 100 101 110 111") == [0 .. 7]
+read_bin :: Integral a => String -> Maybe a
+read_bin = fmap fst . listToMaybe . readInt 2 (`elem` "01") digitToInt
+
+-- | Erroring variant.
+read_bin_err :: Integral a => String -> a
+read_bin_err = fromMaybe (error "read_bin") . read_bin
+
+-- * HEX
+
+-- | Error variant of 'readHex'.
+--
+-- > read_hex_err "F0B0" == 61616
+read_hex_err :: (Eq n, Integral n) => String -> n
+read_hex_err = reads_to_read_precise_err "readHex" readHex
+
+-- | Read hex value from string of at most /k/ places.
+read_hex_sz :: (Eq n, Integral n) => Int -> String -> n
+read_hex_sz k str =
+  if length str > k
+  then error "read_hex_sz? = > K"
+  else case readHex str of
+         [(r,[])] -> r
+         _ -> error "read_hex_sz? = PARSE"
+
+-- | Read hexadecimal representation of 32-bit unsigned word.
+--
+-- > map read_hex_word32 ["00000000","12345678","FFFFFFFF"] == [minBound,305419896,maxBound]
+read_hex_word32 :: String -> Word32
+read_hex_word32 = read_hex_sz 8
+
+-- * Rational
+
+-- | Parser for 'rational_pp'.
+--
+-- > map rational_parse ["1","3/2","5/4","2"] == [1,3/2,5/4,2]
+-- > rational_parse "" == undefined
+rational_parse :: (Read t,Integral t) => String -> Ratio t
+rational_parse s =
+  case break (== '/') s of
+    ([],_) -> error "rational_parse"
+    (n,[]) -> read n % 1
+    (n,_:d) -> read n % read d
diff --git a/Music/Theory/Show.hs b/Music/Theory/Show.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Show.hs
@@ -0,0 +1,129 @@
+-- | Show functions.
+module Music.Theory.Show where
+
+import Data.Char {- base -}
+import Data.Ratio {- base -}
+import Numeric {- base -}
+
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Math as T {- hmt-base -}
+import qualified Music.Theory.Math.Convert as T {- hmt-base -}
+
+-- * DIFF
+
+-- | Show positive and negative values always with sign, maybe show zero, maybe right justify.
+--
+-- > map (num_diff_str_opt (True,2)) [-2,-1,0,1,2] == ["-2","-1"," 0","+1","+2"]
+num_diff_str_opt :: (Ord a, Num a, Show a) => (Bool,Int) -> a -> String
+num_diff_str_opt (wr_0,k) n =
+  let r = case compare n 0 of
+            LT -> '-' : show (abs n)
+            EQ -> if wr_0 then "0" else ""
+            GT -> '+' : show n
+  in if k > 0 then T.pad_left ' ' k r else r
+
+-- | 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 = num_diff_str_opt (False,0)
+
+-- * RATIONAL
+
+-- | Pretty printer for 'Rational' using @/@ and eliding denominators of @1@.
+--
+-- > map rational_pp [1,3/2,5/4,2] == ["1","3/2","5/4","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, if /nil/ is True elide unit denominator.
+--
+-- > map (ratio_pp_opt True) [1,3/2,2] == ["1","3:2","2"]
+ratio_pp_opt :: Bool -> Rational -> String
+ratio_pp_opt nil r =
+  let f :: (Integer,Integer) -> String
+      f (n,d) = concat [show n,":",show d]
+  in case T.rational_nd r of
+       (n,1) -> if nil then show n else f (n,1)
+       x -> f x
+
+-- | 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 = ratio_pp_opt False
+
+-- | 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 3 (-100) == "-100.000"
+show_rational_decimal :: Int -> Rational -> String
+show_rational_decimal n = double_pp n . fromRational
+
+-- * REAL
+
+-- | Show /r/ as float to /k/ places.
+--
+-- > real_pp 4 (1/3 :: Rational) == "0.3333"
+-- > map (real_pp 4) [1,1.1,1.12,1.123,1.1234,1/0,sqrt (-1)]
+real_pp :: Real t => Int -> t -> String
+real_pp k = realfloat_pp k . T.real_to_double
+
+-- | Variant that writes `∞` for Infinity.
+--
+-- > putStrLn $ unwords $ map (real_pp_unicode 4) [1/0,-1/0]
+real_pp_unicode :: Real t => Int -> t -> [Char]
+real_pp_unicode k r =
+  case real_pp k r of
+    "Infinity" -> "∞"
+    "-Infinity" -> "-∞"
+    s -> s
+
+-- | Prints /n/ as integral or to at most /k/ decimal places. Does not print -0.
+--
+-- > real_pp_trunc 4 (1/3 :: Rational) == "0.3333"
+-- > map (real_pp_trunc 4) [1,1.1,1.12,1.123,1.1234] == ["1","1.1","1.12","1.123","1.1234"]
+-- > map (real_pp_trunc 4) [1.00009,1.00001] == ["1.0001","1"]
+-- > map (real_pp_trunc 2) [59.999,60.001,-0.00,-0.001]
+real_pp_trunc :: Real t => Int -> t -> String
+real_pp_trunc k n =
+  case break (== '.') (real_pp k n) of
+    (i,[]) -> i
+    (i,j) -> case T.drop_while_end (== '0') j of
+               "." -> if i == "-0" then "0" else i
+               z -> i ++ z
+
+-- | 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"]
+-- > map (realfloat_pp 4) [1,1.1,1.12,1.123,1.1234,1/0,sqrt (-1)]
+realfloat_pp :: RealFloat a => Int -> a -> String
+realfloat_pp k n = showFFloat (Just k) n ""
+
+-- | Type specialised 'realfloat_pp'.
+float_pp :: Int -> Float -> String
+float_pp = realfloat_pp
+
+-- | Type specialised 'realfloat_pp'.
+--
+-- > double_pp 4 0
+double_pp :: Int -> Double -> String
+double_pp = realfloat_pp
+
+-- * BIN
+
+-- | Read binary integer.
+--
+-- > unwords (map (show_bin Nothing) [0 .. 7]) == "0 1 10 11 100 101 110 111"
+-- > unwords (map (show_bin (Just 3)) [0 .. 7]) == "000 001 010 011 100 101 110 111"
+show_bin :: (Integral i,Show i) => Maybe Int -> i -> String
+show_bin k n = maybe id (T.pad_left '0') k (showIntAtBase 2 intToDigit n "")
diff --git a/Music/Theory/String.hs b/Music/Theory/String.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/String.hs
@@ -0,0 +1,70 @@
+-- | String functions.
+module Music.Theory.String where
+
+import Data.Char {- base -}
+import Data.List {- base -}
+
+-- | Case-insensitive '=='.
+--
+-- > map (str_eq_ci "ci") (words "CI ci Ci cI")
+str_eq_ci :: String -> String -> Bool
+str_eq_ci x y = map toUpper x == map toUpper y
+
+-- | 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 "\t\n        \t\n" == ""
+delete_trailing_whitespace :: String -> String
+delete_trailing_whitespace = reverse . dropWhile isSpace . reverse
+
+{- | Variant of 'unwords' that does not write spaces for NIL elements.
+
+> unwords_nil [] == ""
+> unwords_nil ["a"] == "a"
+> unwords_nil ["a",""] == "a"
+> unwords_nil ["a","b"] == "a b"
+> unwords_nil ["a","","b"] == "a b"
+> unwords_nil ["a","","","b"] == "a b"
+> unwords_nil ["a","b",""] == "a b"
+> unwords_nil ["a","b","",""] == "a b"
+> unwords_nil ["","a","b"] == "a b"
+> unwords_nil ["","","a","b"] == "a b"
+-}
+unwords_nil :: [String] -> String
+unwords_nil = unwords . filter (not . null)
+
+-- | Variant of 'unlines' that does not write empty lines for NIL elements.
+unlines_nil :: [String] -> String
+unlines_nil = unlines . filter (not . null)
+
+{- | unlines without a trailing newline.
+
+> unlines (words "a b c") == "a\nb\nc\n"
+> unlinesNoTrailingNewline (words "a b c") == "a\nb\nc"
+-}
+unlinesNoTrailingNewline :: [String] -> String
+unlinesNoTrailingNewline = intercalate "\n"
+
+{- | Capitalise first character of word.
+
+> capitalise "freqShift" == "FreqShift"
+-}
+capitalise :: String -> String
+capitalise x = toUpper (head x) : tail x
+
+{- | Downcase first character of word.
+
+> unCapitalise "FreqShift" == "freqShift"
+-}
+unCapitalise :: String -> String
+unCapitalise x = toLower (head x) : tail x
+
+-- | Apply function at each line of string.
+--
+-- > on_lines reverse "ab\ncde\nfg" == "ba\nedc\ngf\n"
+on_lines :: (String -> String) -> String -> String
+on_lines f = unlines . map f . lines
diff --git a/Music/Theory/Time/Duration.hs b/Music/Theory/Time/Duration.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Time/Duration.hs
@@ -0,0 +1,183 @@
+-- | Ordinary timing durations, in H:M:S:m (Hours:Minutes:Seconds:milliseconds)
+module Music.Theory.Time.Duration where
+
+import Text.Printf {- base -}
+
+import qualified Data.List.Split as Split {- split -}
+
+-- | 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.
+     The notation writes seconds fractionally, and allows hours and minutes to be elided if zero.
+-}
+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 Split.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'.
+     Inverse of read_duration.
+     Hours and minutes are always shown, even if zero.
+
+> show_duration (Duration 1 35 5 250) == "01:35:05.250"
+> show (Duration 1 15 0 000) == "01:15:00.000"
+> show (Duration 0 0 3 500) == "00:00:03.500"
+-}
+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
+
+-- | If minutes is not in (0,59) then edit hours.
+normalise_minutes :: Duration -> Duration
+normalise_minutes (Duration h m s ms) =
+    let (h',m') = m `divMod` 60
+    in Duration (h + h') m' s ms
+
+-- | If seconds is not in (0,59) then edit minutes.
+normalise_seconds :: Duration -> Duration
+normalise_seconds (Duration h m s ms) =
+    let (m',s') = s `divMod` 60
+    in Duration h (m + m') s' ms
+
+-- | If milliseconds is not in (0,999) then edit seconds.
+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 so that all parts are in normal ranges.
+normalise_duration :: Duration -> Duration
+normalise_duration =
+    normalise_minutes .
+    normalise_seconds .
+    normalise_milliseconds
+
+{- | Extract 'Duration' tuple applying filter function at each element
+
+> duration_to_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 as fractional hours.
+
+> 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 as fractional minutes.
+
+> 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 as fractional seconds.
+
+> duration_to_seconds (read "01:35:05.250") == 5705.25
+-}
+duration_to_seconds :: Fractional n => Duration -> n
+duration_to_seconds = (* 60) . duration_to_minutes
+
+{- | Inverse of duration_to_hours.
+
+> 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
+
+-- | Inverse of duration_to_minutes.
+minutes_to_duration :: RealFrac a => a -> Duration
+minutes_to_duration n = hours_to_duration (n / 60)
+
+-- | Inverse of duration_to_seconds.
+seconds_to_duration :: RealFrac a => a -> Duration
+seconds_to_duration n = minutes_to_duration (n / 60)
+
+-- | Empty (zero) duration.
+nil_duration :: Duration
+nil_duration = Duration 0 0 0 0
+
+-- | Negate the leftmost non-zero element of Duration.
+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'
+
+{- | Difference between two durations as a duration.
+     Implemented by translation to and from Rational fractional hours.
+
+> 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 -> Rational
+        (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/Notation.hs b/Music/Theory/Time/Notation.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Time/Notation.hs
@@ -0,0 +1,481 @@
+{- | Ordinary time and duration notations.
+     In terms of Weeks, Days, Hours, Minutes, Second and Centiseconds.
+     c.f. "Music.Theory.Time.Duration".
+-}
+module Music.Theory.Time.Notation where
+
+import Text.Printf {- base -}
+
+import qualified Data.List.Split as Split {- split -}
+import qualified Data.Time as Time {- time -}
+
+import qualified Music.Theory.Function as Function {- hmt-base -}
+import qualified Music.Theory.List as List {- hmt-base -}
+
+-- * Integral types
+
+-- | Week, one-indexed, ie. 1-52
+type Week = Int
+
+-- | Week, one-indexed, ie. 1-31
+type Day = Int
+
+-- | Hour, zero-indexed, ie. 0-23
+type Hour = Int
+
+-- | Minute, zero-indexed, ie. 0-59
+type Min = Int
+
+-- | Second, zero-indexed, ie. 0-59
+type Sec = Int
+
+-- | Centi-seconds, zero-indexed, ie. 0-99
+type Csec = Int -- (0-99)
+
+-- * Composite types
+
+-- | Minutes, seconds as @(min,sec)@
+type MinSec = (Min,Sec)
+
+-- | Generic MinSec
+type GMinSec n = (n,n)
+
+-- | Minutes, seconds, centi-seconds as @(min,sec,csec)@
+type MinCsec = (Min,Sec,Csec)
+
+-- | Generic MinCsec
+type GMinCsec n = (n,n,n)
+
+-- | (Hours,Minutes,Seconds)
+type Hms = (Hour,Min,Sec)
+
+-- | (Days,Hours,Minutes,Seconds)
+type Dhms = (Day,Hour,Min,Sec)
+
+-- * Fractional types
+
+-- | Fractional days.
+type FDay = Double
+
+-- | Fractional hour, ie. 1.50 is one and a half hours, ie. 1 hour and 30 minutes.
+type FHour = Double
+
+-- | Fractional minute, ie. 1.50 is one and a half minutes, ie. 1 minute and 30 seconds, cf. 'FMinSec'
+type FMin = Double
+
+-- | Fractional seconds.
+type FSec = Double
+
+-- | Fractional minutes and seconds (mm.ss, ie. 01.45 is 1 minute and 45 seconds).
+type FMinSec = Double
+
+-- * Time.UTCTime format strings.
+
+-- | 'Time.parseTimeOrError' with 'Time.defaultTimeLocale'.
+parse_time_str :: Time.ParseTime t => String -> String -> t
+parse_time_str = Time.parseTimeOrError True Time.defaultTimeLocale
+
+format_time_str :: Time.FormatTime t => String -> t -> String
+format_time_str = Time.formatTime Time.defaultTimeLocale
+
+-- * Iso-8601
+
+-- | Parse date in ISO-8601 extended (@YYYY-MM-DD@) or basic (@YYYYMMDD@) form.
+--
+-- > Time.toGregorian (Time.utctDay (parse_iso8601_date "2011-10-09")) == (2011,10,09)
+-- > Time.toGregorian (Time.utctDay (parse_iso8601_date "20190803")) == (2019,08,03)
+parse_iso8601_date :: String -> Time.UTCTime
+parse_iso8601_date s =
+  case length s of
+    8 -> parse_time_str "%Y%m%d" s -- basic
+    10 -> parse_time_str "%F" s -- extended
+    _ -> error "parse_iso8601_date?"
+
+-- | Format date in ISO-8601 form.
+--
+-- > format_iso8601_date True (parse_iso8601_date "2011-10-09") == "2011-10-09"
+-- > format_iso8601_date False (parse_iso8601_date "20190803") == "20190803"
+format_iso8601_date :: Time.FormatTime t => Bool -> t -> String
+format_iso8601_date ext = if ext then format_time_str "%F" else format_time_str "%Y%m%d"
+
+{- | Format date in ISO-8601 (@YYYY-WWW@) form.
+
+> r = ["2016-W52","2011-W40"]
+> map (format_iso8601_week . parse_iso8601_date) ["2017-01-01","2011-10-09"] == r
+
+-}
+format_iso8601_week :: Time.FormatTime t => t -> String
+format_iso8601_week = format_time_str "%G-W%V"
+
+-- | Parse ISO-8601 time is extended (@HH:MM:SS@) or basic (@HHMMSS@) form.
+--
+-- > format_iso8601_time True (parse_iso8601_time "21:44:00") == "21:44:00"
+-- > format_iso8601_time False (parse_iso8601_time "172511") == "172511"
+parse_iso8601_time :: String -> Time.UTCTime
+parse_iso8601_time s =
+  case length s of
+    6 -> parse_time_str "%H%M%S" s -- basic
+    8 -> parse_time_str "%H:%M:%S" s -- extended
+    _ -> error "parse_iso8601_time?"
+
+-- | Format time in ISO-8601 form.
+--
+-- > format_iso8601_time True (parse_iso8601_date_time "2011-10-09T21:44:00") == "21:44:00"
+-- > format_iso8601_time False (parse_iso8601_date_time "20190803T172511") == "172511"
+format_iso8601_time :: Time.FormatTime t => Bool -> t -> String
+format_iso8601_time ext = format_time_str (if ext then "%H:%M:%S" else "%H%M%S")
+
+-- | Parse date and time in extended or basic forms.
+--
+-- > Time.utctDayTime (parse_iso8601_date_time "2011-10-09T21:44:00") == Time.secondsToDiffTime 78240
+-- > Time.utctDayTime (parse_iso8601_date_time "20190803T172511") == Time.secondsToDiffTime 62711
+parse_iso8601_date_time :: String -> Time.UTCTime
+parse_iso8601_date_time s =
+  case length s of
+    15 -> parse_time_str "%Y%m%dT%H%M%S" s -- basic
+    19 -> parse_time_str "%FT%H:%M:%S" s -- extended
+    _ -> error ("parse_iso8601_date_time: " ++ s)
+
+{- | Format date in @YYYY-MM-DD@ and time in @HH:MM:SS@ forms.
+
+> t = parse_iso8601_date_time "2011-10-09T21:44:00"
+> format_iso8601_date_time True t == "2011-10-09T21:44:00"
+> format_iso8601_date_time False t == "20111009T214400"
+
+-}
+format_iso8601_date_time :: Time.FormatTime t => Bool -> t -> String
+format_iso8601_date_time ext = format_time_str (if ext then "%FT%H:%M:%S" else "%Y%m%dT%H%M%S")
+
+-- * FMin
+
+-- | 'fsec_to_minsec' . '*' 60
+--
+-- > fmin_to_minsec 6.48 == (6,29)
+fmin_to_minsec :: FMin -> MinSec
+fmin_to_minsec = fsec_to_minsec . (*) 60
+
+-- * FSec
+
+-- | Translate fractional seconds to picoseconds.
+--
+-- > fsec_to_picoseconds 78240.05
+fsec_to_picoseconds :: FSec -> Integer
+fsec_to_picoseconds s = floor (s * (10 ** 12))
+
+fsec_to_difftime :: FSec -> Time.DiffTime
+fsec_to_difftime = Time.picosecondsToDiffTime . fsec_to_picoseconds
+
+-- * FMinSec
+
+-- | Translate fractional minutes.seconds to picoseconds.
+--
+-- > map fminsec_to_fsec [0.45,15.355] == [45,935.5]
+fminsec_to_fsec :: FMinSec -> FSec
+fminsec_to_fsec n =
+    let m = ffloor n
+        s = (n - m) * 100
+    in (m * 60) + s
+
+fminsec_to_sec_generic :: (RealFrac f,Integral i) => f -> i
+fminsec_to_sec_generic n =
+    let m = floor n
+        s = round ((n - fromIntegral m) * 100)
+    in (m * 60) + s
+
+-- | Fractional minutes are mm.ss, so that 15.35 is 15 minutes and 35 seconds.
+--
+-- > map fminsec_to_sec [0.45,15.35] == [45,935]
+fminsec_to_sec :: FMinSec -> Sec
+fminsec_to_sec = fminsec_to_sec_generic
+
+-- > fsec_to_fminsec 935.5 == 15.355
+fsec_to_fminsec :: FSec -> FMinSec
+fsec_to_fminsec n =
+    let m = ffloor (n / 60)
+        s = n - (m * 60)
+    in m + (s / 100)
+
+-- > sec_to_fminsec 935 == 15.35
+sec_to_fminsec :: Sec -> FMinSec
+sec_to_fminsec n =
+    let m = ffloor (fromIntegral n / 60)
+        s = fromIntegral n - (m * 60)
+    in m + (s / 100)
+
+-- > fminsec_add 1.30 0.45 == 2.15
+-- > fminsec_add 1.30 0.45 == 2.15
+fminsec_add :: Function.BinOp FMinSec
+fminsec_add p q = fsec_to_fminsec (fminsec_to_fsec p + fminsec_to_fsec q)
+
+fminsec_sub :: Function.BinOp FMinSec
+fminsec_sub p q = fsec_to_fminsec (fminsec_to_fsec p - fminsec_to_fsec q)
+
+-- > fminsec_mul 0.45 2 == 1.30
+fminsec_mul :: Function.BinOp FMinSec
+fminsec_mul t n = fsec_to_fminsec (fminsec_to_fsec t * n)
+
+-- * FHour
+
+-- | Type specialised 'fromInteger' of 'floor'.
+ffloor :: Double -> Double
+ffloor = fromInteger . floor
+
+-- | Fractional hour to (hours,minutes,seconds).
+--
+-- > fhour_to_hms 21.75 == (21,45,0)
+fhour_to_hms :: FHour -> Hms
+fhour_to_hms h =
+    let m = (h - ffloor h) * 60
+        s = (m - ffloor m) * 60
+    in (floor h,floor m,round s)
+
+-- | Hms to fractional hours.
+--
+-- > hms_to_fhour (21,45,0) == 21.75
+hms_to_fhour :: Hms -> FHour
+hms_to_fhour (h,m,s) = fromIntegral h + (fromIntegral m / 60) + (fromIntegral s / (60 * 60))
+
+-- | Fractional hour to seconds.
+--
+-- > fhour_to_fsec 21.75 == 78300.0
+fhour_to_fsec :: FHour -> FSec
+fhour_to_fsec = (*) (60 * 60)
+
+fhour_to_difftime :: FHour -> Time.DiffTime
+fhour_to_difftime = fsec_to_difftime . fhour_to_fsec
+
+-- * FDay
+
+-- | Time in fractional days.
+--
+-- > round (utctime_to_fday (parse_iso8601_date_time "2011-10-09T09:00:00")) == 55843
+-- > round (utctime_to_fday (parse_iso8601_date_time "2011-10-09T21:00:00")) == 55844
+utctime_to_fday :: Time.UTCTime -> FDay
+utctime_to_fday t =
+    let d = Time.utctDay t
+        d' = fromIntegral (Time.toModifiedJulianDay d)
+        s = Time.utctDayTime t
+        s_max = 86401
+    in d' + (fromRational (toRational s) / s_max)
+
+-- * DiffTime
+
+-- | 'Time.DiffTime' in fractional seconds.
+--
+-- > difftime_to_fsec (hms_to_difftime (21,44,30)) == 78270
+difftime_to_fsec :: Time.DiffTime -> FSec
+difftime_to_fsec = fromRational . toRational
+
+-- | 'Time.DiffTime' in fractional minutes.
+--
+-- > difftime_to_fmin (hms_to_difftime (21,44,30)) == 1304.5
+difftime_to_fmin :: Time.DiffTime -> Double
+difftime_to_fmin = (/ 60) . difftime_to_fsec
+
+-- | 'Time.DiffTime' in fractional hours.
+--
+-- > difftime_to_fhour (hms_to_difftime (21,45,00)) == 21.75
+difftime_to_fhour :: Time.DiffTime -> FHour
+difftime_to_fhour = (/ 60) . difftime_to_fmin
+
+hms_to_difftime :: Hms -> Time.DiffTime
+hms_to_difftime = fhour_to_difftime . hms_to_fhour
+
+-- * Hms
+
+hms_to_sec :: Hms -> Sec
+hms_to_sec (h,m,s) = h * 60 * 60 + m * 60 + s
+
+-- | Seconds to (hours,minutes,seconds).
+--
+-- > map sec_to_hms [60-1,60+1,60*60-1,60*60+1] == [(0,0,59),(0,1,1),(0,59,59),(1,0,1)]
+sec_to_hms :: Sec -> Hms
+sec_to_hms s =
+  let (h,s') = s `divMod` (60 * 60)
+      (m,s'') = sec_to_minsec s'
+  in (h,m,s'')
+
+-- | 'Hms' pretty printer.
+--
+-- > map (hms_pp True) [(0,1,2),(1,2,3)] == ["01:02","01:02:03"]
+hms_pp :: Bool -> Hms -> String
+hms_pp trunc (h,m,s) =
+  if trunc && h == 0
+  then printf "%02d:%02d" m s
+  else printf "%02d:%02d:%02d" h m s
+
+-- * 'Hms' parser.
+--
+-- > hms_parse "0:01:00" == (0,1,0)
+hms_parse :: String -> Hms
+hms_parse x =
+    case Split.splitOn ":" x of
+      [h,m,s] -> (read h,read m,read s)
+      _ -> error "parse_hms"
+
+-- * MinSec
+
+-- | 'divMod' by @60@.
+--
+-- > sec_to_minsec 123 == (2,3)
+sec_to_minsec :: Integral n => n -> GMinSec n
+sec_to_minsec = flip divMod 60
+
+-- | Inverse of 'sec_minsec'.
+--
+-- > minsec_to_sec (2,3) == 123
+minsec_to_sec :: Num n => GMinSec n -> n
+minsec_to_sec (m,s) = m * 60 + s
+
+-- | Convert /p/ and /q/ to seconds, apply /f/, and convert back to 'MinSec'.
+minsec_binop :: Integral t => (t -> t -> t) -> GMinSec t -> GMinSec t -> GMinSec 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 => GMinSec n -> GMinSec n -> GMinSec n
+minsec_sub = minsec_binop (-)
+
+-- | 'minsec_binop' 'subtract', assumes /p/ precedes /q/.
+--
+-- > minsec_diff (1,59) (2,35) == (0,36)
+minsec_diff :: Integral n => GMinSec n -> GMinSec n -> GMinSec n
+minsec_diff = minsec_binop subtract
+
+-- | 'minsec_binop' '+'.
+--
+-- > minsec_add (1,59) (2,35) == (4,34)
+minsec_add :: Integral n => GMinSec n -> GMinSec n -> GMinSec n
+minsec_add = minsec_binop (+)
+
+-- | 'foldl' of 'minsec_add'
+--
+-- > minsec_sum [(1,59),(2,35),(4,34)] == (9,08)
+minsec_sum :: Integral n => [GMinSec n] -> GMinSec n
+minsec_sum = foldl minsec_add (0,0)
+
+-- | 'round' 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 -> GMinSec n
+minsec_parse x =
+    case Split.splitOn ":" x of
+      [m,s] -> (read m,read s)
+      _ -> error ("minsec_parse: " ++ x)
+
+-- * MinCsec
+
+-- | 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 => GMinCsec 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 => GMinCsec 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 -> GMinCsec 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) -> GMinCsec t -> GMinCsec t -> GMinCsec t
+mincsec_binop f p q = csec_to_mincsec (f (mincsec_to_csec p) (mincsec_to_csec q))
+
+-- * DHms
+
+-- | Convert seconds into (days,hours,minutes,seconds).
+sec_to_dhms_generic :: Integral n => n -> (n,n,n,n)
+sec_to_dhms_generic n =
+    let (d,h') = n `divMod` (24 * 60 * 60)
+        (h,m') = h' `divMod` (60 * 60)
+        (m,s) = m' `divMod` 60
+    in (d,h,m,s)
+
+-- | Type specialised 'sec_to_dhms_generic'.
+--
+-- > sec_to_dhms 1475469 == (17,1,51,9)
+sec_to_dhms :: Sec -> Dhms
+sec_to_dhms = sec_to_dhms_generic
+
+-- | Inverse of 'seconds_to_dhms'.
+--
+-- > dhms_to_sec (17,1,51,9) == 1475469
+dhms_to_sec :: Num n => (n,n,n,n) -> n
+dhms_to_sec (d,h,m,s) = sum [d * 24 * 60 * 60,h * 60 * 60,m * 60,s]
+
+-- | Generic form of 'parse_dhms'.
+parse_dhms_generic :: (Integral n,Read n) => String -> (n,n,n,n)
+parse_dhms_generic =
+    let sep_elem = Split.split . Split.keepDelimsR . Split.oneOf
+        sep_last x = let (e, x') = List.headTail (reverse x) in (reverse x',e)
+        p x = case sep_last x of
+                (n,'d') -> read n * 24 * 60 * 60
+                (n,'h') -> read n * 60 * 60
+                (n,'m') -> read n * 60
+                (n,'s') -> read n
+                _ -> error "parse_dhms"
+    in sec_to_dhms_generic . sum . map p . filter (not . null) . sep_elem "dhms"
+
+-- | Parse DHms text.  All parts are optional, order is not
+-- significant, multiple entries are allowed.
+--
+-- > parse_dhms "17d1h51m9s" == (17,1,51,9)
+-- > parse_dhms "1s3d" == (3,0,0,1)
+-- > parse_dhms "1h1h" == (0,2,0,0)
+parse_dhms :: String -> Dhms
+parse_dhms = parse_dhms_generic
+
+-- * Week
+
+-- | Week that /t/ lies in.
+--
+-- > map (time_to_week . parse_iso8601_date) ["2017-01-01","2011-10-09"] == [52,40]
+time_to_week :: Time.UTCTime -> Week
+time_to_week = read . format_time_str "%V"
+
+-- * Util
+
+-- | 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/Traversable.hs b/Music/Theory/Traversable.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Traversable.hs
@@ -0,0 +1,49 @@
+-- | Traversable functions.
+module Music.Theory.Traversable where
+
+import Data.List {- base -}
+
+-- | Replace elements at 'Traversable' with result of joining with elements from list.
+--
+-- > let t = Tree.Node 0 [Tree.Node 1 [Tree.Node 2 [],Tree.Node 3 []],Tree.Node 4 []]
+-- > putStrLn $ Tree.drawTree (fmap show t)
+-- > let (_,u) = adopt_shape (\_ x -> x) "abcde" t
+-- > putStrLn $ Tree.drawTree (fmap return u)
+adopt_shape :: Traversable t => (a -> b -> c) -> [b] -> t a -> ([b],t c)
+adopt_shape jn l =
+    let f (i:j) k = (j,jn k i)
+        f [] _ = error "adopt_shape: rhs ends"
+    in mapAccumL f l
+
+-- | Two-level variant of 'adopt_shape'.
+--
+-- > adopt_shape_2 (,) [0..4] (words "a bc d") == ([4],[[('a',0)],[('b',1),('c',2)],[('d',3)]])
+adopt_shape_2 :: (Traversable t,Traversable u) => (a -> b -> c) -> [b] -> t (u a) -> ([b],t (u c))
+adopt_shape_2 jn = mapAccumL (adopt_shape jn)
+
+{- | Adopt stream to shape of traversable and zip elements.
+
+> adopt_shape_2_zip_stream [1..] ["a", "list", "of", "strings"]
+-}
+adopt_shape_2_zip_stream :: (Traversable t, Traversable u) => [c] -> t (u a) -> t (u (c, a))
+adopt_shape_2_zip_stream s l = snd (adopt_shape_2 (flip (,)) s l)
+
+-- | Two-level variant of 'zip' [1..]
+--
+-- > list_number_2 ["number","list","two"] == [[(1,'n'),(2,'u'),(3,'m'),(4,'b'),(5,'e'),(6,'r')],[(7,'l'),(8,'i'),(9,'s'),(10,'t')],[(11,'t'),(12,'w'),(13,'o')]]
+list_number_2 :: [[x]] -> [[(Int,x)]]
+list_number_2 = adopt_shape_2_zip_stream [1..]
+
+{- | Variant of 'adopt_shape' that considers only 'Just' elements at 'Traversable'.
+
+> let s = "a(b(cd)ef)ghi"
+> let t = group_tree (begin_end_cmp_eq '(' ')') s
+> adopt_shape_m (,) [1..13] t
+-}
+adopt_shape_m :: Traversable t => (a -> b-> c) -> [b] -> t (Maybe a) -> ([b],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 mapAccumL f l
diff --git a/Music/Theory/Tree.hs b/Music/Theory/Tree.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tree.hs
@@ -0,0 +1,12 @@
+-- | Tree functions
+module Music.Theory.Tree where
+
+import qualified Data.Tree as Tree {- containers -}
+
+-- | Print forest as markdown list.
+mdForest :: Tree.Forest String -> String
+mdForest  = unlines . concatMap (mdTree 0)
+
+-- | Print tree as markdown list with indicated starting indent level.
+mdTree :: Int -> Tree.Tree String -> [String]
+mdTree k (Tree.Node txt st) = (replicate (k * 2) ' ' ++ "- " ++ txt) : concatMap (mdTree (k + 1)) st
diff --git a/Music/Theory/Tuple.hs b/Music/Theory/Tuple.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Tuple.hs
@@ -0,0 +1,403 @@
+-- | 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
+
+import Data.List {- base -}
+import Data.Monoid {- base -}
+
+-- * P2 (2-product)
+
+p2_from_list :: (t -> t1,t -> t2) -> [t] -> (t1,t2)
+p2_from_list (f1,f2) l =
+  case l of
+    [c1,c2] -> (f1 c1,f2 c2)
+    _ -> error "p2_from_list"
+
+-- | Swap elements of P2
+--
+-- > p2_swap (1,2) == (2,1)
+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
+
+-- | 't2_infix' 'mappend'.
+--
+-- > t2_join ([1,2],[3,4]) == [1,2,3,4]
+t2_join :: Data.Monoid.Monoid m => T2 m -> m
+t2_join = t2_infix mappend
+
+-- | 't2_map' 'mconcat' of 'unzip'
+--
+-- > t2_concat [("ab","cd"),("ef","gh")] == ("abef","cdgh")
+t2_concat :: Data.Monoid.Monoid m => [T2 m] -> T2 m
+t2_concat = t2_map mconcat . unzip
+
+-- | 'sort'
+--
+-- > t2_sort (2,1) == (1,2)
+t2_sort :: Ord t => (t,t) -> (t,t)
+t2_sort (p,q) = (min p q,max p q)
+
+-- | 'sum'
+t2_sum :: Num n => (n,n) -> n
+t2_sum (i,j) = i + j
+
+-- | 'mapM'
+t2_mapM :: Monad m => (t -> m u) -> (t,t) -> m (u,u)
+t2_mapM f (i,j) = f i >>= \p -> f j >>= \q -> return (p,q)
+
+-- | 'mapM_'
+t2_mapM_ :: Monad m => (t -> m u) -> (t,t) -> m ()
+t2_mapM_ f (i,j) = f i >> f j >> return ()
+
+-- * 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 (++)
+
+t3_sort :: Ord t => (t,t,t) -> (t,t,t)
+t3_sort = t3_from_list . sort . t3_to_list
+
+-- * 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
+
+p4_zip :: (a,b,c,d) -> (e,f,g,h) -> ((a,e),(b,f),(c,g),(d,h))
+p4_zip (a,b,c,d) (e,f,g,h) = ((a,e),(b,f),(c,g),(d,h))
+
+-- * 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)
+
+t6_sum :: Num t => T6 t -> t
+t6_sum (a,b,c,d,e,f) = a + b + c + d + e + f
+
+-- * 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_from_list :: [t] -> T9 t
+t9_from_list l = case l of {[p,q,r,s,t,u,v,w,x] -> (p,q,r,s,t,u,v,w,x); _ -> error "t9_from_list?"}
+
+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
+
+-- * Family of 'uncurry' functions.
+
+uncurry3 :: (a->b->c -> z) -> (a,b,c) -> z
+uncurry3 fn (a,b,c) = fn a b c
+uncurry4 :: (a->b->c->d -> z) -> (a,b,c,d) -> z
+uncurry4 fn (a,b,c,d) = fn a b c d
+uncurry5 :: (a->b->c->d->e -> z) -> (a,b,c,d,e) -> z
+uncurry5 fn (a,b,c,d,e) = fn a b c d e
+uncurry6 :: (a->b->c->d->e->f -> z) -> (a,b,c,d,e,f) -> z
+uncurry6 fn (a,b,c,d,e,f) = fn a b c d e f
+uncurry7 :: (a->b->c->d->e->f->g -> z) -> (a,b,c,d,e,f,g) -> z
+uncurry7 fn (a,b,c,d,e,f,g) = fn a b c d e f g
+uncurry8 :: (a->b->c->d->e->f->g->h -> z) -> (a,b,c,d,e,f,g,h) -> z
+uncurry8 fn (a,b,c,d,e,f,g,h) = fn a b c d e f g h
+uncurry9 :: (a->b->c->d->e->f->g->h->i -> z) -> (a,b,c,d,e,f,g,h,i) -> z
+uncurry9 fn (a,b,c,d,e,f,g,h,i) = fn a b c d e f g h i
+uncurry10 :: (a->b->c->d->e->f->g->h->i->j -> z) -> (a,b,c,d,e,f,g,h,i,j) -> z
+uncurry10 fn (a,b,c,d,e,f,g,h,i,j) = fn a b c d e f g h i j
+uncurry11 :: (a->b->c->d->e->f->g->h->i->j->k -> z) -> (a,b,c,d,e,f,g,h,i,j,k) -> z
+uncurry11 fn (a,b,c,d,e,f,g,h,i,j,k) = fn a b c d e f g h i j k
+uncurry12 :: (a->b->c->d->e->f->g->h->i->j->k->l -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l) -> z
+uncurry12 fn (a,b,c,d,e,f,g,h,i,j,k,l) = fn a b c d e f g h i j k l
+uncurry13 :: (a->b->c->d->e->f->g->h->i->j->k->l->m -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m) -> z
+uncurry13 fn (a,b,c,d,e,f,g,h,i,j,k,l,m) = fn a b c d e f g h i j k l m
+uncurry14 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n) -> z
+uncurry14 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n) = fn a b c d e f g h i j k l m n
+uncurry15 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) -> z
+uncurry15 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o) = fn a b c d e f g h i j k l m n o
+uncurry16 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) -> z
+uncurry16 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p) = fn a b c d e f g h i j k l m n o p
+uncurry17 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) -> z
+uncurry17 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q) = fn a b c d e f g h i j k l m n o p q
+uncurry18 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) -> z
+uncurry18 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r) = fn a b c d e f g h i j k l m n o p q r
+uncurry19 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) -> z
+uncurry19 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s) = fn a b c d e f g h i j k l m n o p q r s
+uncurry20 :: (a->b->c->d->e->f->g->h->i->j->k->l->m->n->o->p->q->r->s->t -> z) -> (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) -> z
+uncurry20 fn (a,b,c,d,e,f,g,h,i,j,k,l,m,n,o,p,q,r,s,t) = fn a b c d e f g h i j k l m n o p q r s t
+
+-- Local Variables:
+-- truncate-lines:t
+-- End:
diff --git a/Music/Theory/Unicode.hs b/Music/Theory/Unicode.hs
new file mode 100644
--- /dev/null
+++ b/Music/Theory/Unicode.hs
@@ -0,0 +1,509 @@
+-- | <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.Char {- base -}
+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-base -}
+import qualified Music.Theory.List as T {- hmt-base -}
+import qualified Music.Theory.Read as T {- hmt-base -}
+
+-- * 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
+
+-- | Unicode interpunct.
+--
+-- > middle_dot == '·'
+middle_dot :: Char
+middle_dot = toEnum 0x00B7
+
+-- | The superscript variants of the digits 0-9
+superscript_digits :: [Char]
+superscript_digits = "⁰¹²³⁴⁵⁶⁷⁸⁹"
+
+-- | Map 'show' of 'Int' to 'superscript_digits'.
+--
+-- > unwords (map int_show_superscript [0,12,345,6789]) == "⁰ ¹² ³⁴⁵ ⁶⁷⁸⁹"
+int_show_superscript :: Int -> String
+int_show_superscript = map ((superscript_digits !!) . digitToInt) . show
+
+-- | The subscript variants of the digits 0-9
+subscript_digits :: [Char]
+subscript_digits = "₀₁₂₃₄₅₆₇₈₉"
+
+-- | The combining over line character.
+--
+-- > ['1',combining_overline] == "1̅"
+-- > ['A',combining_overline] == "A̅"
+combining_overline :: Char
+combining_overline = toEnum 0x0305
+
+-- | Add 'combining_overline' to each 'Char'.
+--
+-- > overline "1234" == "1̅2̅3̅4̅"
+overline :: String -> String
+overline = let f x = [x,combining_overline] in concatMap f
+
+-- | The combining under line character.
+--
+-- > ['1',combining_underline] == "1̲"
+combining_underline :: Char
+combining_underline = toEnum 0x0332
+
+-- | Add 'combining_underline' to each 'Char'.
+--
+-- > underline "1234" == "1̲2̲3̲4̲"
+underline :: String -> String
+underline = let f x = [x,combining_underline] in concatMap f
+
+-- * Table
+
+type Unicode_Index = Int
+type Unicode_Name = String
+type Unicode_Range = (Unicode_Index,Unicode_Index)
+type Unicode_Point = (Unicode_Index,Unicode_Name)
+type Unicode_Table = [Unicode_Point]
+
+{- | <http://unicode.org/Public/11.0.0/ucd/UnicodeData.txt>
+
+> let fn = "/home/rohan/data/unicode.org/Public/11.0.0/ucd/UnicodeData.txt"
+> tbl <- unicode_data_table_read fn
+> length tbl == 32292
+> T.reverse_lookup_err "MIDDLE DOT" tbl == 0x00B7
+> putStrLn $ unwords $ map (\(n,x) -> toEnum n : x) $ filter (\(_,x) -> "EMPTY SET" `isInfixOf` x) tbl
+> T.lookup_err 0x22C5 tbl == "DOT OPERATOR"
+-}
+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 :: (Unicode_Index,Unicode_Index) -> 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
+
+-- * Music
+
+-- > putStrLn$ map (toEnum . fst) (concat music_tbl)
+music_tbl :: [Unicode_Table]
+music_tbl = [barlines_tbl,accidentals_tbl,notes_tbl,rests_tbl,clefs_tbl]
+
+-- > 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)]
+
+-- > putStrLn$ unicode_table_hs (unicode_table_block barlines_rng tbl)
+barlines_rng :: Unicode_Range
+barlines_rng = (0x1D100,0x1D105)
+
+-- | UNICODE barline symbols.
+--
+-- > let r = "𝄀𝄁𝄂𝄃𝄄𝄅" in map (toEnum . fst) barlines_tbl == r
+barlines_tbl :: Unicode_Table
+barlines_tbl =
+  [(0x1D100,"MUSICAL SYMBOL SINGLE BARLINE")
+  ,(0x1D101,"MUSICAL SYMBOL DOUBLE BARLINE")
+  ,(0x1D102,"MUSICAL SYMBOL FINAL BARLINE")
+  ,(0x1D103,"MUSICAL SYMBOL REVERSE FINAL BARLINE")
+  ,(0x1D104,"MUSICAL SYMBOL DASHED BARLINE")
+  ,(0x1D105,"MUSICAL SYMBOL SHORT BARLINE")]
+
+-- | UNICODE accidental symbols.
+--
+-- > let r = "♭♮♯𝄪𝄫𝄬𝄭𝄮𝄯𝄰𝄱𝄲𝄳" in map (toEnum . fst) accidentals_tbl == r
+accidentals_tbl :: Unicode_Table
+accidentals_tbl =
+    [(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_tbl == r
+notes_tbl :: Unicode_Table
+notes_tbl =
+    [(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_tbl == r
+rests_tbl :: Unicode_Table
+rests_tbl =
+    [(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")]
+
+-- | Augmentation dot.
+--
+-- > 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_tbl == r
+clefs_tbl :: Unicode_Table
+clefs_tbl =
+    [(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 noteheads_rng tbl)
+noteheads_rng :: Unicode_Range
+noteheads_rng = (0x1D143,0x1D15B)
+
+-- | UNICODE notehead symbols.
+--
+-- > let r = "𝅃𝅄𝅅𝅆𝅇𝅈𝅉𝅊𝅋𝅌𝅍𝅎𝅏𝅐𝅑𝅒𝅓𝅔𝅕𝅖𝅗𝅘𝅙𝅚𝅛" in map (toEnum . fst) noteheads_tbl == r
+noteheads_tbl :: Unicode_Table
+noteheads_tbl =
+    [(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_tbl == "𝆌𝆍𝆎𝆏𝆐𝆑𝆒𝆓"
+dynamics_tbl :: Unicode_Table
+dynamics_tbl =
+    [(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_tbl :: String)
+articulations_tbl :: Unicode_Table
+articulations_tbl =
+    [(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")]
+
+-- * Math
+
+ix_set_to_tbl :: Unicode_Table -> [Unicode_Index] -> Unicode_Table
+ix_set_to_tbl tbl ix = zip ix (map (`T.lookup_err` tbl) ix)
+
+-- | Unicode dot-operator.
+--
+-- > dot_operator == '⋅'
+dot_operator :: Char
+dot_operator = toEnum 0x22C5
+
+-- | Math symbols outside of the math blocks.
+--
+-- > putStrLn (unicode_table_hs (ix_set_to_tbl tbl math_plain_ix))
+math_plain_ix :: [Unicode_Index]
+math_plain_ix = [0x00D7,0x00F7]
+
+-- > map (toEnum . fst) math_plain_tbl == "×÷"
+math_plain_tbl :: Unicode_Table
+math_plain_tbl = [(0xd7,"MULTIPLICATION SIGN"),(0xf7,"DIVISION SIGN")]
+
+-- * 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 =
+    [((0x01B00,0x01B7F),"Balinese")
+    ,((0x02200,0x022FF),"Mathematical Operators")
+    ,((0x025A0,0x025FF),"Geometric Shapes")
+    ,((0x027C0,0x027EF),"Miscellaneous Mathematical Symbols-A")
+    ,((0x027F0,0x027FF),"Supplemental Arrows-A")
+    ,((0x02800,0x028FF),"Braille Patterns")
+    ,((0x02900,0x0297F),"Supplemental Arrows-B")
+    ,((0x02980,0x029FF),"Miscellaneous Mathematical Symbols-B")
+    ,((0x02A00,0x02AFF),"Supplemental Mathematical Operators")
+    ,((0x1D000,0x1D0FF),"Byzantine Musical Symbols")
+    ,((0x1D100,0x1D1FF),"Musical Symbols")
+    ,((0x1D200,0x1D24F),"Ancient Greek Musical Notation")
+    ]
+
+-- * BAGUA, EIGHT TRI-GRAMS
+
+-- | Bagua tri-grams.
+--
+-- > putStrLn $ unicode_table_hs (unicode_table_block (fst bagua) tbl)
+bagua :: Unicode_Block
+bagua = ((0x02630,0x02637),"BAGUA")
+
+{- | Table of eight tri-grams.
+
+HEAVEN,乾,Qián,☰,111
+LAKE,兌,Duì,☱,110
+FIRE,離,Lí,☲,101
+THUNDER,震,Zhèn,☳,100
+WIND,巽,Xùn,☴,011
+WATER,坎,Kǎn,☵,010
+MOUNTAIN,艮,Gèn,☶,001
+EARTH,坤,Kūn,☷,000
+
+-}
+bagua_tbl :: Unicode_Table
+bagua_tbl =
+  [(0x2630,"TRIGRAM FOR HEAVEN")
+  ,(0x2631,"TRIGRAM FOR LAKE")
+  ,(0x2632,"TRIGRAM FOR FIRE")
+  ,(0x2633,"TRIGRAM FOR THUNDER")
+  ,(0x2634,"TRIGRAM FOR WIND")
+  ,(0x2635,"TRIGRAM FOR WATER")
+  ,(0x2636,"TRIGRAM FOR MOUNTAIN")
+  ,(0x2637,"TRIGRAM FOR EARTH")]
+
+-- * YIJING (I-CHING), SIXTY-FOUR HEXAGRAMS
+
+-- | Yijing hexagrams in King Wen sequence.
+--
+-- > putStrLn $ unicode_table_hs (unicode_table_block (fst yijing) tbl)
+yijing :: Unicode_Block
+yijing = ((0x04DC0,0x04DFF),"YIJING")
+
+{- | Yijing hexagrams in King Wen sequence.
+
+䷀,乾,qián,111,111
+䷁,坤,kūn,000,000
+䷂,屯,chún,100,010
+䷃,蒙,méng,010,001
+䷄,需,xū,111,010
+䷅,訟,sòng,010,111
+䷆,師,shī,010,000
+䷇,比,bǐ,000,010
+䷈,小畜,xiǎo chù,111,011
+䷉,履,lǚ,110,111
+䷊,泰,tài,111,000
+䷋,否,pǐ,000,111
+䷌,同人,tóng rén,101,111
+䷍,大有,dà yǒu,111,101
+䷎,謙,qiān,001,000
+䷏,豫,yù,000,100
+䷐,隨,suí,100,110
+䷑,蠱,gŭ,011,001
+䷒,臨,lín,110,000
+䷓,觀,guān,000,011
+䷔,噬嗑,shì kè,100,101
+䷕,賁,bì,101,001
+䷖,剝,bō,000,001
+䷗,復,fù,100,000
+䷘,無妄,wú wàng,100,111
+䷙,大畜,dà chù,111,001
+䷚,頤,yí,100,001
+䷛,大過,dà guò,011,110
+䷜,坎,kǎn,010,010
+䷝,離,lí,101,101
+䷞,咸,xián,001,110
+䷟,恆,héng,011,100
+䷠,遯,dùn,001,111
+䷡,大壯,dà zhuàng,111,100
+䷢,晉,jìn,000,101
+䷣,明夷,míng yí,101,000
+䷤,家人,jiā rén,101,011
+䷥,睽,kuí,110,101
+䷦,蹇,jiǎn,001,010
+䷧,解,xiè,010,100
+䷨,損,sǔn,110,001
+䷩,益,yì,100,011
+䷪,夬,guài,111,110
+䷫,姤,gòu,011,111
+䷬,萃,cuì,000,110
+䷭,升,shēng,011,000
+䷮,困,kùn,010,110
+䷯,井,jǐng,011,010
+䷰,革,gé,101,110
+䷱,鼎,dǐng,011,101
+䷲,震,zhèn,100,100
+䷳,艮,gèn,001,001
+䷴,漸,jiàn,001,011
+䷵,歸妹,guī mèi,110,100
+䷶,豐,fēng,101,100
+䷷,旅,lǚ,001,101
+䷸,巽,xùn,011,011
+䷹,兌,duì,110,110
+䷺,渙,huàn,010,011
+䷻,節,jié,110,010
+䷼,中孚,zhōng fú,110,011
+䷽,小過,xiǎo guò,001,110
+䷾,既濟,jì jì,101,010
+䷿,未濟,wèi jì,010,101
+-}
+yijing_tbl :: Unicode_Table
+yijing_tbl =
+  [(0x4dc0,"HEXAGRAM FOR THE CREATIVE HEAVEN")
+  ,(0x4dc1,"HEXAGRAM FOR THE RECEPTIVE EARTH")
+  ,(0x4dc2,"HEXAGRAM FOR DIFFICULTY AT THE BEGINNING")
+  ,(0x4dc3,"HEXAGRAM FOR YOUTHFUL FOLLY")
+  ,(0x4dc4,"HEXAGRAM FOR WAITING")
+  ,(0x4dc5,"HEXAGRAM FOR CONFLICT")
+  ,(0x4dc6,"HEXAGRAM FOR THE ARMY")
+  ,(0x4dc7,"HEXAGRAM FOR HOLDING TOGETHER")
+  ,(0x4dc8,"HEXAGRAM FOR SMALL TAMING")
+  ,(0x4dc9,"HEXAGRAM FOR TREADING")
+  ,(0x4dca,"HEXAGRAM FOR PEACE")
+  ,(0x4dcb,"HEXAGRAM FOR STANDSTILL")
+  ,(0x4dcc,"HEXAGRAM FOR FELLOWSHIP")
+  ,(0x4dcd,"HEXAGRAM FOR GREAT POSSESSION")
+  ,(0x4dce,"HEXAGRAM FOR MODESTY")
+  ,(0x4dcf,"HEXAGRAM FOR ENTHUSIASM")
+  ,(0x4dd0,"HEXAGRAM FOR FOLLOWING")
+  ,(0x4dd1,"HEXAGRAM FOR WORK ON THE DECAYED")
+  ,(0x4dd2,"HEXAGRAM FOR APPROACH")
+  ,(0x4dd3,"HEXAGRAM FOR CONTEMPLATION")
+  ,(0x4dd4,"HEXAGRAM FOR BITING THROUGH")
+  ,(0x4dd5,"HEXAGRAM FOR GRACE")
+  ,(0x4dd6,"HEXAGRAM FOR SPLITTING APART")
+  ,(0x4dd7,"HEXAGRAM FOR RETURN")
+  ,(0x4dd8,"HEXAGRAM FOR INNOCENCE")
+  ,(0x4dd9,"HEXAGRAM FOR GREAT TAMING")
+  ,(0x4dda,"HEXAGRAM FOR MOUTH CORNERS")
+  ,(0x4ddb,"HEXAGRAM FOR GREAT PREPONDERANCE")
+  ,(0x4ddc,"HEXAGRAM FOR THE ABYSMAL WATER")
+  ,(0x4ddd,"HEXAGRAM FOR THE CLINGING FIRE")
+  ,(0x4dde,"HEXAGRAM FOR INFLUENCE")
+  ,(0x4ddf,"HEXAGRAM FOR DURATION")
+  ,(0x4de0,"HEXAGRAM FOR RETREAT")
+  ,(0x4de1,"HEXAGRAM FOR GREAT POWER")
+  ,(0x4de2,"HEXAGRAM FOR PROGRESS")
+  ,(0x4de3,"HEXAGRAM FOR DARKENING OF THE LIGHT")
+  ,(0x4de4,"HEXAGRAM FOR THE FAMILY")
+  ,(0x4de5,"HEXAGRAM FOR OPPOSITION")
+  ,(0x4de6,"HEXAGRAM FOR OBSTRUCTION")
+  ,(0x4de7,"HEXAGRAM FOR DELIVERANCE")
+  ,(0x4de8,"HEXAGRAM FOR DECREASE")
+  ,(0x4de9,"HEXAGRAM FOR INCREASE")
+  ,(0x4dea,"HEXAGRAM FOR BREAKTHROUGH")
+  ,(0x4deb,"HEXAGRAM FOR COMING TO MEET")
+  ,(0x4dec,"HEXAGRAM FOR GATHERING TOGETHER")
+  ,(0x4ded,"HEXAGRAM FOR PUSHING UPWARD")
+  ,(0x4dee,"HEXAGRAM FOR OPPRESSION")
+  ,(0x4def,"HEXAGRAM FOR THE WELL")
+  ,(0x4df0,"HEXAGRAM FOR REVOLUTION")
+  ,(0x4df1,"HEXAGRAM FOR THE CAULDRON")
+  ,(0x4df2,"HEXAGRAM FOR THE AROUSING THUNDER")
+  ,(0x4df3,"HEXAGRAM FOR THE KEEPING STILL MOUNTAIN")
+  ,(0x4df4,"HEXAGRAM FOR DEVELOPMENT")
+  ,(0x4df5,"HEXAGRAM FOR THE MARRYING MAIDEN")
+  ,(0x4df6,"HEXAGRAM FOR ABUNDANCE")
+  ,(0x4df7,"HEXAGRAM FOR THE WANDERER")
+  ,(0x4df8,"HEXAGRAM FOR THE GENTLE WIND")
+  ,(0x4df9,"HEXAGRAM FOR THE JOYOUS LAKE")
+  ,(0x4dfa,"HEXAGRAM FOR DISPERSION")
+  ,(0x4dfb,"HEXAGRAM FOR LIMITATION")
+  ,(0x4dfc,"HEXAGRAM FOR INNER TRUTH")
+  ,(0x4dfd,"HEXAGRAM FOR SMALL PREPONDERANCE")
+  ,(0x4dfe,"HEXAGRAM FOR AFTER COMPLETION")
+  ,(0x4dff,"HEXAGRAM FOR BEFORE COMPLETION")]
diff --git a/README.md b/README.md
new file mode 100644
--- /dev/null
+++ b/README.md
@@ -0,0 +1,13 @@
+hmt - haskell music theory base
+-------------------------------
+
+base library for [haskell](http://haskell.org/) music theory
+
+related:
+
+- [hmt](http://rohandrape.net/?t=hmt)
+- [hmt-diagrams](http://rohandrape.net/?t=hmt-diagrams)
+- [hmt-texts](http://rohandrape.net/?t=hmt-texts)
+
+© [rohan drape](http://rohandrape.net/), 2006-2022, [gpl](http://gnu.org/copyleft/).
+
diff --git a/hmt-base.cabal b/hmt-base.cabal
new file mode 100644
--- /dev/null
+++ b/hmt-base.cabal
@@ -0,0 +1,79 @@
+cabal-version:     2.4
+Name:              hmt-base
+Version:           0.20
+Synopsis:          Haskell Music Theory Base
+Description:       Haskell music theory Base Library
+License:           GPL-3.0-only
+Category:          Music
+Copyright:         Rohan Drape, 2006-2022
+Author:            Rohan Drape
+Maintainer:        rd@rohandrape.net
+Stability:         Experimental
+Homepage:          http://rohandrape.net/t/hmt-base
+Tested-With:       GHC == 9.2.4
+Build-Type:        Simple
+Data-files:        README.md
+
+Library
+  Build-Depends:   array,
+                   base >= 4.9 && < 5,
+                   bytestring,
+                   containers,
+                   data-ordlist,
+                   directory,
+                   filepath,
+                   lazy-csv,
+                   monad-loops,
+                   process,
+                   random,
+                   safe,
+                   split,
+                   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.Text
+                   Music.Theory.Bits
+                   Music.Theory.Bool
+                   Music.Theory.Byte
+                   Music.Theory.Combinations
+                   Music.Theory.Concurrent
+                   Music.Theory.Directory
+                   Music.Theory.Directory.Find
+                   Music.Theory.Either
+                   Music.Theory.Enum
+                   Music.Theory.Function
+                   Music.Theory.Graph.Bliss
+                   Music.Theory.Graph.G6
+                   Music.Theory.Graph.Lcf
+                   Music.Theory.Graph.Lgl
+                   Music.Theory.Graph.Planar
+                   Music.Theory.Graph.Type
+                   Music.Theory.Io
+                   Music.Theory.List
+                   Music.Theory.Map
+                   Music.Theory.Math
+                   Music.Theory.Math.Constant
+                   Music.Theory.Math.Convert
+                   Music.Theory.Math.Histogram
+                   Music.Theory.Maybe
+                   Music.Theory.Monad
+                   Music.Theory.Opt
+                   Music.Theory.Ord
+                   Music.Theory.Permutations
+                   Music.Theory.Read
+                   Music.Theory.Show
+                   Music.Theory.String
+                   Music.Theory.Time.Duration
+                   Music.Theory.Time.Notation
+                   Music.Theory.Traversable
+                   Music.Theory.Tree
+                   Music.Theory.Tuple
+                   Music.Theory.Unicode
+
+Source-Repository  head
+  Type:            git
+  Location:        https://gitlab.com/rd--/hmt-base