diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2016, Stuart Popejoy
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are
+met:
+
+1. Redistributions of source code must retain the above copyright
+   notice, this list of conditions and the following disclaimer.
+
+2. Redistributions in binary form must reproduce the above copyright
+   notice, this list of conditions and the following disclaimer in the
+   documentation and/or other materials provided with the
+   distribution.
+
+3. Neither the name of the copyright holder nor the names of its
+   contributors may be used to endorse or promote products derived
+   from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/fadno.cabal b/fadno.cabal
new file mode 100644
--- /dev/null
+++ b/fadno.cabal
@@ -0,0 +1,65 @@
+name:                fadno
+category:            Music
+synopsis:            Minimal library for music generation and notation
+version:             1.1.0
+homepage:            http://github.com/slpopejoy/fadno
+description:         Provides the Note type and HasNote class with polymorphic pitch and duration representations,
+                     metering, barring and time signature utilities, plus midi and MusicXML support.
+license:             BSD3
+license-file:        LICENSE
+author:              Stuart Popejoy
+maintainer:          spopejoy@panix.com
+build-type:          Simple
+cabal-version:       >=1.10
+source-repository head
+  type:     git
+  location: https://github.com/slpopejoy/fadno.git
+
+library
+  exposed-modules:
+                  Fadno.Meter
+                  Fadno.Midi
+                  Fadno.Notation
+                  Fadno.Note
+                  Fadno.Util
+                  Fadno.Xml
+
+
+  -- other-modules:
+  -- other-extensions:
+  build-depends:       Decimal == 0.4.*
+                     , HUnit == 1.5.*
+                     , base == 4.9.*
+                     , containers == 0.5.*
+                     , comonad == 5.*
+                     , data-default == 0.7.*
+                     , deepseq == 1.4.*
+                     , event-list == 0.1.*
+                     , fadno-braids == 0.1.*
+                     , fadno-xml == 1.1.*
+                     , lens == 4.15.*
+                     , midi == 0.2.*
+                     , mtl == 2.2.*
+                     , process == 1.4.*
+                     , safe == 0.3.*
+                     , split == 0.2.*
+                     , text == 1.2.*
+                     , unordered-containers == 0.2.*
+                     , vector == 0.12.*
+                     , xml == 1.3.*
+  hs-source-dirs: src
+  default-language:    Haskell2010
+
+test-suite tests
+  type: exitcode-stdio-1.0
+  main-is: Tests.hs
+  hs-source-dirs: tests
+  default-language:    Haskell2010
+  build-depends:
+                base
+              , containers
+              , HUnit
+              , fadno
+              , lens
+              , hspec
+              , hspec-contrib
diff --git a/src/Fadno/Meter.hs b/src/Fadno/Meter.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Meter.hs
@@ -0,0 +1,279 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts #-}
+module Fadno.Meter where
+
+import Fadno.Notation
+import Fadno.Note
+import Control.Lens hiding (Empty,pre)
+import Data.Foldable
+import Test.HUnit
+import Data.Ratio
+import GHC.Real
+import Data.Maybe
+import Data.List (sort,sortBy,nub)
+import Data.Function
+import Control.Arrow
+import qualified Data.Map.Strict as M
+import Safe
+import Fadno.Util
+
+type HasRatioNotes t n p = (Traversable t, HasNote n p Rational)
+
+--
+-- REBAR
+--
+
+-- | use 'rebar' with multiple input "bars".
+rebars :: (HasRatioNotes b n p, HasRatioNotes c m p,Monoid p,Eq p,
+           Monoid (c m), Monoid (b n),HasTimeSignature (c m),
+           Snoc (c m) (c m) m m,HasTie m,Show (c m)) =>
+          TimeSignature -> [b n] -> [c m]
+rebars ts = rebar ts . mconcat
+
+-- | Given a time signature and a "bar" (Traversable "b" of HasNotes "n"),
+-- make new "bars" (Traversable "c" of HasNotes "m"),
+-- partitioning notes, applying ties as needed,
+-- and decorating with the time signature.
+rebar :: (HasRatioNotes b n p, HasRatioNotes c m p,Monoid p,Eq p,Monoid (c m),
+          HasTimeSignature (c m),Snoc (c m) (c m) m m,HasTie m,Show (c m)) =>
+         TimeSignature -> b n -> [c m]
+rebar ts = reverse . fixup . foldl' go [mempty] . fmap fromNote where
+    tslen = tsToRatio ts
+    go [] _ = error "impossible"
+    go bss@(b:bs) n | barlen == tslen = go (mempty:bss) n
+                    | newBarLen <= tslen = (b |> n):bs
+                    | otherwise = {- trace1' "otherwise" (remaining, ndur) $ -} go ((b |> pre):bs) post
+        where barlen = sumDurs b
+              ndur = view noteDur n
+              newBarLen = barlen + ndur
+              remaining = newBarLen - tslen
+              post = tieMay TStop . set noteDur remaining $ n
+              pre = tieMay TStart . set noteDur (ndur - remaining) $ n
+    -- fixup: set head and tail timesigs
+    fixup [] = []
+    fixup bs = over _head fixLast . joinLast . over _last (timeSignature ?~ ts) $ bs
+    fixLast b | barlen == tslen = b
+              | otherwise = case tsFromRatio' ts barlen of
+                              Just t -> b & timeSignature ?~ t
+                              Nothing -> b
+              where barlen = sumDurs b
+    -- joinLast: apply heuristic that an additional bar less than 1/2 the ts length
+    -- should be merged with the prior bar.
+    joinLast aas@(a:b:as) | sumDurs a + sumDurs b < tslen * (3%2) =
+                              (b `mappend` a):as -- leave notes tied. why not.
+                          | otherwise = aas
+    joinLast a = a
+
+
+
+-- | 'rebar' using 'Bar' and 'Note\'' for output.
+rebar' :: (HasRatioNotes b n p,Monoid p,Eq p,Show p) =>
+          TimeSignature -> b n -> [Bar (Note' p Rational)]
+rebar' = rebar
+
+-- | 'rebars' using 'Bar' and 'Note\'' for output.
+rebars' :: (HasRatioNotes b n p,Monoid (b n),Monoid p,Eq p,Show p) =>
+           TimeSignature -> [b n] -> [Bar (Note' p Rational)]
+rebars' = rebars
+
+-- | Set tie if not a rest
+tieMay :: (Eq a, Monoid a, HasNote s a d, HasTie s) => Tie -> s -> s
+tieMay end v | isRest v = v
+             | otherwise = over tie setTie v
+             where setTie o@(Just old) | old == end = o
+                                       | otherwise = Just TBoth
+                   setTie Nothing = Just end
+
+
+
+--
+-- TIE RULES
+--
+
+-- | Representable duration denominators.
+--
+-- For standard base-2 durs, 2 and 4 are spurious as they reduce to 1,
+-- thus 1 plus the "dot values" 3,7.
+--
+-- For non-standard (quintuples etc), we admit 2 and 4 as well, for e.g. 2%5,
+-- a "half-note" under a quarter-quintuple. Anything greater
+-- exceeding the understanding limit: 8%17 can certainly be represented as
+-- a half-note, but it makes little sense to the reader.
+validDenoms :: [Integer]
+validDenoms = [1,2,3,4,7]
+
+-- | Max representable duration.
+maxDur :: Rational
+maxDur = 2
+
+-- | Test for representational duration per 'validDenoms' and 'maxDur'.
+validDur :: Rational -> Bool
+validDur r = r == maxDur ||
+             (r < maxDur && numerator r `elem` validDenoms)
+
+-- | Tie rules that work across any denominators, such that
+-- 5%8 -> [1%2,1%8], 9%16 -> [1%2,1%16],  11%16 -> [1%2,3%16],
+-- 13%16 -> [3%2,1%16], 9%4 -> [2,1%4].
+splitDur :: Rational -> [Rational]
+splitDur r | r < 0 = error "splitDur: negative duration"
+           | r == 0 = []
+           | validDur r = [r]
+           -- NB: subtraction doesn't preserve denom (17:%20 - 3%5 -> 1%4, not 5%20)
+           | otherwise = split:splitDur (r - split)
+           where split = findSplit r
+
+-- | Find split by 1) finding largest power-of-2 fraction under value or
+-- 2) finding longest power-of-two denominator split, up to 8.
+findSplit :: Rational -> Rational
+findSplit r = case filter validDur candidates of
+                [] -> splitOnValid
+                (v:_) -> v
+    where
+      n = numerator r
+      d = denominator r
+      pow2s = [x | p <- [(1 :: Integer)..], x<-[2^p]]
+      denomPow2s = reverse $ takeWhile (\v -> v < d && d `rem` v == 0) pow2s
+      candidates = filter (<r) $ map (\cd -> (n * cd `div` d) :% (d `div` cd)) denomPow2s
+      splitOnValid = case filter (<= min r maxDur) $ map (:%d) $ reverse $
+                     takeWhile (<min n 8) pow2s of
+                       [] -> r
+                       (v:_) -> v
+
+-- | Apply rules in 'splitDur' and tie affected notes.
+tieRules :: (HasRatioNotes b n p, HasTie n, Monoid p, Eq p, Show n,
+             HasRatioNotes c m p, HasTie m, Monoid (c m),
+             Snoc (c m) (c m) m m) => b n -> c m
+tieRules = foldl' apply mempty where
+    apply r n = case splitDur (view noteDur n) of
+                       [] -> error $ "tieRules: empty result from splitDur for " ++ show n
+                       [_] -> r |> set tie (view tie n) (fromNote n)
+                       ds -> foldl (|>) r . fixLast . fixFirst . map mkTied $ ds
+                           where mkTied d = tieMay TBoth (set noteDur d (fromNote n))
+                                 forOrgTie t = case view tie n of
+                                                 Nothing -> t
+                                                 (Just a) | a == t -> t
+                                                          | otherwise -> TBoth
+                                 fixFirst = over (_head.tie) (fmap (const (forOrgTie TStart)))
+                                 fixLast = over (_last.tie) (fmap (const (forOrgTie TStop)))
+
+
+
+-- | Monomorphic-result 'tieRules
+tieRules' :: (HasRatioNotes b n p, HasTie n, Monoid p, Eq p, Show n) =>
+             b n -> Bar (Note' p Rational)
+tieRules' = tieRules
+
+
+--
+-- SELECT TIMESIG
+--
+
+-- | Weights and pulse values for pre-configured TSs.
+data TsConfig = TsConfig {
+      _tSig :: TimeSignature
+    , _tWeight :: Rational
+    , _tPulse :: Rational
+    } deriving (Eq,Show)
+makeLenses ''TsConfig
+
+selectTimeSig :: HasRatioNotes t n p => [t n] -> Maybe TimeSignature
+selectTimeSig phrases = fmap fst $ headMay $ selectTimeSigs phrases
+
+-- | Combine scores from phrases.
+selectTimeSigs :: HasRatioNotes t n p => [t n] -> [(TimeSignature,Rational)]
+selectTimeSigs = mergeScores . preferDivisableHeads . map selectTsConfigs where
+    mergeScores = sortBy (flip compare `on` snd) .
+                  M.toList . foldl1 (M.unionWith (+)) .
+                  map (M.fromListWith max . map (_tSig &&& _tWeight))
+
+
+-- | nutty heuristic that overweights a TS for a uniform duration divisor
+preferDivisableHeads :: [[TsConfig]] -> [[TsConfig]]
+preferDivisableHeads [] = []
+preferDivisableHeads [a] = [a]
+preferDivisableHeads phraseTss =
+    case sequence (map headMay phraseTss) of
+      Nothing -> phraseTss
+      Just heads | length (nub heads) == 1 -> phraseTss
+                 | otherwise -> case nub $ (zipWith commonDivHeur <*> tail) (map tsConfigToDur heads) of
+                      [] -> phraseTss
+                      [a] -> maybe phraseTss ((:phraseTss).return) $ tsConfigFromDur 100 a
+                      _ -> phraseTss
+
+-- | main heuristic is finding the common divisible duration,
+-- with requirement that it must be greater than 1/4 the difference between the durations.
+-- Hopefully avoids crappy tiny TSs like 2/8.
+commonDivHeur :: Rational -> Rational -> Rational
+commonDivHeur d1 d2 | d1 == d2 = d1
+                | c / (abs (d1 - d2)) > (1%4) = min d1 d2
+                | otherwise = c
+                where c = d1 / fromIntegral (numerator (d1/d2))
+
+
+tsConfigToDur :: TsConfig -> Rational
+tsConfigToDur = tsToRatio . _tSig
+
+
+
+-- | Attempt to construct a TS config from duration
+tsConfigFromDur :: Rational -> Rational -> Maybe TsConfig
+tsConfigFromDur weight = fmap (\t -> TsConfig t weight (minMedianDur (_tsUnit t))) . tsFromRatio
+
+-- | Pre-configured timesigs.
+tsConfigs :: [TsConfig]
+tsConfigs = [TsConfig (4/:Q4) 9 (1%4)
+            ,TsConfig (3/:Q4) 8 (1%4)
+            ,TsConfig (6/:Q8) 8 (3%8)
+            ,TsConfig (12/:Q8) 7 (3%8)
+            ,TsConfig (2/:Q4) 6 (1%4)
+             ,TsConfig (5/:Q4) 5 (5%4)
+             ,TsConfig (5/:Q8) 5 (5%8)
+             ,TsConfig (7/:Q4) 5 (7%4)
+            ,TsConfig (7/:Q8) 5 (7%8)
+             ,TsConfig (9/:Q8) 5 (3%8)
+            ]
+
+
+-- | Given a median note duration, minima for acceptable quanta.
+minMedianDur :: Quanta -> Rational
+minMedianDur q = fromMaybe (1%32) . lookup q $
+                                   [(Q8,1%32),(Q4,1%16),(Q2,1%4)]
+
+-- | Given a phrase, select configs
+selectTsConfigs :: HasRatioNotes t n p => t n -> [TsConfig]
+selectTsConfigs phrase | null phrase = []
+                       | otherwise = sortBy (flip compare `on` _tWeight) $
+                                     mapMaybe (evalTsConfig phrase)
+                                     -- append custom-length TS as lowest-weight choice
+                                     (maybe tsConfigs (:tsConfigs) (tsConfigFromDur 4 (sumDurs phrase)))
+
+-- | Filter and score time signatures per heuristics.
+evalTsConfig :: HasRatioNotes t n p => t n -> TsConfig -> Maybe TsConfig
+evalTsConfig phrase c@(TsConfig ts@(TimeSignature _n q) _ pulse)
+    | medianDur < minMedianDur q = Nothing -- density filter
+    | phraseDur < tsDur = Nothing -- min duration filter
+    | tsDur >= 2 = Nothing -- too long TS
+    | phraseDur == tsDur = Just $ over tWeight (* (9%4)) c -- exact length match bonus,
+    | otherwise = Just $ over tWeight computeWeight c
+        where medianDur = sort (toListOf (traverse.noteDur) phrase) !! (phraseLength `div` 2)
+              phraseLength = length phrase
+              phraseDur = sumDurs phrase
+              tsDur = tsToRatio ts
+              -- scale by pulse coverage, subtract by divisibility by ts duration
+              computeWeight w = (w * pulseCoverage pulse phrase) - (phraseDur `frem` tsDur)
+
+-- | 'rem' for 'RealFrac'
+frem :: RealFrac a => a -> a -> a
+frem a b = let (_ :: Int,f) = properFraction (a/b) in f
+
+isDivBy :: RealFrac a => a -> a -> Bool
+isDivBy a b = 0 == frem a b
+
+-- | Compute percentage of notes falling on pulse values.
+pulseCoverage :: HasRatioNotes t n p => Rational -> t n -> Rational
+pulseCoverage pulse phrase = fromIntegral pulseNoteCount % fromIntegral (length phrase)
+    where
+      pulseNoteCount = length . filter ((`isDivBy` pulse) . fst) . mapTime $ phrase
diff --git a/src/Fadno/Midi.hs b/src/Fadno/Midi.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Midi.hs
@@ -0,0 +1,193 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# OPTIONS_GHC -fno-warn-warnings-deprecations #-}
+
+
+module Fadno.Midi where
+
+import Sound.MIDI.File as MFile
+import Data.EventList.Relative.TimeBody as EList hiding (concat,traverse)
+import Sound.MIDI.File.Event as MEvent
+import Sound.MIDI.File.Event.Meta as MMeta
+import Sound.MIDI.Message.Channel as MChan
+import Sound.MIDI.Message.Channel.Voice as MVoice
+import Sound.MIDI.File.Load
+import Sound.MIDI.File.Save
+import Sound.MIDI.General
+import Fadno.Note
+import Data.List (mapAccumL)
+import Control.Lens
+import Control.Arrow
+import System.Process
+import Control.Monad
+import Data.Ratio
+
+-- | Serializable midi data.
+type MidiData = MFile.T
+
+type IPitch = Int
+type IDur = Int
+
+-- | Convert some note value to midi-ready values.
+class MidiNotes a where
+    toMidiNotes :: a -> [([IPitch],IDur)]
+
+instance MidiNotes [([IPitch],IDur)] where toMidiNotes = id
+
+instance {-# OVERLAPPING #-} (Integral p, Traversable c, Integral d, Traversable t) => MidiNotes (t (Note (c p) d))  where
+    toMidiNotes = map ((map fromIntegral . toListOf traverse) *** fromIntegral) .
+                  toListOf (traverse.toPair)
+
+instance (Integral p, Integral d, Traversable t) => MidiNotes (t (Note p d))  where
+    toMidiNotes = map (return.fromIntegral *** fromIntegral) . toListOf (traverse.toPair)
+
+
+-- | Tempo in microseconds per quarter. See 'fromBPM'.
+newtype MidiTempo = MidiTempo Int
+    deriving (Eq,Show,Enum,Bounded,Ord,Num,Real,Integral)
+
+-- | Midi channel, 1-16 presumably.
+newtype MidiChan = MidiChan Int
+    deriving (Eq,Show,Enum,Bounded,Ord,Num,Real,Integral)
+
+-- | note velocity, 0-127
+newtype MidiVelocity = MidiVelocity Int
+    deriving (Eq,Show,Enum,Bounded,Ord,Num,Real,Integral)
+
+-- | Midi program. See 'fromInstrument'.
+newtype MidiProgram = MidiProgram Int
+    deriving (Eq,Show,Enum,Bounded,Ord,Num,Real,Integral)
+
+-- | Midi ticks per quarter.
+newtype MidiTicks = MidiTicks Int
+    deriving (Eq,Show,Enum,Bounded,Ord,Num,Real,Integral)
+
+-- | Rational to ticks
+toTicks :: MidiTicks -> Iso' Rational IDur
+toTicks t = iso to' from' where
+    to' = truncate . (* fromIntegral (t*4))
+    from' = (% fromIntegral (t*4)) . fromIntegral
+
+
+-- | Internal type for midi event or pad.
+data MidiEvent = Pad IDur | Event MEvent.T
+
+-- | cover our tracks
+type MidiTrack = Track
+
+
+-- | write to disk.
+writeMidiFile :: FilePath -> MidiData -> IO ()
+writeMidiFile = toFile
+
+-- | debug midi file.
+showMidiFile :: FilePath -> IO ()
+showMidiFile = showFile
+
+-- | Make midi file data
+midi :: MidiTicks -> [MidiTrack] -> MidiData
+midi ticks = MFile.Cons Parallel (Ticks (toTempo $ fromIntegral ticks))
+
+-- | make a standard track which specifies tempo and program.
+-- | see 'makeTrack' for more control.
+makeTrackFull
+  :: (MidiNotes notes) =>
+     MidiTempo
+     -> MidiChan
+     -> MidiProgram
+     -> MidiVelocity
+     -> notes
+     -> MidiTrack
+makeTrackFull tempo chan prog vel notes =
+    makeTrack $ setTempo tempo:
+                programChange chan prog:
+                toNoteEvents chan vel notes
+
+
+-- | BPM to microseconds per quarter note.
+fromBPM :: (Real a, Show a) => a -> MidiTempo
+fromBPM b | b > 0 = floor (60 * 1000000 / toRational b)
+          | otherwise = error $ "fromBPM: must be > 0: " ++ show b
+
+-- | convert a General MIDI 'Instrument'.
+fromInstrument :: Instrument -> MidiProgram
+fromInstrument = fromIntegral . fromEnum
+
+-- | make a track from track events.
+makeTrack :: [MidiEvent] -> MidiTrack
+makeTrack = fromPairList . concat . snd . mapAccumL conv 0
+    where conv :: IDur -> MidiEvent -> (IDur,[(ElapsedTime,MEvent.T)])
+          conv _ (Pad dur) = (dur,[])
+          conv off (Event e) = (0,[(toElapsedTime $ fromIntegral off,e)])
+
+
+-- | turn notes into track events.
+toNoteEvents :: MidiNotes notes => MidiChan -> MidiVelocity -> notes -> [MidiEvent]
+toNoteEvents chan vel = concatMap (noteEvents chan vel) . toMidiNotes
+
+
+-- | create a "Voice" MIDI event
+voiceEvent :: MidiChan -> MVoice.T -> MidiEvent
+voiceEvent chan = midiEvent chan . Voice
+
+-- | tempo meta event.
+setTempo :: MidiTempo -> MidiEvent
+setTempo = metaEvent . SetTempo . toTempo . fromIntegral
+
+-- | create a "Meta" MIDI event
+metaEvent :: MMeta.T -> MidiEvent
+metaEvent = Event . MetaEvent
+
+-- | create a "Voice" or "Mode" MIDI event.
+midiEvent :: MidiChan -> MChan.Body -> MidiEvent
+midiEvent chan = Event . MIDIEvent . MChan.Cons (toChannel $ fromIntegral chan)
+
+-- TODO: sysex.
+
+-- | program change MIDI Voice event.
+programChange :: MidiChan -> MidiProgram -> MidiEvent
+programChange chan prog = voiceEvent chan (ProgramChange (toProgram $ fromIntegral prog))
+
+-- | note on + note off events, using 'Pad' to carve out space.
+noteEvents :: MidiChan -> MidiVelocity -> ([IPitch],IDur) -> [MidiEvent]
+noteEvents chan vel (ps,dur) = evs noteOn ++ [Pad dur] ++ evs noteOff
+    where evs f = map (f chan vel . fromIntegral) ps
+
+-- TODO: figure out polymorphic way to attach velocity and anything else to notes.
+
+-- | note on or note off event.
+noteEvent :: (Pitch -> Velocity -> MVoice.T) ->
+             MidiChan -> MidiVelocity -> IPitch -> MidiEvent
+noteEvent f chan vel pitch = voiceEvent chan
+                             (f (toPitch (fromIntegral pitch))
+                                    (toVelocity $ fromIntegral vel))
+noteOn :: MidiChan -> MidiVelocity -> IPitch -> MidiEvent
+noteOn = noteEvent NoteOn
+
+noteOff :: MidiChan -> MidiVelocity -> IPitch -> MidiEvent
+noteOff = noteEvent NoteOff
+
+
+test1 :: IO ()
+test1 = playMidi "/tmp/first.midi" 120 [(AcousticGrandPiano,
+         map (uncurry Note)
+                 [([60 :: Int],48 :: Int),([61],48),([62],24),([64],64),
+                  ([],96),([60,66],96)])]
+
+
+playMidi :: MidiNotes n => FilePath -> Int -> [(Instrument,n)] -> IO ()
+playMidi file bpm tracks = do
+    writeMidiFile file $ midi 96 $ map (\(inst,notes) -> makeTrackFull (fromBPM bpm) 0 (fromInstrument inst) 127 notes) tracks
+    void $ createProcess (shell $ "scripts/qt7play.applescript " ++ file)
+
+
+
+-- playMidi "/tmp/boston.mid" DrawbarOrgan notes
+-- let boston = [Db@:5,F@:4,Db@:5,Eb@:5,Ab@:4,C@:5]
+-- map (\p -> (p - 60) * 2 + 60)
+-- let notes = concat $ replicate 8 $ map (`Note` (1 % 16)) boston
+-- playMidi "/tmp/boston.mid" DrawbarOrgan 140
+--    (toListOf (traverse.seconding (toTicks 96)) notes)
diff --git a/src/Fadno/Notation.hs b/src/Fadno/Notation.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Notation.hs
@@ -0,0 +1,255 @@
+{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE ImpredicativeTypes #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module Fadno.Notation where
+
+import GHC.Generics
+import Data.String
+import Data.Default
+import Fadno.Note
+import Control.Lens hiding (pre)
+import Data.Typeable
+import Data.Ratio
+import Data.Sequence (Seq,fromList)
+import Data.Foldable
+import Test.HUnit
+import Data.List
+import Data.Maybe
+
+
+-- valid time sig denoms
+data Quanta = Q2|Q4|Q8|Q16|Q32|Q64
+               deriving (Eq,Show,Ord,Enum,Bounded,Typeable)
+
+qToInt :: Quanta -> Int
+qToInt = (2^) . succ . fromEnum
+qFromInt :: Integral i => i -> Maybe Quanta
+qFromInt = fmap toEnum . (`elemIndex` [2,4,8,16,32,64])
+
+
+data TimeSignature = TimeSignature { _tsLength :: Int, _tsUnit :: Quanta }
+   deriving (Eq,Ord)
+instance Show TimeSignature where
+    show (TimeSignature l u) = show l ++ "/:" ++ show u
+makeLenses ''TimeSignature
+class HasTimeSignature a where timeSignature :: Lens' a (Maybe TimeSignature)
+
+(/:) :: Int -> Quanta -> TimeSignature
+(/:) = TimeSignature
+
+-- PPQ: valid midi divisions, named after equivalent Quantum
+-- as in, "1 means ..."; PQ4 is "1 means quarter note"
+data PPQ = PQ4|PQ8|PQ16|PQ32|PQ64|PQ128|PQ256
+         deriving (Eq,Show,Ord,Enum,Bounded)
+
+
+-- convert to midi division value
+ppqDiv :: Integral a => PPQ -> a
+ppqDiv = (2^) . fromEnum
+
+
+-- Compute duration of TS
+tsToRatio :: TimeSignature -> Rational
+tsToRatio (TimeSignature n d) = fromIntegral n % fromIntegral (qToInt d)
+
+-- Derive TS from duration, with 1 denominator implying Q4
+tsFromRatio :: Rational -> Maybe TimeSignature
+tsFromRatio r = toTs (if d == 1 then 4 else (if n == 1 then 2 else 1))
+    where toTs m = (fromIntegral (n * m) /:) <$> qFromInt (d * m)
+          d = denominator r
+          n = numerator r
+
+
+tsFromRatio' :: TimeSignature -> Rational -> Maybe TimeSignature
+tsFromRatio' (TimeSignature _ src) = fmap adjust . tsFromRatio where
+    adjust t@(TimeSignature n d) | src <= d = t
+                                 | otherwise = (n * m) /: src
+                                 where qd = qToInt d
+                                       qs = qToInt src
+                                       m = qs `div` qd
+
+
+-- | Duration iso, from Integral to Rational, given PPQ
+ratioPPQ :: Integral a => PPQ -> Iso' a Rational
+ratioPPQ p = iso toRat toInt where
+    ppq4 = ppqDiv p * 4
+    toRat i = fromIntegral i % fromIntegral ppq4
+    toInt r = truncate (r * toRational ppq4)
+
+-- | Adapt a type to its HasXXX "Maybe Lens'"
+adaptHas :: Lens' a (Maybe a)
+adaptHas f s = fromMaybe s <$> f (Just s)
+
+-- | Adapt a non-Maybe lens to the HasXXX "Maybe Lens'"
+adaptHasLens :: Lens' s a -> Lens' s (Maybe a)
+adaptHasLens l f s = fmap (maybe s (\a -> set l a s)) (f (Just (view l s)))
+
+-- | Adapt a type that does NOT support the HasXXX feature.
+adaptHasNot :: Lens' s (Maybe a)
+adaptHasNot f s = fmap (const s) (f Nothing)
+
+
+-- | Tied notes.
+data Tie = TStart | TStop | TBoth
+    deriving (Eq,Bounded,Enum,Ord,Show)
+makeLenses ''Tie
+class HasTie a where tie :: Lens' a (Maybe Tie)
+instance HasTie Tie where tie = adaptHas
+instance HasTie (Note p d) where tie = adaptHasNot
+
+
+-- | Slurred notes.
+data Slur = SStart | SStop
+    deriving (Eq,Bounded,Enum,Ord,Show)
+makeLenses ''Slur
+class HasSlur a where slur :: Lens' a (Maybe Slur)
+instance HasSlur Slur where slur = adaptHas
+
+-- | Note articulations.
+data Articulation = Staccato | Accent
+    deriving (Eq,Show,Bounded,Enum,Ord)
+class HasArticulation a where articulation :: Lens' a (Maybe Articulation)
+instance HasArticulation Articulation where articulation = adaptHas
+
+
+-- | Bar rehearsal mark.
+newtype RehearsalMark = RehearsalMark { _rehearsalText :: String }
+    deriving (Eq,Ord,IsString,Generic,Monoid,Default)
+makeLenses ''RehearsalMark
+instance Show RehearsalMark where show = show . _rehearsalText
+class HasRehearsalMark a where rehearsalMark :: Lens' a (Maybe RehearsalMark)
+instance HasRehearsalMark RehearsalMark where rehearsalMark = adaptHas
+
+-- | Musical direction.
+newtype Direction = Direction { _directionText :: String }
+    deriving (Eq,Ord,IsString,Generic,Monoid,Default)
+makeLenses ''Direction
+instance Show Direction where show = show . _directionText
+class HasDirection a where direction :: Lens' a (Maybe Direction)
+instance HasDirection Direction where direction = adaptHas
+
+-- | Barline.
+data Barline = Double | Final
+    deriving (Eq,Show,Ord,Generic)
+class HasBarline a where barline :: Lens' a (Maybe Barline)
+instance HasBarline Barline where barline = adaptHas
+
+data Repeats = RStart | REnd | RBoth
+    deriving (Eq,Show,Ord,Generic)
+class HasRepeats a where repeats :: Lens' a (Maybe Repeats)
+instance HasRepeats Repeats where repeats = adaptHas
+
+data Clef = TrebleClef | BassClef | AltoClef | PercClef
+    deriving (Eq,Show,Ord,Generic)
+makeLenses ''Clef
+class HasClef a where clef :: Lens' a (Maybe Clef)
+instance HasClef Clef where clef = adaptHas
+
+
+-- | Part identifier, prefers 'Num' or 'IsString' values.
+newtype Part a = Part { _partIdx :: a }
+    deriving (Eq,Generic,Ord,Functor,Bounded,Foldable,Traversable,Real,Num,IsString)
+makeLenses ''Part
+instance (Show a) => Show (Part a) where show = show._partIdx
+class HasPart a b | a -> b where part :: Lens' a (Maybe (Part b))
+
+-- | Lensy show of a Maybe field, given a 'Getter' and its name.
+mshow :: (Show a) => Getter s (Maybe a) -> String -> s -> String
+mshow l n = maybe "" (\v -> " & " ++ n ++ " ?~ " ++ show v) . view l
+
+-- | 'concatMap' show functions with a prelude.
+mshows :: s -> String -> [s -> String] -> String
+mshows s pre = (pre ++) . concatMap ($ s)
+
+-- Example types.
+
+-- | Note with notations.
+data Note' p d = Note' {
+      _nNote :: Note p d
+    , _nTie :: Maybe Tie
+    , _nSlur :: Maybe Slur
+    , _nArticulation :: Maybe Articulation
+    } deriving (Eq,Generic)
+
+makeLenses ''Note'
+instance HasNote (Note' p d) p d where
+    note = nNote
+    fromNote = note' . view note
+instance HasTie (Note' p d) where tie = nTie
+instance HasSlur (Note' p d) where slur = nSlur
+instance HasArticulation (Note' p d) where articulation = nArticulation
+instance (Show p, Show d) => Show (Note' p d) where
+    show n = mshows n ("note' (" ++ show (view nNote n) ++ ")")
+             [mshow tie "tie"
+             ,mshow slur "slur"
+             ,mshow articulation "articulation"
+             ]
+
+
+-- | Note smart ctor, used in 'Show'.
+note' :: Note p d -> Note' p d
+note' n = Note' n Nothing Nothing Nothing
+
+testNote :: Note' [Int] Int
+testNote = note' ([60]|:2) & tie ?~ TStart & articulation ?~ Accent
+
+-- | Bar as list of notes, with notations.
+data Bar n = Bar {
+      _bNotes :: Seq n
+    , _bRehearsalMark :: Maybe RehearsalMark
+    , _bDirection :: Maybe Direction
+    , _bBarline :: Maybe Barline
+    , _bRepeats :: Maybe Repeats
+    , _bTimeSignature :: Maybe TimeSignature
+    , _bClef :: Maybe Clef
+    } deriving (Eq,Generic,Functor,Foldable,Traversable)
+makeLenses ''Bar
+instance Default (Bar n) where def = bar []
+instance Snoc (Bar n) (Bar n) n n where
+    _Snoc = prism (\(b,n) -> over bNotes (review _Snoc . (,n)) b) $
+            \b -> case firstOf _Snoc (view bNotes b) of
+                    Nothing -> Left (def :: Bar n)
+                    (Just (as,a)) -> Right (set bNotes as b,a)
+instance Cons (Bar n) (Bar n) n n where
+    _Cons = prism (\(n,b) -> over bNotes (review _Cons . (n,)) b) $
+            \b -> case firstOf _Cons (view bNotes b) of
+                    Nothing -> Left (def :: Bar n)
+                    (Just (a,as)) -> Right (a,set bNotes as b)
+instance HasRehearsalMark (Bar n) where rehearsalMark = bRehearsalMark
+instance HasDirection (Bar n) where direction = bDirection
+instance HasBarline (Bar n) where barline = bBarline
+instance HasTimeSignature (Bar n) where timeSignature = bTimeSignature
+instance HasClef (Bar n) where clef = bClef
+instance HasRepeats (Bar n) where repeats = bRepeats
+instance (Show n) => Show (Bar n) where
+    show b = mshows b ("bar " ++ show (toList $ view bNotes b))
+             [mshow rehearsalMark "rehearsalMark"
+             ,mshow direction "direction"
+             ,mshow barline "barline"
+             ,mshow repeats "repeat"
+             ,mshow timeSignature "timeSignature"
+             ,mshow clef "clef"
+             ]
+instance Monoid (Bar n) where
+    mempty = def
+    a `mappend` b = over bNotes (`mappend` view bNotes b) a
+
+-- | Bar smart ctor, used in 'Show'.
+bar :: [n] -> Bar n
+bar ns = Bar (fromList ns) Nothing Nothing Nothing Nothing Nothing Nothing
+
+testBar :: Bar (Note [Int] Int)
+testBar = bar [[60]|:2,[62]|:1] & timeSignature ?~ TimeSignature 4 Q4 & direction ?~ "Softly"
diff --git a/src/Fadno/Note.hs b/src/Fadno/Note.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Note.hs
@@ -0,0 +1,250 @@
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE MultiParamTypeClasses #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE DeriveFunctor #-}
+
+module Fadno.Note
+    (Note(..),pitch,dur
+    ,HasNote(..),toPair,(|:)
+    ,Mono(..),maybeMono,mono,mono',mPitch,unMono,catMonos,_M
+    ,rest,isRest
+    ,Spelling(..),fromChroma,toChroma,spelling
+    ,PitchRep(..),prPitch,prOctave,(@:),pitchRep
+    ,sumDurs,mapTime
+    ,tied,tied',legato,legato',merge
+    ,transpose,transpose'
+    ,(%)
+    )
+where
+
+import Control.Lens
+import Control.Arrow
+import Data.Ratio
+import GHC.Generics (Generic)
+import Data.Traversable
+import Data.Function
+import Data.Foldable
+
+-- | Note = pitch and duration.
+data Note p d = Note { _pitch :: p, _dur :: d }
+                deriving (Eq,Generic)
+$(makeLenses ''Note)
+
+instance (Show p, Show d) => Show (Note p d) where
+    show (Note p d) = show p ++ "|:" ++ show d
+instance Bifunctor Note where
+    bimap f g (Note a b) = Note (f a) (g b)
+instance Field1 (Note a b) (Note a' b) a a'
+instance Field2 (Note a b) (Note a b') b b'
+
+-- | Hand-rolled class providing monomorphic lenses.
+class HasNote s p d | s -> p d where
+  note :: Lens' s (Note p d)
+  fromNote :: (HasNote n p d) => n -> s
+  notePitch :: Lens' s p
+  notePitch = note.pitch
+  noteDur :: Lens' s d
+  noteDur = note.dur
+instance HasNote (Note p d) p d where
+    note = ($)
+    fromNote = view note
+
+-- iso with pair
+toPair :: Iso' (Note p d) (p,d)
+toPair = iso (\(Note p d) -> (p,d)) (uncurry Note)
+
+
+infixl 5 |:
+-- | 'Note' smart constructor.
+(|:) :: p -> d -> Note p d
+(|:) = Note
+
+-- | Monophonic pitch functor, i.e. Maybe with a sum monoid.
+data Mono p = Rest | M { _mPitch :: p }
+    deriving (Eq,Ord,Functor)
+instance (Show p)=>Show (Mono p) where
+    show Rest = "Rest"
+    show (M p) = "M " ++ show p
+makeLenses ''Mono
+makePrisms ''Mono
+instance Num p => Monoid (Mono p) where
+    mempty = Rest
+    mappend Rest b = b
+    mappend a Rest = a
+    mappend (M a) (M b) = M (a + b)
+-- | Mono/Maybe isomorphism.
+maybeMono :: Iso' (Maybe a) (Mono a)
+maybeMono = iso toMono toMaybe
+    where toMono Nothing = Rest
+          toMono (Just a) = M a
+          toMaybe Rest = Nothing
+          toMaybe (M a) = Just a
+
+-- | Mono 'HasNote'
+mono :: HasNote n (Mono p) d => p -> d -> n
+mono p = fromNote . mono' p
+
+-- | Mono 'Note'.
+mono' :: p -> d -> Note (Mono p) d
+mono' p = Note (M p)
+
+-- | Mono eliminator
+unMono :: b -> (a -> b) -> Mono a -> b
+unMono b _ Rest = b
+unMono _ f (M a) = f a
+
+-- | cf 'catMaybe'. Grab all non-rest values.
+catMonos :: Foldable f => f (Mono a) -> [a]
+catMonos = foldMap (unMono [] pure)
+
+-- | 'Note' from duration, given 'Monoid' pitch.
+-- Interoperates with 'chord' and 'mono'.
+-- Useful for batch duration conversion.
+rest :: (HasNote n p d, Monoid p) => d -> n
+rest = fromNote . rest'
+
+rest' :: Monoid p => d -> Note p d
+rest' = Note mempty
+
+isRest :: (Monoid p, Eq p, HasNote n p d) => n -> Bool
+isRest = (mempty ==) . view notePitch
+
+
+
+
+-- | Chroma as enharmonic names.
+data Spelling = C|Cs|Db|D|Ds|Eb|E|F|Fs|Gb|G|Gs|Ab|A|As|Bb|B
+            deriving (Eq,Show,Read,Enum,Ord,Bounded,Generic)
+
+-- | Convert to 'Spelling' with 0==C, using 'Cs','Eb','Fs','Gs','Bb' enharmonics.
+fromChroma :: Integral a => a -> Spelling
+fromChroma 0 = C
+fromChroma 1 = Cs
+fromChroma 2 = D
+fromChroma 3 = Eb
+fromChroma 4 = E
+fromChroma 5 = F
+fromChroma 6 = Fs
+fromChroma 7 = G
+fromChroma 8 = Gs
+fromChroma 9 = A
+fromChroma 10 = Bb
+fromChroma 11 = B
+fromChroma n | n > 11 = fromChroma $ n `mod` 12
+             | otherwise = fromChroma $ n `mod` 12 + 12
+
+-- | 'Spelling' to 0-11.
+toChroma :: Integral a => Spelling -> a
+toChroma C = 0
+toChroma Cs = 1
+toChroma Db = 1
+toChroma D = 2
+toChroma Ds = 3
+toChroma Eb = 3
+toChroma E = 4
+toChroma F = 5
+toChroma Fs = 6
+toChroma Gb = 6
+toChroma G = 7
+toChroma Gs = 8
+toChroma Ab = 8
+toChroma A = 9
+toChroma As = 10
+toChroma Bb = 10
+toChroma B = 11
+
+-- | 'Spelling'-to-chroma degenerate 'Iso'.
+spelling :: Integral a => Iso' a Spelling
+spelling = iso fromChroma toChroma
+
+-- | Represent pitch as chroma and octave.
+-- It's a full 'Num', 'Integral' instance, so negative octave values OK.
+-- Instances use C4 == 60.
+data PitchRep = PitchRep { _prPitch :: Spelling, _prOctave :: Int  }
+              deriving (Eq,Bounded,Generic)
+instance Show PitchRep where show (PitchRep s o) = show s ++ "@:" ++ show o
+$(makeLenses ''PitchRep)
+
+infixl 6 @:
+(@:) :: Spelling -> Int -> PitchRep
+(@:) = PitchRep
+
+instance Num PitchRep where
+    fromInteger i = fromChroma i @: ((fromIntegral i `div` 12) - 1)
+    a * b = fromIntegral (toInteger a * toInteger b)
+    a + b = fromIntegral (toInteger a + toInteger b)
+    abs = fromIntegral . abs . toInteger
+    signum = fromIntegral . signum . toInteger
+    negate = fromIntegral . negate . toInteger
+
+instance Enum PitchRep where
+    toEnum = fromInteger . fromIntegral
+    fromEnum = fromIntegral . toInteger
+
+instance Ord PitchRep where
+    a <= b = fromIntegral a <= fromIntegral b
+
+instance Real PitchRep where
+    toRational (PitchRep s o) = (((fromIntegral o + 1) * 12) + toChroma s) % 1
+
+instance Integral PitchRep where
+    toInteger = truncate . toRational
+    a `quotRem` b = (fromInteger *** fromInteger) (toInteger a `quotRem` toInteger b)
+
+-- | Iso to integrals.
+pitchRep :: Integral a => Iso' a PitchRep
+pitchRep = iso fromIntegral (fromIntegral . toInteger)
+
+
+--
+-- Utilities
+--
+
+-- | compute total duration of notes
+sumDurs :: (Num d, HasNote a p d, Traversable t) => t a -> d
+sumDurs = sumOf (traverse.noteDur)
+
+-- | map notes to arrival time
+mapTime :: (Num d, Ord d, HasNote a p d, Traversable t) => t a -> [(d,a)]
+mapTime = toList . snd .
+          mapAccumL (\t n -> (t + view noteDur n,(t,n))) 0
+
+-- | merge same-pitch notes
+tied :: (Eq p,Num d,HasNote a p d,Traversable t,
+          Traversable u,Snoc (u a) (u a) a a,Monoid (u a)) => t a -> u a
+tied = merge ((==) `on` view notePitch)
+
+tied' :: (Eq p,Num d,HasNote a p d,Traversable t) => t a -> [a]
+tied' = tied
+
+-- | merge rests with prior note
+legato :: (Eq p,Monoid p,Num d,HasNote a p d,Traversable t,
+          Traversable u,Snoc (u a) (u a) a a,Monoid (u a)) => t a -> u a
+legato = merge $ \_ n -> view notePitch n == mempty
+
+legato' :: (Eq p,Monoid p,Num d,HasNote a p d,Traversable t) => t a -> [a]
+legato' = legato
+
+
+-- | merge notes meeting some comparison by accumulating durations
+merge :: (Num d,HasNote a p d,Traversable t,
+          Traversable u,Snoc (u a) (u a) a a,Monoid (u a)) => (a -> a -> Bool) -> t a -> u a
+merge cmp = acc mempty . toListOf traverse where
+    acc rs [] = rs
+    acc (rs :> r) (n:ns) | cmp r n = acc (rs |> over noteDur (+ view noteDur n) r) ns
+    acc rs (n:ns) = acc (rs |> n) ns
+
+
+-- | Pitch addition
+transpose :: (Num p,HasNote a p d,Traversable t) => p -> t a -> t a
+transpose by = over (traverse.notePitch) (+by)
+
+-- | Pitch addition over a functor
+transpose' :: (Num p,Functor f, HasNote a (f p) d,Traversable t) => p -> t a -> t a
+transpose' by = over (traverse.notePitch.mapped) (+by)
diff --git a/src/Fadno/Util.hs b/src/Fadno/Util.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Util.hs
@@ -0,0 +1,153 @@
+{-# LANGUAGE RankNTypes #-}
+module Fadno.Util where
+
+import Control.Applicative
+import Control.Monad (replicateM)
+import Test.HUnit
+import Data.List
+import Data.Function (on)
+import qualified Debug.Trace as T
+import qualified Data.Map as M
+import qualified Data.Set as S
+import Control.Monad.State
+import Control.Lens
+
+-- compute intervals
+diff :: Num a => [a] -> [a]
+diff = zipTail (flip (-))
+
+-- a simple reducer.
+-- quicksilver says: zip`ap`tail - the Aztec god of consecutive numbers
+zipTail :: (a -> a -> c) -> [a] -> [c]
+zipTail f = zipWith f <*> tail
+
+-- opposite of diff, compute concrete notes from intervals
+integ :: Int -> [Int] -> [Int]
+integ = scanl (+)
+
+-- | 'Debug.Trace.trace' with brackets.
+trace :: String -> a -> a
+trace s = T.trace ("<" ++ s ++ ">")
+-- | trace with output of result.
+trace' :: Show a => String -> a -> a
+trace' s a = trace1 s a a
+-- | trace with extra variable, not showing result.
+trace1 :: Show b => String -> b -> a -> a
+trace1 s a = trace (s ++ ":" ++ show a)
+-- | trace with extra variable and output of result.
+trace1' :: (Show a, Show b) => String -> b -> a -> a
+trace1' s a b = trace (s ++ ":" ++ show a ++ "," ++ show b) b
+
+
+
+-- | pop items off a stateful list, use for monadic function.
+popping :: (MonadState s m) => Int -> Lens' s [a] -> ([a] -> m b) -> m b
+popping n l f = do
+  as <- use l
+  l .= drop n as
+  f (take n as)
+
+-- | 'popping' but only runs function if popped items are non-empty
+popping' :: (MonadState s m) => Int -> Lens' s [a] -> ([a] -> m b) -> m (Maybe b)
+popping' n l f = popping n l
+                     (\as -> if null as then return Nothing else Just <$> f as)
+
+-- | popping with only head
+popping1 :: (MonadState s m) => Lens' s [a] -> (a -> m b) -> m (Maybe b)
+popping1 l f = popping' 1 l (f . head)
+
+-- | 'succ' with wraparound.
+wrapSucc :: (Bounded a, Enum a, Eq a) => a -> a
+wrapSucc s = if s == maxBound then minBound else succ s
+-- | 'pred' with wraparound.
+wrapPred :: (Bounded a, Enum a, Eq a) => a -> a
+wrapPred s = if s == minBound then maxBound else pred s
+
+-- | do monadic 'over' -- '(%=)' -- with pass-through of (before,after)
+mutating :: MonadState s m => Lens' s a -> (a -> a) -> m (a,a)
+mutating l f = do
+  a <- use l
+  a' <- l <.= f a
+  return (a,a')
+
+-- | reorganize 'maybe' for chaining on Just
+maybe' :: Maybe a -> b -> (a -> b) -> b
+maybe' m n j = maybe n j m
+
+median :: Integral a => [a] -> Maybe a
+median [] = Nothing
+median ls = Just $ if odd len then sorted !! mid
+                   else (sorted !! mid + sorted !! (mid - 1)) `div` 2
+    where len = length ls
+          sorted = sort ls
+          mid = len `div` 2
+
+
+
+
+
+-- subtract all by minimum to "normalize" around 0
+normalize :: (Num a, Ord a) => [a] -> [a]
+normalize l = map (flip (-) $ minimum l) l
+
+-- PC rules state you must rotate the scale through the gamut,
+-- and selecting for the least distance from tail -> head, tail-1 -> head, etc.
+-- Line can be any melody, gets normalized to gamut.
+pitchClassSet :: Int -> [Int] -> [Int]
+pitchClassSet gamut line = let
+    modg = flip mod gamut
+    norm = normalize . sort . nub . map modg $ line
+    -- rotate through gamut
+    alts = nub $ map (\x -> normalize . sort $ map (modg . (x+)) norm) [0..(gamut-1)]
+    -- compute "values" as distance from head, reversed
+    vals = map (\x -> reverse $ map (flip (-) (head x)) x) alts
+    min = minimum vals
+    in fst . minimumBy (compare `on` snd) $ zip alts vals
+
+
+lfsr :: Int -> Int -> Int -> [Bool]
+lfsr len tap1 tap2 =
+    if len<tap1 || len<tap2 || tap1==tap2 || len<2 then
+        error ("lfsr: invalid arguments: " ++ show [len,tap1,tap2])
+    else
+        map snd . shift $ replicate len True where
+            shift r = v:next v where v = (r, r !! tap1 /= r !! tap2)
+            next (register,prev) = shift $ prev:register
+
+-- | generate "A" .. "Z", "AA" .. "AZ", "BA" .. "BZ", .. "AAA" etc
+rehMarks :: [String]
+rehMarks = a ++ ((++) <$> a <*> a) where a = map (:[]) ['A'..'Z']
+
+-- apply 'i' rotations to list
+rotate :: Int -> [a] -> [a]
+rotate i l = zipWith const (drop i $ cycle l) l
+
+-- get all rotations of a list
+rotations :: [a] -> [[a]]
+rotations l = flip rotate l <$> [1..(length l)]
+
+-- Cartesian product of specified dimension
+allTuples :: Int -> [a] -> [[a]]
+allTuples = replicateM
+
+monotonic :: [Int] -> Bool
+monotonic = (2 >) . length . nub . filter (EQ /=) . zipTail compare
+
+interleave :: [[a]] -> [a]
+interleave = concat . pivot
+
+pivot :: [[a]] -> [[a]]
+pivot chords = map iter [0..maxLength] where
+    maxLength = minimum (map length chords) - 1
+    iter i = map (!! i) chords
+
+filterOnKeys :: (Ord a) => [a] -> M.Map a b -> M.Map a b
+filterOnKeys ks = M.filterWithKey (\k _ -> S.member k $ S.fromList ks)
+
+pairBy :: (a -> b) -> [a] -> [(a,b)]
+pairBy f = map (\a -> (a,f a))
+
+delim :: String -> [String] -> String
+delim _ []              =  ""
+delim _ [w]             = w
+delim d (w:ws)          = w ++ d ++ delim d ws
diff --git a/src/Fadno/Xml.hs b/src/Fadno/Xml.hs
new file mode 100644
--- /dev/null
+++ b/src/Fadno/Xml.hs
@@ -0,0 +1,367 @@
+{-# LANGUAGE ConstraintKinds #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE OverloadedStrings #-}
+module Fadno.Xml
+    ( -- * Score and Part
+     xmlScore,xmlPart,xmlPartClef
+    -- * Bars
+    ,xmlMeasure
+    ,xmlPrependMeasureData,xmlPrependMeasureDatas
+    ,xmlAppendMeasureData,xmlAppendMeasureDatas
+    ,xmlClef,xmlClef'
+    ,xmlRepeats,xmlRepeats'
+    ,xmlBarline,xmlTimeSig,xmlRehearsalMark,xmlDirection
+    -- * Notes
+    ,xmlNote,xmlChord
+    ,xmlTie
+    -- * Rendering
+    ,renderFile,renderString,renderElement,Element
+    ) where
+
+
+import Fadno.MusicXml.MusicXml20
+import Fadno.Xml.EmitXml
+import qualified Data.Map.Strict as M
+import qualified Fadno.Note as N
+import qualified Fadno.Notation as N
+import Data.List (mapAccumL)
+import Data.Maybe
+import Data.Ratio
+import Control.Arrow
+import Text.XML.Light
+import Data.String
+import Control.Lens hiding (Empty)
+import Data.Foldable
+import Data.Monoid
+
+
+makeClassy_ ''ChxMusicData
+makeClassy_ ''Note
+makeClassy_ ''ChxNote
+makeClassy_ ''GrpFullNote
+makeClassy_ ''MusicData
+makeClassy_ ''Measure
+
+makeClassy_ ''ScorePartwise
+makeClassy_ ''ScoreHeader
+makeClassy_ ''Identification
+makeClassy_ ''PartList
+makeClassy_ ''CmpPart
+
+
+
+_testFile :: IO ()
+_testFile = renderFile "output/newtest.xml" $
+           xmlScore "Test" "Stoobie"
+           [xmlPartClef "Hurdy Gurdy" "HGy" N.TrebleClef
+            [xmlMeasure "1" $ xmlChord _testNote]]
+
+
+
+-- | Hardcoded divisions.
+xmlDivisions :: PositiveDivisions
+xmlDivisions = 768
+
+--
+-- SCORE & PART
+--
+
+type MeasureList f = (Traversable f, Cons (f Measure) (f Measure) Measure Measure,
+                      Snoc (f Measure) (f Measure) Measure Measure)
+
+-- | Partwise score.
+xmlScore :: String -> String -> [(CmpPart,ScorePart)] -> ScorePartwise
+xmlScore title composer xmlParts =
+    (mkScorePartwise
+     ((mkScoreHeader doPartList)
+      { scoreHeaderMovementTitle = Just title
+      , scoreHeaderIdentification =
+          Just (mkIdentification
+                { identificationCreator =
+                  [TypedText composer (Just "composer") ]}) })
+        ) { scorePartwisePart = toListOf (traverse._1) xmlParts }
+    where
+      doPartList =
+          PartList []
+          (xmlParts ^?! _head._2)
+          (map PartListScorePart (toListOf (_tail.traverse._2) xmlParts))
+
+
+-- | Render partwise part and score parts.
+xmlPart :: MeasureList f => String -> String -> f Measure -> (CmpPart,ScorePart)
+xmlPart longName shortName measures =
+    (CmpPart (fromString shortName) (toList $ addDivs measures),
+     ScorePart
+     (mkCmpScorePart (fromString shortName)
+      (mkPartName (fromString longName)))
+     { scorePartPartAbbreviation =
+       Just (mkPartName (fromString shortName)) })
+    where addDivs = xmlPrependMeasureData
+                    (MusicDataAttributes
+                      ((mkAttributes mkEditorial)
+                       { attributesDivisions = Just xmlDivisions }))
+
+-- | Render partwise part with clef.
+xmlPartClef :: MeasureList f => String -> String -> N.Clef -> f Measure -> (CmpPart,ScorePart)
+xmlPartClef l s c ms = xmlPart l s (xmlPrependMeasureData (xmlClef' c) ms)
+
+
+--
+-- BARS
+--
+
+type ApplyMonoid c t = (Applicative c,Monoid (c t))
+
+-- | Partwise measure.
+xmlMeasure :: Traversable t => String -> t ChxMusicData -> Measure
+xmlMeasure mNumber = mkMeasure (fromString mNumber) . MusicData . toList
+
+-- | Add datum to beginning of first measure
+xmlPrependMeasureData :: (MeasureList f) => ChxMusicData -> f Measure -> f Measure
+xmlPrependMeasureData = xmlPrependMeasureDatas . pure
+
+-- | Add data to beginning of first measure
+xmlPrependMeasureDatas :: (MeasureList f) => [ChxMusicData] -> f Measure -> f Measure
+xmlPrependMeasureDatas d = over (_head._measureMusicData._musicDataMusicData) (d <>)
+
+-- | Add datum to beginning of last measure
+xmlAppendMeasureData :: (MeasureList f) => ChxMusicData -> f Measure -> f Measure
+xmlAppendMeasureData = xmlAppendMeasureDatas . pure
+
+-- | Add data to beginning of last measure
+xmlAppendMeasureDatas :: (MeasureList f) => [ChxMusicData] -> f Measure -> f Measure
+xmlAppendMeasureDatas d = over (_last._measureMusicData._musicDataMusicData) (d <>)
+
+
+-- | Use a "Maybe Lens" to generate some or none of a datum.
+maybeMusicDatas :: (ApplyMonoid c t) => Getting (Maybe a) s (Maybe a) -> (a -> c t) -> s -> c t
+maybeMusicDatas l f = maybe mempty f . view l
+
+-- | Use a "Maybe Lens" to generate one or none of a datum.
+maybeMusicData :: (ApplyMonoid c t) => Getting (Maybe a) s (Maybe a) -> (a -> t) -> s -> c t
+maybeMusicData l f = maybeMusicDatas l (pure.f)
+
+-- | Clef in bar
+xmlClef :: (ApplyMonoid c ChxMusicData, N.HasClef a) => a -> c ChxMusicData
+xmlClef = maybeMusicData N.clef xmlClef'
+
+-- | Clef alone.
+xmlClef' :: N.Clef -> ChxMusicData
+xmlClef' c =
+    case c of
+      N.TrebleClef -> mkC ClefSignG 2
+      N.BassClef -> mkC ClefSignF 4
+      N.AltoClef -> mkC ClefSignC 3
+      N.PercClef -> mkC ClefSignPercussion 3
+    where mkC cs cl =
+              MusicDataAttributes
+              ((mkAttributes mkEditorial)
+               { attributesClef = [(mkClef cs)
+                                   { clefLine = Just cl }]})
+
+
+-- | Measure barlines.
+xmlBarline :: (ApplyMonoid c ChxMusicData) => N.HasBarline a => a -> c ChxMusicData
+xmlBarline = maybeMusicData N.barline $ \b ->
+      case b of
+        N.Double -> mdBarline RightLeftMiddleLeft
+                    BarStyleLightLight Nothing
+        N.Final -> mdBarline RightLeftMiddleRight
+                   BarStyleLightHeavy Nothing
+
+-- | Measure repeats for a single measure.
+xmlRepeats :: (ApplyMonoid t ChxMusicData) => N.HasRepeats a => a -> t ChxMusicData
+xmlRepeats = maybeMusicDatas N.repeats $ \r ->
+     case r of
+        N.RStart -> pure startRepeat
+        N.REnd -> pure endRepeat
+        N.RBoth -> pure startRepeat <> pure endRepeat
+    where
+
+startRepeat :: ChxMusicData
+startRepeat = mdBarline RightLeftMiddleLeft
+              BarStyleHeavyLight (Just BackwardForwardForward)
+endRepeat :: ChxMusicData
+endRepeat = mdBarline RightLeftMiddleRight
+            BarStyleLightHeavy (Just BackwardForwardBackward)
+
+-- | Measure repeats bracketing existing measures.
+xmlRepeats' :: (N.HasRepeats a, MeasureList f) => a -> f Measure -> f Measure
+xmlRepeats' s measures =
+    case view N.repeats s of
+      Nothing -> measures
+      Just N.RStart -> doStart measures
+      Just N.REnd -> doEnd measures
+      Just N.RBoth -> doStart . doEnd $ measures
+    where doStart = xmlPrependMeasureData startRepeat
+          doEnd = xmlAppendMeasureData endRepeat
+
+-- | utility
+mdBarline :: RightLeftMiddle -> BarStyle ->
+             Maybe BackwardForward -> ChxMusicData
+mdBarline rml bs bf =
+    MusicDataBarline
+    ((mkBarline mkEditorial)
+     { barlineLocation = Just rml
+     , barlineBarStyle = Just (mkBarStyleColor bs)
+     , barlineRepeat = fmap mkRepeat bf })
+
+-- | Measure time signature.
+xmlTimeSig :: (ApplyMonoid t ChxMusicData, N.HasTimeSignature a) => a -> t ChxMusicData
+xmlTimeSig = maybeMusicData N.timeSignature $ \(N.TimeSignature n q) ->
+       MusicDataAttributes $
+       (mkAttributes mkEditorial)
+        { attributesTime =
+          [mkTime (TimeTime [SeqTime (fromString $ show n)
+                             (fromString $ show $ N.qToInt q)])]}
+
+-- | Measure rehearsal mark.
+xmlRehearsalMark :: (ApplyMonoid t ChxMusicData,N.HasRehearsalMark a) => a -> t ChxMusicData
+xmlRehearsalMark = maybeMusicData N.rehearsalMark
+               (makeDirection . DirectionTypeRehearsal . return .
+                mkRehearsal . view N.rehearsalText)
+
+-- | Measure direction.
+xmlDirection :: (ApplyMonoid t ChxMusicData,N.HasDirection a) => a -> t ChxMusicData
+xmlDirection = maybeMusicData N.direction
+                   (makeDirection . DirectionTypeWords . return .
+                    mkFormattedText . view N.directionText)
+
+-- | Utility for direction types
+makeDirection :: ChxDirectionType -> ChxMusicData
+makeDirection dt = MusicDataDirection
+                        ((mkDirection mkEditorialVoiceDirection)
+                         { directionDirectionType = [DirectionType dt] })
+
+
+
+--
+-- NOTES
+--
+
+
+
+-- | render note/rest as xml
+xmlNote :: (N.HasNote a (N.Mono N.PitchRep) Rational) => a -> ChxMusicData
+xmlNote n = MusicDataNote
+            (mkNote (NoteFullNote
+                     (GrpFullNote Nothing
+                      (fullNote (view N.notePitch n)))
+                     (Duration durDivs) [])
+             mkEditorialVoice)
+            { noteType = Just (mkNoteType durNoteType)
+            , noteDot = nds }
+    where (durDivs,durNoteType,durDots) = convertDurR xmlDivisions $ view N.noteDur n
+          nds = replicate durDots mkEmptyPlacement
+          fullNote (N.M p) = FullNotePitch (convertPitchRep p)
+          fullNote N.Rest = FullNoteRest mkDisplayStepOctave
+
+-- | render notes as xml chord or rest.
+xmlChord :: (N.HasNote a [N.PitchRep] Rational) =>
+            a -> [ChxMusicData]
+xmlChord ch =
+    case view N.notePitch ch of
+      [] -> [doNote N.Rest]
+      ps -> zipWith doChord [(0 :: Int)..] $ map (doNote.N.M) ps
+    where doNote p = xmlNote (N.Note p (view N.noteDur ch))
+          doChord i | i == 0 = id
+                    | otherwise =
+                        set (_musicDataNote._noteNote._noteFullNote2._fullNoteChord)
+                            (Just Empty)
+
+
+_testNote :: N.Note' [N.PitchRep] Rational
+_testNote = over N.nNote (view (bimapping (mapping N.pitchRep) (N.ratioPPQ N.PQ4))) N.testNote
+
+-- | Adapt a rendered note to account for tie information.
+-- > xmlTie testNote <$> xmlChord 128 testNote
+xmlTie :: (N.HasTie a) => a -> ChxMusicData -> ChxMusicData
+xmlTie a = over (_musicDataNote._noteNotations) (++adapt mkTNot) .
+           over (_musicDataNote._noteNote._noteTie1) (++adapt Tie)
+    where adapt fc = maybe [] (fmap fc . conv) $ view N.tie a
+          conv N.TStart = [StartStopStart]
+          conv N.TStop = [StartStopStop]
+          conv N.TBoth = [StartStopStop,StartStopStart]
+          mkTNot s = (mkNotations mkEditorial)
+                     {notationsNotations = [NotationsTied (mkTied s)]}
+
+-- | Steps and enharmonics.
+steps :: [(Step,Maybe Semitones)]
+steps = [(StepC,Nothing),
+         (StepC,sharp),
+         (StepD,Nothing),
+         (StepE,flat),
+         (StepE,Nothing),
+         (StepF,Nothing),
+         (StepF,sharp),
+         (StepG,Nothing),
+         (StepA,flat),
+         (StepA,Nothing),
+         (StepB,flat),
+         (StepB,Nothing)]
+    where sharp = Just 1
+          flat = Just (-1)
+
+-- | Note values indexed by powers of two. [(1,Long) .. (1024,256th)]
+noteTypeValues :: M.Map Int NoteTypeValue
+noteTypeValues = M.fromList $ snd $ mapAccumL acc (256*4) [minBound .. maxBound]
+    where acc v nt = (v `div` 2,(v,nt))
+
+-- | Int pitch to xml. TODO C3 vs C4?
+convertPitch :: Int -> Pitch
+convertPitch i = Pitch step semi oct where
+    oct = fromIntegral $ (i `div` 12) - 1
+    (step, semi) = steps !! (i `mod` 12)
+
+convertPitchRep :: N.PitchRep -> Pitch
+convertPitchRep (N.PitchRep s o) = Pitch step semi (fromIntegral o)
+    where (step,semi) = ss s
+          sharp = Just 1
+          flat = Just (-1)
+          ss N.C = (StepC,Nothing)
+          ss N.Cs = (StepC,sharp)
+          ss N.Db = (StepD,flat)
+          ss N.D = (StepD,Nothing)
+          ss N.Ds = (StepD,sharp)
+          ss N.Eb = (StepE,flat)
+          ss N.E = (StepE,Nothing)
+          ss N.F = (StepF,Nothing)
+          ss N.Fs = (StepF,sharp)
+          ss N.Gb = (StepG,flat)
+          ss N.G = (StepG,Nothing)
+          ss N.Gs = (StepG,sharp)
+          ss N.Ab = (StepA,flat)
+          ss N.A = (StepA,Nothing)
+          ss N.As = (StepA,sharp)
+          ss N.Bb = (StepB,flat)
+          ss N.B = (StepB,Nothing)
+
+
+-- | Int duration/PPQ to xml values.
+convertDur :: N.PPQ -> Int -> PositiveDivisions -> (PositiveDivisions,NoteTypeValue,Int)
+convertDur ppq dur xdivs = (fromIntegral divs,findValue,dots)
+    where
+      ppqd = N.ppqDiv ppq
+      divs = floor xdivs * dur `div` ppqd
+      (num,denom) = numerator &&& denominator $ (dur % (ppqd * 16))
+      dots = fromMaybe 0 $ M.lookup num dotValues
+      findValue = fromMaybe NoteTypeValue256th $
+                  M.lookup (denom `div` (2 ^ dots))  noteTypeValues
+
+-- | Rational duration (ie, '1 % 4' for quarter note) to xml values.
+convertDurR :: PositiveDivisions -> Rational -> (PositiveDivisions,NoteTypeValue,Int)
+convertDurR xdivs r = (fromIntegral divs,findValue,dots)
+    where
+      divs :: Int
+      divs = floor $ toRational xdivs * (r * 4)
+      (num,denom) = numerator &&& denominator $ (r / 4)
+      dots = fromMaybe 0 $ M.lookup (fromIntegral num) dotValues
+      findValue = fromMaybe NoteTypeValue256th $
+                  M.lookup (fromIntegral denom `div` (2 ^ dots)) noteTypeValues
+
+-- | Numerator values to dots.
+dotValues :: M.Map Int Int
+dotValues = M.fromList $ takeWhile (<= 1024) (dot 3 4) `zip` [1..]
+    where dot v i = v:dot (v + i) (i * 2)
diff --git a/tests/Tests.hs b/tests/Tests.hs
new file mode 100644
--- /dev/null
+++ b/tests/Tests.hs
@@ -0,0 +1,17 @@
+module Main where
+
+import qualified MeterSpec
+import qualified NotationSpec
+import qualified NoteSpec
+import qualified UtilSpec
+import Test.HUnit
+import System.IO
+import Control.Monad
+import Test.Hspec
+import Test.Hspec.Contrib.HUnit
+
+main = hspec $ fromHUnitTest $ TestList
+           [MeterSpec.tests,
+            NotationSpec.tests,
+            NoteSpec.tests,
+            UtilSpec.tests]