diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2018, John Wiegley
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * 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.
+
+    * Neither the name of John Wiegley nor the names of other
+      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
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Main.hs b/Main.hs
new file mode 100644
--- /dev/null
+++ b/Main.hs
@@ -0,0 +1,57 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeApplications #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Main where
+
+import Control.Lens
+import Data.Aeson hiding ((.=))
+import qualified Data.ByteString.Lazy as BL
+import Data.Foldable
+import Data.Map (Map)
+import Data.Text (Text)
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+import qualified Data.Text.Lazy.IO as TL
+import GHC.Generics hiding (to)
+import Journal.Amount
+import Journal.Model
+import Journal.Parse
+import Options
+import Text.Megaparsec (parse)
+import Text.Megaparsec.Error
+
+data Config = Config
+  { splits :: Map Text [Amount 6],
+    rounding :: Map Text (Amount 2)
+  }
+  deriving (Generic, Show, FromJSON)
+
+newConfig :: Config
+newConfig =
+  Config
+    { splits = mempty,
+      rounding = mempty
+    }
+
+parseProcessPrint :: MonadFail m => FilePath -> TL.Text -> m TL.Text
+parseProcessPrint path journal = do
+  actions <- case parse parseJournal path journal of
+    Left e -> fail $ errorBundlePretty e
+    Right res -> pure res
+  case processJournal actions of
+    Left err ->
+      error $ "Error processing journal " ++ path ++ ": " ++ show err
+    Right j -> pure $ printJournal j
+
+main :: IO ()
+main = do
+  opts <- getOptions
+  forM_ (opts ^. files) $ \path -> do
+    putStrLn $ "Reading journal " ++ path
+    journal <- TL.decodeUtf8 <$> BL.readFile path
+    TL.putStrLn =<< parseProcessPrint path journal
diff --git a/Options.hs b/Options.hs
new file mode 100644
--- /dev/null
+++ b/Options.hs
@@ -0,0 +1,65 @@
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Options where
+
+import Control.Lens hiding (argument)
+import Data.Data (Data)
+import Data.Typeable (Typeable)
+import GHC.Generics
+import Options.Applicative
+
+version :: String
+version = "0.0.1"
+
+copyright :: String
+copyright = "2020"
+
+tradeJournalSummary :: String
+tradeJournalSummary =
+  "trade-journal "
+    ++ version
+    ++ ", (C) "
+    ++ copyright
+    ++ " John Wiegley"
+
+data Options = Options
+  { _verbose :: Bool,
+    _totals :: Bool,
+    _files :: [FilePath]
+  }
+  deriving (Data, Show, Eq, Typeable, Generic)
+
+makeLenses ''Options
+
+newOptions :: Options
+newOptions =
+  Options
+    { _verbose = False,
+      _totals = False,
+      _files = []
+    }
+
+tradeJournalOpts :: Parser Options
+tradeJournalOpts =
+  Options
+    <$> switch
+      ( short 'v'
+          <> long "verbose"
+          <> help "Report progress verbosely"
+      )
+    <*> switch
+      ( long "totals"
+          <> help "Show calculated totals for entries"
+      )
+    <*> some (argument str (metavar "FILE"))
+
+optionsDefinition :: ParserInfo Options
+optionsDefinition =
+  info
+    (helper <*> tradeJournalOpts)
+    (fullDesc <> progDesc "" <> header tradeJournalSummary)
+
+getOptions :: IO Options
+getOptions = execParser optionsDefinition
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,3 @@
+import Distribution.Simple
+
+main = defaultMain
diff --git a/src/Journal/Amount.hs b/src/Journal/Amount.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/Amount.hs
@@ -0,0 +1,223 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE KindSignatures #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications #-}
+
+module Journal.Amount
+  ( Amount (..),
+    _Amount,
+    rounded,
+    thousands,
+    renderAmount,
+    normalizeAmount,
+    spreadAmounts,
+    showAmount,
+    amountToString,
+    mpfr_RNDN,
+    mpfr_RNDZ,
+    mpfr_RNDU,
+    mpfr_RNDD,
+    mpfr_RNDA,
+    mpfr_RNDF,
+    mpfr_RNDNA,
+    sign,
+  )
+where
+
+import Control.Monad
+import Data.Aeson
+import Data.Char (isDigit)
+import Data.Coerce
+import Data.Data
+import Data.Default
+import Data.Function (on)
+import Data.Int (Int64)
+import Data.List (intercalate)
+import Data.List.Split
+import Data.Profunctor
+import Data.Ratio
+import Foreign.C.String
+import Foreign.C.Types
+import Foreign.Marshal.Alloc
+import Foreign.Ptr
+import Foreign.Storable
+import GHC.Generics
+import GHC.TypeLits
+import Journal.Utils (Render (..))
+import System.IO.Unsafe
+import Text.PrettyPrint (text)
+import Text.Show.Pretty as P
+import Prelude hiding (Double, Float)
+
+mpfr_RNDN, mpfr_RNDZ, mpfr_RNDU, mpfr_RNDD, mpfr_RNDA, mpfr_RNDF :: CUInt
+
+mpfr_RNDNA :: CUInt
+
+mpfr_RNDN = 0 -- round to nearest, with ties to even
+
+mpfr_RNDZ = 1 -- round toward zero
+
+mpfr_RNDU = 2 -- round toward +Inf
+
+mpfr_RNDD = 3 -- round toward -Inf
+
+mpfr_RNDA = 4 -- round away from zero
+
+mpfr_RNDF = 5 -- faithful rounding
+
+mpfr_RNDNA = 6 -- round to nearest, with ties away from zero (mpfr_round)
+
+foreign import ccall unsafe "mpfr_free_str" c'mpfr_free_str :: CString -> IO ()
+
+foreign import ccall unsafe "rational_to_str"
+  c'rational_to_str ::
+    CLong -> CULong -> CUInt -> CSize -> Ptr CString -> IO ()
+
+newtype Amount (dec :: Nat) = Amount {getAmount :: Ratio Int64}
+  deriving
+    ( Generic,
+      Data,
+      Typeable,
+      Ord,
+      Num,
+      Fractional,
+      Real,
+      RealFrac
+    )
+
+instance Default (Amount n) where
+  def = 0
+
+instance KnownNat n => PrettyVal (Amount n) where
+  prettyVal = P.String . show
+
+showAmount :: forall n. KnownNat n => CUInt -> Amount n -> String
+showAmount rnd (Amount r) =
+  unsafePerformIO $ alloca $ \bufPtr -> do
+    c'rational_to_str
+      (CLong (numerator r))
+      (CULong (fromIntegral (denominator r)))
+      rnd
+      (CSize (fromIntegral (natVal (Proxy :: Proxy n))))
+      bufPtr
+    buf <- peek bufPtr
+    str <- peekCString buf
+    c'mpfr_free_str buf
+    return str
+
+instance KnownNat n => Eq (Amount n) where
+  (==) = (==) `on` show
+
+instance KnownNat n => Show (Amount n) where
+  show = amountToString 2
+
+instance KnownNat n => Read (Amount n) where
+  readsPrec _d = \case
+    '-' : xs -> map (\(x, y) -> (negate x, y)) (readNum xs)
+    xs -> readNum xs
+    where
+      readNum r = case takeWhile isDigit r of
+        [] -> error $ "Not an amount: " ++ r
+        num -> case dropWhile isDigit r of
+          ('.' : den) ->
+            let den' = takeWhile isDigit den
+                rem' = dropWhile isDigit den
+             in [(Amount (read (num ++ den') % 10 ^ length den'), rem')]
+          xs -> [(Amount (read num % 1), xs)]
+
+instance KnownNat n => Render (Amount n) where
+  rendered = text . show
+
+instance KnownNat n => ToJSON (Amount n) where
+  toJSON = Number . fromRational . toRational . getAmount
+
+instance KnownNat n => FromJSON (Amount n) where
+  parseJSON (Number n) = pure $ Amount (fromRational (toRational n))
+  parseJSON v = error $ "Expected Amount, saw: " ++ show v
+
+-- _Amount :: KnownNat n => Prism' String (Amount n)
+_Amount ::
+  (KnownNat n, Choice p, Applicative f) =>
+  p (Amount n) (f (Amount n)) ->
+  p String (f String)
+_Amount = dimap read (fmap show)
+
+-- rounded :: (KnownNat m, KnownNat n) => Iso' (Amount n) (Amount m)
+rounded ::
+  (Profunctor p, Functor f) =>
+  p (Amount m) (f (Amount m)) ->
+  p (Amount n) (f (Amount n))
+rounded = dimap coerce (fmap coerce)
+
+amountToString :: KnownNat n => Int -> Amount n -> String
+amountToString n = touchup . cleanup n . showAmount mpfr_RNDNA
+  where
+    touchup s
+      | last s == '.' = take (length s - 1) s
+      | otherwise = s
+    cleanup m t
+      | len > m && last t == '0' = cleanup m (take (length t - 1) t)
+      | otherwise = t
+      where
+        len = length (last (splitOn "." t))
+
+thousands :: forall n. KnownNat n => Amount n -> String
+thousands d = intercalate "." $ case splitOn "." str of
+  x : xs -> (reverse . go . reverse) x
+    : case xs of
+      y : ys -> expand y : ys
+      _ | isInt -> ["00"]
+      _ -> []
+  xs -> xs
+  where
+    isInt = case natVal (Proxy :: Proxy n) of
+      0 -> True
+      _ -> False
+    str
+      | isInt = show (floor d :: Int)
+      | otherwise = amountToString 2 d
+    go (x : y : z : []) = x : y : z : []
+    go (x : y : z : ['-']) = x : y : z : ['-']
+    go (x : y : z : xs) = x : y : z : ',' : go xs
+    go xs = xs
+    expand [] = "00"
+    expand (x : []) = x : "0"
+    expand xs = xs
+
+renderAmount :: KnownNat n => Amount n -> String
+renderAmount d
+  | fromIntegral (floor d :: Int) == d =
+    thousands @0 (coerce d)
+renderAmount d = thousands d
+
+normalizeAmount :: KnownNat n => CUInt -> Amount n -> Amount n
+normalizeAmount = (read .) . showAmount
+
+-- Given a way of project a "count" from an element, an amount, and a list of
+-- elements, divide the given amount among the elements each according to its
+-- count. Thus, if passed a two element list with counts 60 and 40, the amount
+-- would be divided 60% to the first, and 40% to the second.
+spreadAmounts ::
+  (KnownNat n, KnownNat m) =>
+  (a -> Amount m) ->
+  Amount n ->
+  [a] ->
+  [(Amount n, a)]
+spreadAmounts f n input = go True input
+  where
+    diff = n - sum (map sump input)
+    per = coerce n / shares
+    shares = sum (map f input)
+    sump l = coerce (f l * per)
+    go _ [] = []
+    go b (x : xs) = (sum', x) : go False xs
+      where
+        sum' = sump x + if b then diff else 0
+
+sign :: (Num a, Ord a, Num b) => a -> b -> b
+sign n = (if n < 0 then negate else id) . abs
diff --git a/src/Journal/Model.hs b/src/Journal/Model.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/Model.hs
@@ -0,0 +1,359 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE ViewPatterns #-}
+
+module Journal.Model
+  ( processJournal,
+    processJournalWithChanges,
+    processActionsWithChanges,
+  )
+where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Exception hiding (handle)
+import Control.Lens
+import Control.Monad.Except
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import Control.Monad.Trans.Writer
+import Data.Foldable
+import Data.List (sortOn)
+import Data.List (tails)
+import Journal.Amount
+import Journal.Split
+import Journal.Types
+import Journal.Utils
+import Prelude hiding (Double, Float)
+
+-- | Ideally, this module turns a stream of lots -- expressing intentions to
+--   buy and sell at given prices -- into a record of transactions with the
+--   broker where all gains and losses have been calculated.
+processJournal :: MonadError JournalError m => Journal -> m Journal
+processJournal =
+  fmap (Journal . snd) . processActionsWithChanges . view actions
+
+processJournalWithChanges ::
+  MonadError JournalError m =>
+  Journal ->
+  m ([Change], Journal)
+processJournalWithChanges =
+  fmap (second Journal) . processActionsWithChanges . view actions
+
+processActionsWithChanges ::
+  MonadError JournalError m =>
+  [Timed Action] ->
+  m ([Change], [Timed Action])
+processActionsWithChanges xs =
+  fmap unzipBoth . (`evalStateT` newJournalState) $ do
+    forM xs $ \x -> do
+      let lot = x ^. item . _Lot
+          macct = lot ^? details . traverse . _Account
+          sym = lot ^. symbol
+      zoom (accounts . at macct . non newAccountState) $ do
+        zoom
+          ( zipped3
+              nextId
+              balance
+              (instruments . at sym . non newInstrumentState)
+          )
+          $ first (SawAction x :) <$> processAction x
+
+checkNetAmount ::
+  MonadError JournalError m =>
+  Timed Action ->
+  m (Timed Action)
+checkNetAmount x
+  | Just itemNet <- x ^? item . _Lot . details . traverse . _Net = do
+    let calcNet = netAmount (x ^. item)
+    if itemNet == calcNet
+      then throwError $ NetAmountDoesNotMatch x calcNet itemNet
+      else pure x
+  | otherwise =
+    pure $ x & item . _Lot . details <>~ [Net (netAmount (x ^. item))]
+
+checkBalance ::
+  MonadError JournalError m =>
+  Timed Action ->
+  StateT (Amount 2) m (Timed Action)
+checkBalance x
+  | Just itemBal <- x ^? item . _Lot . details . traverse . _Balance = do
+    bal <- get
+    let newBal = netAmount (x ^. item) + bal
+    if itemBal == newBal
+      then pure x
+      else throwError $ BalanceDoesNotMatch x newBal itemBal
+  | otherwise = do
+    bal <- get
+    let newBal = netAmount (x ^. item) + bal
+    put newBal
+    pure $ x & item . _Lot . details <>~ [Balance newBal]
+
+processAction ::
+  MonadError JournalError m =>
+  Timed Action ->
+  StateT (Int, Amount 2, InstrumentState) m ([Change], [Timed Action])
+processAction =
+    fmap unzipBoth . mapM applyChange <=< readonly . impliedChanges
+  where
+    applyChange chg = case chg of
+      SawAction _ -> throwError $ ChangeNotFromImpliedChanges chg
+      Result e -> do
+        e' <- zoom _2 $ checkBalance e
+        e'' <- lift $ checkNetAmount e'
+        pure ([chg], [e''])
+      Submit lot ->
+        first (\xs -> chg : xs ++ [SubmitEnd])
+          <$> processAction (Wash <$> lot)
+      SubmitEnd -> pure ([chg], [])
+      AddEvent e -> do
+        ident <- use _1
+        _1 += 1
+        _3 . events . at ident ?= e
+        pure ([chg], [])
+      RemoveEvent ident -> do
+        _3 . events . at ident .= Nothing
+        pure ([chg], [])
+      ReplaceEvent ident e -> do
+        _3 . events . at ident ?= e
+        pure ([chg], [])
+      SaveWash name lot -> do
+        _3 . washSales . at name
+          %= \case Nothing -> Just [lot]; Just xs -> Just (lot : xs)
+        pure ([chg], [])
+
+-- | A specialized variant of 'foldM' with some arguments shifted around.
+shortFoldM ::
+  Monad m =>
+  a ->
+  [b] ->
+  (b -> Maybe a -> m (Maybe a)) ->
+  m (Maybe a)
+shortFoldM z xs f = foldM (flip f) (Just z) xs
+
+impliedChanges ::
+  MonadError JournalError m =>
+  Timed Action ->
+  ReaderT (Int, Amount 2, InstrumentState) m [Change]
+impliedChanges x = do
+  hist <- asks (sortOn fst . toListOf (_3 . events . ifolded . withIndex))
+  (mx, changes) <- runWriterT $ shortFoldM x (tails hist) $
+    \hs -> \case
+      Nothing -> pure Nothing
+      Just x' -> handle hs x'
+  forM_ mx $ throwError . UnexpectedRemainder
+  pure changes
+
+buyOrSell :: Traversal' (Timed Action) Lot
+buyOrSell = item . failing _Buy _Sell
+
+wash :: Traversal' (Timed Action) Lot
+wash = item . _Wash
+
+opened :: Traversal' (Timed Event) Lot
+opened = item . _Opened . _2
+
+handle ::
+  MonadError JournalError m =>
+  [(Int, Timed Event)] ->
+  Timed Action ->
+  WriterT
+    [Change]
+    (ReaderT (Int, Amount 2, InstrumentState) m)
+    (Maybe (Timed Action))
+handle
+  ((n, open@(view item -> Opened buyToOpen _)) : _)
+  close@(preview buyOrSell -> Just _)
+    | buyToOpen == has (item . _Sell) close =
+      closePosition n open close
+handle
+  ((n, open@(view item -> Opened _ o)) : _)
+  washing@(preview wash -> Just _)
+    | all
+        (\ann -> hasn't _Exempt ann && hasn't _Washed ann)
+        (o ^. details),
+      (open ^. time) `distance` (washing ^. time) <= 30 =
+      washExistingPosition n open washing
+-- If a wash sale couldn't be applied to the current history, record it to
+-- apply to a future opening.
+handle [] act@(preview wash -> Just x) = do
+  case x ^? details . traverse . _WashTo of
+    Just (name, mres) ->
+      Nothing
+        <$ tell
+          [ SaveWash
+              name
+              ( ( case mres of
+                    Nothing -> x
+                    Just (_amount, _price) ->
+                      let _symbol = x ^. symbol
+                          _details = []
+                          _computed = []
+                       in Lot {..}
+                )
+                  <$ act
+              ),
+            Result (Wash x <$ act)
+          ]
+    _ -> pure Nothing
+-- Otherwise, if there is no history to examine then this buy or sale must
+-- open a new position.
+handle [] action = do
+  mact <- shortFoldM
+    action
+    (action ^.. buyOrSell . details . traverse . _WashApply)
+    $ \(name, _amount) -> \case
+      Just (act@(preview buyOrSell -> Just open)) -> do
+        sales <-
+          lift $
+            asks
+              ( toListOf
+                  ( _3 . washSales
+                      . ix name
+                      . folded
+                      . filtered
+                        ( \adj ->
+                            (adj ^. time)
+                              `distance` (act ^. time) <= 30
+                        )
+                      . to (\x -> x ^. item . amount * x ^. item . price)
+                  )
+              )
+        let _price = sum sales / _amount
+            _symbol = open ^. symbol
+            _details = []
+            _computed = []
+        washNewPosition Lot {..} act
+      _ -> pure Nothing
+  case mact of
+    Just (act@(preview buyOrSell -> Just open)) ->
+      Nothing
+        <$ tell
+          [ AddEvent (Opened (has (item . _Buy) act) open <$ act),
+            Result (act & buyOrSell . details <>~ [Position Open])
+          ]
+    _ ->
+      -- If none of the above apply, nothing is done for this action, pass
+      -- it through
+      pure mact
+handle _ x = pure $ Just x
+
+-- | The most common trading activities are either to open a new position, or
+-- to close an existing one for a profit or loss. If there is a loss within 30
+-- days of the opening, it implies a wash sale adjustment of any preceeding or
+-- subsequent openings 30 days before or after.
+closePosition ::
+  MonadError JournalError m =>
+  Int ->
+  Timed Event ->
+  Timed Action ->
+  WriterT [Change] m (Maybe (Timed Action))
+closePosition n open close = do
+  let (s, d) = (open ^?! opened) `alignLots` (close ^?! buyOrSell)
+  forM_ ((,) <$> s ^? _SplitUsed <*> d ^? _SplitUsed) $ \(su, du) -> do
+    let pricing x =
+          x ^. price
+            + sum
+              ( x
+                  ^.. details
+                    . traverse
+                    . _Washed
+              )
+        lotFees = sum (du ^.. fees) + sum (su ^.. fees)
+        pl
+          | has (item . _Sell) close =
+            pricing du - pricing su - lotFees
+          | otherwise = pricing su - pricing du - lotFees
+        res =
+          du & details
+            <>~ [ Position Close,
+                  if pl < 0
+                    then Loss (- pl)
+                    else Gain pl
+                ]
+    tell [Result (close & buyOrSell .~ res)]
+    -- After closing at a loss, and if the loss occurs within 30 days
+    -- of its corresponding open, and there is another open within 30
+    -- days of the loss, close it and re-open so it's repriced by the
+    -- wash loss.
+    let mayWash = (close ^. time) `distance` (open ^. time) <= 30 && pl < 0
+    tell
+      [ case s ^? _SplitKept of
+          Just k ->
+            ReplaceEvent
+              n
+              ( open & opened
+                  .~ if mayWash
+                    then k & details <>~ [Exempt]
+                    else k
+              )
+          Nothing -> RemoveEvent n
+      ]
+    when mayWash $
+      tell
+        [ Submit ((du & price .~ negate pl) <$ close)
+        ]
+  pure $ (set buyOrSell ?? close) <$> (d ^? _SplitKept)
+
+-- | If the action is a wash sale adjustment, determine if can be applied to
+-- any existing open positions. If not, it is remembered, to be applied at the
+-- next opening within 30 days of sale.
+washExistingPosition ::
+  MonadError JournalError m =>
+  Int ->
+  Timed Event ->
+  Timed Action ->
+  WriterT [Change] m (Maybe (Timed Action))
+washExistingPosition n open washing =
+  assert (washing ^?! wash . amount /= 0) $ do
+    let (s, d) = (open ^?! opened) `alignLots` (washing ^?! wash)
+    -- Wash failing closes by adding the amount to the cost basis of the
+    -- opening transaction.
+    tell $
+      [ case s ^? _SplitKept of
+          Just e ->
+            ReplaceEvent n (set opened (e & details <>~ [Exempt]) open)
+          Nothing -> RemoveEvent n
+      ]
+        ++ ( AddEvent
+               . (set opened ?? open)
+               . (details <>~ [Washed (d ^?! _SplitUsed . price)])
+               <$> s ^.. _SplitUsed
+           )
+        ++ ( Result . (set wash ?? washing)
+               . (details .~ [Washed (s ^?! _SplitUsed . price)])
+               <$> d ^.. _SplitUsed
+           )
+    pure $ (set wash ?? washing) <$> (d ^? _SplitKept)
+
+-- | If we are opening a position and there is a pending wash sale within the
+-- last 30 days, apply the adjustment to the applicable part of this opening.
+washNewPosition ::
+  MonadError JournalError m =>
+  Lot ->
+  Timed Action ->
+  WriterT [Change] m (Maybe (Timed Action))
+washNewPosition washing open =
+  assert (washing ^. amount <= open ^?! buyOrSell . amount) $ do
+    let (_s, d) = washing `alignLots` (open ^?! buyOrSell)
+    -- We wash failing closes by adding the amount to the cost basis of
+    -- the opening transaction. Thus, we generate three instances of
+    -- WashLossApplied, but only one OpenPosition.
+    tell $
+      ( AddEvent
+          . Timed (open ^. time)
+          . Opened (has (item . _Buy) open)
+          . (details <>~ [Washed (washing ^. price)])
+          <$> d ^.. _SplitUsed
+      )
+        ++ ( Result . (set buyOrSell ?? open)
+               . ( details
+                     <>~ [ Position Open,
+                           Washed (washing ^. price)
+                         ]
+                 )
+               <$> d ^.. _SplitUsed
+           )
+    pure $ (set buyOrSell ?? open) <$> d ^? _SplitKept
diff --git a/src/Journal/Parse.hs b/src/Journal/Parse.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/Parse.hs
@@ -0,0 +1,229 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
+
+module Journal.Parse (parseJournal, printJournal) where
+
+import Control.Lens
+import Data.Char
+import Data.Either
+import Data.List (intersperse, sort)
+import Data.Maybe (mapMaybe)
+import qualified Data.Text as T
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as TL
+import Data.Time
+import Data.Void
+import GHC.TypeLits
+import Journal.Amount
+import Journal.Types
+import Text.Megaparsec
+import Text.Megaparsec.Char
+import qualified Text.Megaparsec.Char.Lexer as L
+
+type Parser = ParsecT Void Text Identity
+
+skipLineComment' :: Tokens Text -> Parser ()
+skipLineComment' prefix =
+  string prefix
+    *> takeWhileP (Just "character") (\x -> x /= '\n' && x /= '\r')
+    *> pure ()
+
+whiteSpace :: Parser ()
+whiteSpace = L.space space1 lineCmnt blockCmnt
+  where
+    lineCmnt = skipLineComment' "|"
+    blockCmnt = L.skipBlockComment "/*" "*/"
+
+lexeme :: Parser a -> Parser a
+lexeme p = p <* whiteSpace
+
+keyword :: Text -> Parser Text
+keyword = lexeme . string
+
+parseJournal :: Parser Journal
+parseJournal =
+  Journal <$> many (whiteSpace *> parseTimed parseAction) <* eof
+
+parseTimed :: Parser a -> Parser (Timed a)
+parseTimed p = do
+  _time <- Journal.Parse.parseTime
+  _item <- p
+  pure Timed {..}
+
+parseAction :: Parser Action
+parseAction =
+  keyword "buy" *> (Buy <$> parseLot)
+    <|> keyword "sell" *> (Sell <$> parseLot)
+    <|> keyword "wash" *> (Wash <$> parseLot)
+    <|> keyword "deposit" *> (Deposit <$> parseLot)
+    <|> keyword "withdraw" *> (Withdraw <$> parseLot)
+    <|> keyword "assign" *> (Assign <$> parseLot)
+    <|> keyword "expire" *> (Expire <$> parseLot)
+    <|> keyword "dividend" *> (Dividend <$> parseLot)
+
+parseLot :: Parser Lot
+parseLot = do
+  _amount <- parseAmount
+  _symbol <- TL.toStrict <$> parseSymbol
+  _price <- parseAmount
+  _details <- many parseAnnotation
+  let _computed = []
+  pure $
+    Lot {..}
+      & details . traverse . failing _Fees _Commission //~ _amount
+
+parseAnnotation :: Parser Annotation
+parseAnnotation = do
+  keyword "position" *> (Position <$> parseEffect)
+    <|> keyword "fees" *> (Fees <$> parseAmount)
+    <|> keyword "commission" *> (Commission <$> parseAmount)
+    <|> keyword "gain" *> (Gain <$> parseAmount)
+    <|> keyword "loss" *> (Loss <$> parseAmount)
+    <|> keyword "washed" *> (Washed <$> parseAmount)
+    <|> keyword "wash" *> parseWash
+    <|> keyword "apply"
+      *> (WashApply . TL.toStrict <$> parseSymbol <*> parseAmount)
+    <|> keyword "exempt" *> pure Exempt
+    <|> keyword "net" *> (Net <$> parseAmount)
+    <|> keyword "balance" *> (Balance <$> parseAmount)
+    <|> keyword "account" *> (Account <$> parseText)
+    <|> keyword "trade" *> (Trade <$> parseText)
+    <|> keyword "order" *> (Order <$> parseText)
+    <|> keyword "xact" *> (Transaction <$> parseText)
+    <|> keyword "meta" *> (Meta <$> parseText <*> parseText)
+  where
+    parseWash = do
+      mres <- optional $ do
+        q <- parseAmount
+        _ <- char '@' <* whiteSpace
+        p <- parseAmount
+        pure (q, p)
+      _ <- keyword "to"
+      sym <- parseSymbol
+      pure $ WashTo (TL.toStrict sym) mres
+    parseEffect =
+      Open <$ keyword "open"
+        <|> Close <$ keyword "close"
+
+printJournal :: Journal -> Text
+printJournal =
+  TL.concat
+    . intersperse "\n"
+    . map (printTimed printAction)
+    . view actions
+
+printTimed :: (a -> Text) -> Timed a -> Text
+printTimed printItem t =
+  TL.concat $ intersperse " " $
+    [ printTime (t ^. time),
+      printItem (t ^. item)
+    ]
+
+printAction :: Action -> Text
+printAction = \case
+  Buy lot -> "buy " <> printLot lot
+  Sell lot -> "sell " <> printLot lot
+  Wash lot -> "wash " <> printLot lot
+  Deposit lot -> "deposit " <> printLot lot
+  Withdraw lot -> "withdraw " <> printLot lot
+  Assign lot -> "assign " <> printLot lot
+  Expire lot -> "expire " <> printLot lot
+  Dividend lot -> "dividend " <> printLot lot
+
+printLot :: Lot -> Text
+printLot lot =
+  ( TL.concat $
+      intersperse
+        " "
+        ( [ printAmount 0 (lot ^. amount),
+            TL.fromStrict (lot ^. symbol),
+            printAmount 4 (lot ^. price)
+          ]
+            ++ inlineAnns
+        )
+  )
+    <> case separateAnns of
+      [] -> ""
+      xs ->
+        ( TL.concat $
+            intersperse "\n  " ("" : xs)
+        )
+  where
+    annotations =
+      mapMaybe
+        printAnnotation
+        (sort (lot ^. details ++ lot ^. computed))
+    (inlineAnns, separateAnns) = partitionEithers annotations
+    totalAmount n x = printAmount n (totaled lot x)
+    printAnnotation = \case
+      Position eff -> Just $ Left $ case eff of
+        Open -> "open"
+        Close -> "close"
+      Fees x -> Just $ Left $ "fees " <> totalAmount 2 x
+      Commission x -> Just $ Left $ "commission " <> totalAmount 2 x
+      Gain x -> Just $ Right $ "gain " <> totalAmount 6 x
+      Loss x -> Just $ Right $ "loss " <> totalAmount 6 x
+      Washed x -> Just $ Right $ "washed " <> totalAmount 6 x
+      WashTo x (Just (q, p)) ->
+        Just $ Left $
+          "wash "
+            <> printAmount 0 q
+            <> " @ "
+            <> printAmount 4 p
+            <> " to "
+            <> TL.fromStrict x
+      WashTo x Nothing -> Just $ Left $ "wash to " <> TL.fromStrict x
+      WashApply x amt ->
+        Just $ Left $ "apply " <> TL.fromStrict x <> " " <> printAmount 0 amt
+      Exempt -> Just $ Left "exempt"
+      Net _x -> Nothing
+      Balance _x -> Nothing
+      -- Net x -> Right $ "net " <> printAmount 2 (x ^. coerced)
+      -- Balance x -> Right $ "balance " <> printAmount 2 (x ^. coerced)
+      Account x -> Just $ Left $ "account " <> printText x
+      Trade x -> Just $ Left $ "trade " <> printText x
+      Order x -> Just $ Left $ "order " <> printText x
+      Transaction x -> Just $ Left $ "transaction " <> printText x
+      Meta k v -> Just $ Right $ "meta " <> printText k <> " " <> printText v
+    printText t
+      | T.all isAlphaNum t = TL.fromStrict t
+      | otherwise = "\"" <> TL.replace "\"" "\\\"" (TL.fromStrict t) <> "\""
+
+parseText :: Parser T.Text
+parseText =
+  T.pack
+    <$> ( char '"' *> manyTill L.charLiteral (char '"')
+            <|> some alphaNumChar
+        )
+
+parseTime :: Parser UTCTime
+parseTime = do
+  dateString <- some (digitChar <|> char '-') <* whiteSpace
+  timeString <-
+    optional (some (digitChar <|> char ':') <* whiteSpace)
+  case timeString of
+    Nothing -> parseTimeM False defaultTimeLocale "%Y-%m-%d" dateString
+    Just str ->
+      parseTimeM
+        False
+        defaultTimeLocale
+        "%Y-%m-%d %H:%M:%S%Q"
+        (dateString ++ " " ++ str)
+
+printTime :: UTCTime -> Text
+printTime = TL.pack . formatTime defaultTimeLocale "%Y-%m-%d %H:%M:%S%Q"
+
+parseAmount :: KnownNat n => Parser (Amount n)
+parseAmount =
+  read <$> some (digitChar <|> char '.') <* whiteSpace
+
+printAmount :: Int -> Amount 6 -> Text
+printAmount n = TL.pack . amountToString n
+
+parseSymbol :: Parser Text
+parseSymbol =
+  TL.pack <$> some (satisfy (\c -> isAlphaNum c || c `elem` ['.', '/']))
+    <* whiteSpace
diff --git a/src/Journal/Split.hs b/src/Journal/Split.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/Split.hs
@@ -0,0 +1,159 @@
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+
+module Journal.Split where
+
+import Control.Lens
+import Data.Default
+import Data.List (foldl')
+
+data Split a
+  = Some
+      { _used :: a,
+        _kept :: a
+      }
+  | All a
+  | None a
+  deriving (Eq, Ord, Show)
+
+makePrisms ''Split
+
+instance Functor Split where
+  fmap f (Some u k) = Some (f u) (f k)
+  fmap f (All u) = All (f u)
+  fmap f (None k) = None (f k)
+
+_Splits :: Traversal (Split a) (Split b) a b
+_Splits f (Some u k) = Some <$> f u <*> f k
+_Splits f (All u) = All <$> f u
+_Splits f (None k) = None <$> f k
+
+_SplitUsed :: Traversal' (Split a) a
+_SplitUsed f (Some u k) = Some <$> f u <*> pure k
+_SplitUsed f (All u) = All <$> f u
+_SplitUsed _ (None k) = pure $ None k
+
+_SplitKept :: Traversal' (Split a) a
+_SplitKept f (Some u k) = Some u <$> f k
+_SplitKept _ (All u) = pure $ All u
+_SplitKept f (None k) = None <$> f k
+
+align ::
+  (Eq n, Ord n, Num n) =>
+  Lens' a n ->
+  Lens' b n ->
+  a ->
+  b ->
+  (Split a, Split b)
+align la lb x y
+  | xq == 0 && yq == 0 =
+    (None x, None y)
+  | xq == 0 = (None x, All y)
+  | yq == 0 = (All x, None y)
+  | xq == yq = (All x, All y)
+  | xq < yq =
+    ( All x,
+      Some
+        (y & lb .~ xq)
+        (y & lb .~ diff)
+    )
+  | otherwise =
+    ( Some
+        (x & la .~ yq)
+        (x & la .~ diff),
+      All y
+    )
+  where
+    xq = x ^. la
+    yq = y ^. lb
+    diff = abs (xq - yq)
+
+data Applied v a b = Applied
+  { _value :: v,
+    _src :: Split a,
+    _dest :: Split b
+  }
+  deriving (Eq, Ord, Show)
+
+makeLenses ''Applied
+
+nothingApplied :: Default v => a -> b -> Applied v a b
+nothingApplied x y = Applied def (None x) (None y)
+
+splits :: Default v => Split a -> Split b -> Applied v a b
+splits = Applied def
+
+data Considered a b c = Considered
+  { _fromList :: [a],
+    _newList :: [b],
+    _fromElement :: [c],
+    _newElement :: Maybe c
+  }
+  deriving (Eq, Show)
+
+makeLenses ''Considered
+
+consideredList :: Traversal' (Considered a a c) a
+consideredList f Considered {..} =
+  Considered <$> traverse f _fromList
+    <*> traverse f _newList
+    <*> pure _fromElement
+    <*> pure _newElement
+
+consideredElements :: Traversal' (Considered a b c) c
+consideredElements f Considered {..} =
+  Considered _fromList _newList
+    <$> traverse f _fromElement
+    <*> traverse f _newElement
+
+consideredFrom :: Traversal' (Considered a b a) a
+consideredFrom f Considered {..} =
+  Considered <$> traverse f _fromList
+    <*> pure _newList
+    <*> traverse f _fromElement
+    <*> pure _newElement
+
+consideredNew :: Traversal' (Considered a c c) c
+consideredNew f Considered {..} =
+  Considered _fromList
+    <$> traverse f _newList
+    <*> pure _fromElement
+    <*> traverse f _newElement
+
+newConsidered :: Considered a b c
+newConsidered =
+  Considered
+    { _fromList = [],
+      _newList = [],
+      _fromElement = [],
+      _newElement = Nothing
+    }
+
+-- Given a list, and an element, determine the following three data:
+--
+-- - A revised version of the input list, based on that element
+-- - Elements derived from the input list that become new outputs
+-- - The fragments of the original element
+consider ::
+  (b -> c -> Applied v b c) ->
+  (c -> v -> b -> a) ->
+  [b] ->
+  c ->
+  Considered a b c
+consider f mk lst el =
+  result & fromList %~ reverse
+    & newList %~ reverse
+    & fromElement %~ reverse
+    & newElement .~ remaining
+  where
+    (remaining, result) = foldl' go (Just el, newConsidered) lst
+    go (Nothing, c) x = (Nothing, c & newList %~ (x :))
+    go (Just z, c) x =
+      ( _dest ^? _SplitKept,
+        c & fromList %~ maybe id ((:) . mk z _value) (_src ^? _SplitUsed)
+          & newList %~ maybe id (:) (_src ^? _SplitKept)
+          & fromElement %~ maybe id (:) (_dest ^? _SplitUsed)
+      )
+      where
+        Applied {..} = f x z
diff --git a/src/Journal/ThinkOrSwim.hs b/src/Journal/ThinkOrSwim.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/ThinkOrSwim.hs
@@ -0,0 +1,115 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE TypeFamilies #-}
+
+module Journal.ThinkOrSwim where
+
+import Control.Lens
+import Control.Monad.State
+import qualified Data.ByteString as B
+import Data.ByteString.Lazy (ByteString)
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.Csv as Csv
+import Data.Map (Map)
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as TL
+import qualified Data.Text.Lazy.Encoding as TL
+-- import Data.Time
+import Data.Vector (toList)
+-- import Journal.Amount
+import System.IO
+
+data ThinkOrSwim = ThinkOrSwim
+  { _account :: Text,
+    _xacts :: [Csv.NamedRecord],
+    _futures :: [Csv.NamedRecord],
+    _forex :: [Csv.NamedRecord],
+    _orders :: [Csv.NamedRecord],
+    _trades :: [Csv.NamedRecord],
+    _equities :: [Csv.NamedRecord],
+    _options :: [Csv.NamedRecord],
+    _pandl :: [Csv.NamedRecord],
+    _byOrderId ::
+      Map
+        B.ByteString
+        ([Csv.NamedRecord], [Csv.NamedRecord], [Csv.NamedRecord])
+  }
+
+makeLenses ''ThinkOrSwim
+
+readSection :: Handle -> IO [Csv.NamedRecord]
+readSection h =
+  fmap (toList . snd)
+    . check
+    . Csv.decodeByNameWithP pure Csv.defaultDecodeOptions
+    =<< readUntilBlank
+  where
+    readUntilBlank = do
+      line <- BL.fromStrict <$> B.hGetLine h
+      if BL.null line
+        then pure line
+        else do
+          rest <- readUntilBlank
+          pure $ line <> "\n" <> rest
+    check :: MonadFail m => Either String a -> m a
+    check (Left err) = fail $ "Error: " ++ err
+    check (Right res) = pure res
+
+readCsv :: FilePath -> IO ThinkOrSwim
+readCsv path = withFile path ReadMode $ \h -> do
+  "\65279Account" : "Statement" : "for" : _account : _ <-
+    TL.words . TL.decodeUtf8 <$> readLine h
+  "" <- readLine h
+  "Cash Balance" <- readLine h
+  _xacts <- readSection h
+  "Futures Statements" <- readLine h
+  _futures <- readSection h
+  "Forex Statements" <- readLine h
+  _forex <- readSection h
+  " " <- readLine h
+  "\"Total" : "Cash" : _ <-
+    TL.words . TL.decodeUtf8 <$> readLine h
+  "" <- readLine h
+  "" <- readLine h
+  "Account Order History" <- readLine h
+  _orders <- readSection h
+  "Account Trade History" <- readLine h
+  _trades <- readSection h
+  "Equities" <- readLine h
+  _equities <- readSection h
+  "Options" <- readLine h
+  _options <- readSection h
+  "Profits and Losses" <- readLine h
+  _pandl <- readSection h
+  let _byOrderId = flip execState mempty $ do
+        forM_ _xacts $ \xact -> do
+          entry (xact ^?! ix "REF #") . _1 <>= [xact]
+        scanOrders _2 _orders
+        scanOrders _3 _trades
+  pure ThinkOrSwim {..}
+  where
+    entry oid = at oid . non ([], [], [])
+    scanOrders l = flip foldM_ Nothing $ \lx x -> do
+      let oid = x ^?! ix "Order ID"
+      entry
+        ( case lx of
+            Nothing -> oid
+            Just o
+              | B.null oid -> o
+              | otherwise -> oid
+        )
+        . l
+        <>= [x]
+      pure $
+        if null x
+          then lx
+          else Just oid
+    readLine :: Handle -> IO ByteString
+    readLine h = do
+      line <- BL.fromStrict <$> B.hGetLine h
+      -- print line
+      pure line
diff --git a/src/Journal/Types.hs b/src/Journal/Types.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/Types.hs
@@ -0,0 +1,297 @@
+{-# LANGUAGE DataKinds #-}
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveFoldable #-}
+{-# LANGUAGE DeriveFunctor #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE DeriveTraversable #-}
+{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# OPTIONS_GHC -Wno-orphans #-}
+
+module Journal.Types where
+
+import Control.Applicative
+import Control.Lens
+import Data.IntMap (IntMap)
+import Data.Map (Map)
+import Data.Text (Text)
+import Data.Time
+import Data.Time.Format.ISO8601
+import GHC.Generics hiding (to)
+import GHC.TypeLits
+import Journal.Amount
+import Journal.Split
+import Text.Show.Pretty
+import Prelude hiding (Double, Float)
+
+data Effect = Open | Close
+  deriving (Show, Eq, Ord, Enum, Bounded, Generic, PrettyVal)
+
+data Annotation
+  = Position Effect
+  | Fees (Amount 6)
+  | Commission (Amount 6)
+  | Gain (Amount 6)
+  | Loss (Amount 6)
+  | Washed (Amount 6)
+  | WashTo Text (Maybe (Amount 6, Amount 6))
+  | WashApply Text (Amount 6)
+  | Exempt
+  | Net (Amount 2)
+  | Balance (Amount 2)
+  | Account Text
+  | Trade Text
+  | Order Text
+  | Transaction Text
+  | Meta Text Text
+  deriving (Show, Eq, Ord, Generic, PrettyVal)
+
+makePrisms ''Annotation
+
+-- | The '_Adjustments' traversal returns any adjust to the price of an
+-- action. For example, a prior wash sale may increase the cost basis of a
+-- position, or a gain might decrease it.
+adjustment :: Traversal' Annotation (Amount 6)
+adjustment f = \case
+  Fees x -> Fees <$> f x
+  Commission x -> Commission <$> f x
+  Gain x -> Gain . negate <$> f (- x)
+  Loss x -> Loss <$> f x
+  Washed x -> Washed <$> f x
+  x -> x <$ f 0
+
+instance PrettyVal UTCTime where
+  prettyVal = String . iso8601Show
+
+-- | A 'Lot' represents a collection of shares, with a given price and a
+--   transaction date.
+data Lot = Lot
+  { _amount :: Amount 6,
+    _symbol :: Text,
+    _price :: Amount 6,
+    -- | All annotations that relate to lot shares are expressed "per share",
+    -- just like the price.
+    _details :: [Annotation],
+    _computed :: [Annotation]
+  }
+  deriving (Show, Eq, Ord, Generic, PrettyVal)
+
+makeLenses ''Lot
+
+alignLots :: Lot -> Lot -> (Split Lot, Split Lot)
+alignLots = align amount amount
+
+totaled :: KnownNat n => Lot -> Amount n -> Amount n
+totaled lot n = lot ^. amount . coerced * n
+
+fees :: Traversal' Lot (Amount 6)
+fees = details . traverse . failing _Fees _Commission
+
+-- | The '_Adjustments' traversal returns any adjust to the price of an
+-- action. For example, a prior wash sale may increase the cost basis of a
+-- position, or a gain might decrease it.
+adjustments :: Fold Lot (Amount 6)
+adjustments f s =
+  error "Never used"
+    <$ traverse
+      f
+      ( s ^.. details . traverse . adjustment
+          ++ s ^.. computed . traverse . adjustment
+      )
+
+data Action
+  = Buy Lot
+  | Sell Lot
+  | Wash Lot
+  | Deposit Lot
+  | Withdraw Lot
+  | Assign Lot
+  | Expire Lot
+  | Dividend Lot
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic,
+      PrettyVal
+    )
+
+makePrisms ''Action
+
+foldAction :: (Lot -> a) -> Action -> a
+foldAction f = \case
+  Buy lot -> f lot
+  Sell lot -> f lot
+  Wash lot -> f lot
+  Deposit lot -> f lot
+  Withdraw lot -> f lot
+  Assign lot -> f lot
+  Expire lot -> f lot
+  Dividend lot -> f lot
+
+mapAction :: (Lot -> Lot) -> Action -> Action
+mapAction f = \case
+  Buy lot -> Buy (f lot)
+  Sell lot -> Sell (f lot)
+  Wash lot -> Wash (f lot)
+  Deposit lot -> Deposit (f lot)
+  Withdraw lot -> Withdraw (f lot)
+  Assign lot -> Assign (f lot)
+  Expire lot -> Expire (f lot)
+  Dividend lot -> Dividend (f lot)
+
+_Lot :: Lens' Action Lot
+_Lot f = \case
+  Buy lot -> Buy <$> f lot
+  Sell lot -> Sell <$> f lot
+  Wash lot -> Wash <$> f lot
+  Deposit lot -> Deposit <$> f lot
+  Withdraw lot -> Withdraw <$> f lot
+  Assign lot -> Assign <$> f lot
+  Expire lot -> Expire <$> f lot
+  Dividend lot -> Dividend <$> f lot
+
+lotNetAmount :: Lot -> Amount 6
+lotNetAmount lot = totaled lot (lot ^. price + sum (lot ^.. adjustments))
+
+-- | The 'netAmount' indicates the exact effect on account balance this action
+-- represents.
+netAmount :: Action -> Amount 2
+netAmount = view coerced . \case
+  Buy lot -> - totaled lot (lot ^. price + sum (lot ^.. fees))
+  Sell lot -> totaled lot (lot ^. price - sum (lot ^.. fees))
+  Wash _lot -> 0
+  Deposit lot -> lot ^. amount
+  Withdraw lot -> - (lot ^. amount)
+  Assign _lot -> 0
+  Expire _lot -> 0
+  Dividend lot -> lot ^. amount
+
+data Event
+  = Opened Bool Lot
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic,
+      PrettyVal
+    )
+
+makePrisms ''Event
+
+data Timed a = Timed
+  { _time :: UTCTime,
+    _item :: a
+  }
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic,
+      PrettyVal,
+      Functor,
+      Foldable,
+      Traversable
+    )
+
+makeLenses ''Timed
+
+data Change
+  = SawAction (Timed Action)
+  | Submit (Timed Lot) -- can only be an adjustment
+  | SubmitEnd
+  | Result (Timed Action)
+  | AddEvent (Timed Event)
+  | RemoveEvent Int
+  | ReplaceEvent Int (Timed Event)
+  | SaveWash Text (Timed Lot)
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic,
+      PrettyVal
+    )
+
+makePrisms ''Change
+
+data InstrumentState = InstrumentState
+  { _events :: IntMap (Timed Event),
+    _washSales :: Map Text [Timed Lot]
+  }
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic
+    )
+
+makeLenses ''InstrumentState
+
+newInstrumentState :: InstrumentState
+newInstrumentState = InstrumentState mempty mempty
+
+data AccountState = AccountState
+  { _nextId :: Int,
+    _balance :: Amount 2,
+    _instruments :: Map Text InstrumentState
+  }
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic
+    )
+
+makeLenses ''AccountState
+
+newAccountState :: AccountState
+newAccountState = AccountState 1 0 mempty
+
+data JournalState = JournalState
+  { _accounts :: Map (Maybe Text) AccountState
+  }
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic
+    )
+
+makeLenses ''JournalState
+
+newJournalState :: JournalState
+newJournalState = JournalState mempty
+
+data Journal = Journal
+  { _actions :: [Timed Action]
+  }
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic,
+      PrettyVal
+    )
+
+makeLenses ''Journal
+
+newJournal :: Journal
+newJournal = Journal []
+
+data JournalError
+  = ChangeNotFromImpliedChanges Change
+  | UnexpectedRemainder (Timed Action)
+  | NetAmountDoesNotMatch (Timed Action) (Amount 2) (Amount 2)
+  | BalanceDoesNotMatch (Timed Action) (Amount 2) (Amount 2)
+  deriving
+    ( Show,
+      Eq,
+      Ord,
+      Generic,
+      PrettyVal
+    )
+
+-- "Change not produced by impliedChanges"
+-- "impliedChanges: unexpected remainder: "
+-- "Unapplied wash sale requires use of \"wash to\""
diff --git a/src/Journal/Utils.hs b/src/Journal/Utils.hs
new file mode 100644
--- /dev/null
+++ b/src/Journal/Utils.hs
@@ -0,0 +1,109 @@
+{-# LANGUAGE FlexibleContexts #-}
+{-# LANGUAGE RankNTypes #-}
+
+module Journal.Utils where
+
+import Control.Applicative
+import Control.Arrow
+import Control.Lens
+import Control.Monad.Trans.Class
+import Control.Monad.Trans.Reader
+import Control.Monad.Trans.State
+import Data.Coerce
+import Data.Foldable
+import Data.Text (Text)
+import qualified Data.Text as T
+import Data.Time
+import Data.Time.Format.ISO8601
+import Debug.Trace (traceM)
+import Text.PrettyPrint as P
+import Prelude hiding ((<>), Double, Float)
+
+readonly :: Monad m => ReaderT s m a -> StateT s m a
+readonly f = lift . runReaderT f =<< get
+
+justify :: [a] -> [Maybe a]
+justify [] = [Nothing]
+justify (x : xs) = Just x : justify xs
+
+unzipBoth :: [([a], [b])] -> ([a], [b])
+unzipBoth = (concat *** concat) . unzip
+
+distance :: UTCTime -> UTCTime -> Integer
+distance x y = abs (utctDay x `diffDays` utctDay y)
+
+renderM :: Applicative f => Doc -> f ()
+renderM = traceM . render
+
+percent :: (Num a, Num b, Coercible b a) => a -> Lens' b b
+percent n f s = f part <&> \v -> v + (s - part)
+  where
+    part = s * coerce n
+
+zipped :: Traversal' s a -> Traversal' s b -> Traversal' s (a, b)
+zipped f g k s = case liftA2 (,) (s ^? f) (s ^? g) of
+  Nothing -> pure s
+  Just p -> k p <&> \(a, b) -> s & f .~ a & g .~ b
+
+zipped3 ::
+  Traversal' s a ->
+  Traversal' s b ->
+  Traversal' s c ->
+  Traversal' s (a, b, c)
+zipped3 f g h k s = case liftA3 (,,) (s ^? f) (s ^? g) (s ^? h) of
+  Nothing -> pure s
+  Just p -> k p <&> \(a, b, c) -> s & f .~ a & g .~ b & h .~ c
+
+contractList :: (a -> a -> Maybe a) -> [a] -> [a]
+contractList _ [] = []
+contractList _ [x] = [x]
+contractList f (x : y : xs) = case f x y of
+  Nothing -> x : contractList f (y : xs)
+  Just z -> contractList f (z : xs)
+
+renderList :: (a -> Doc) -> [a] -> Doc
+renderList _ [] = brackets P.empty
+renderList f ts =
+  fst (foldl' go (P.empty, True) ts) <> space <> rbrack
+  where
+    go (_, True) x = (lbrack <> space <> f x, False)
+    go (acc, False) x = (acc $$ comma <> space <> f x, False)
+
+class Render a where
+  rendered :: a -> Doc
+
+instance Render a => Render [a] where
+  rendered = renderList rendered
+
+instance Render a => Render (Maybe a) where
+  rendered Nothing = text "Nothing"
+  rendered (Just x) = text "Just" <> space <> rendered x
+
+instance Render Text where
+  rendered = text . T.unpack
+
+instance Render Day where
+  rendered = text . iso8601Show
+
+instance Render UTCTime where
+  rendered = text . iso8601Show . utctDay
+
+tshow :: Show a => a -> Doc
+tshow = text . show
+
+-- A Fold over the individual components of a Text split on a separator.
+--
+-- splitOn :: Text -> Fold String String
+-- splitOn :: Text -> Traversal' String String
+--
+-- splitOn :: Text -> IndexedFold Int String String
+-- splitOn :: Text -> IndexedTraversal' Int String String
+--
+-- Note: This function type-checks as a Traversal but it doesn't satisfy the
+-- laws. It's only valid to use it when you don't insert any separator strings
+-- while traversing, and if your original Text contains only isolated split
+-- strings.
+splitOn :: Applicative f => Text -> IndexedLensLike' Int f Text Text
+splitOn s f = fmap (T.intercalate s) . go . T.splitOn s
+  where
+    go = conjoined traverse (indexing traverse) f
diff --git a/src/Journal/mpfr_printf.c b/src/Journal/mpfr_printf.c
new file mode 100644
--- /dev/null
+++ b/src/Journal/mpfr_printf.c
@@ -0,0 +1,95 @@
+#include <stdlib.h>
+#include <string.h>
+#include <stdio.h>
+
+#include <mpfr.h>
+
+int stream_out_mpq(
+  mpq_t      quant,
+  size_t     precision,
+  int        zeros_prec /* = -1 */,
+  mpfr_rnd_t rnd /* = GMP_RNDN */,
+  char **    bufPtr)
+{
+  static const size_t extend_by_digits = 6U;
+
+  mpfr_t tempfb;
+  mpfr_t tempfnum;
+  mpfr_t tempfden;
+
+  mpfr_init(tempfb);
+  mpfr_init(tempfnum);
+  mpfr_init(tempfden);
+
+  // Convert the rational number to a floating-point, extending the
+  // floating-point to a large enough size to get a precise answer.
+
+  mp_prec_t num_prec =
+    (mpfr_prec_t)mpz_sizeinbase(mpq_numref(quant), 2);
+  num_prec += extend_by_digits*64;
+  if (num_prec < MPFR_PREC_MIN)
+    num_prec = MPFR_PREC_MIN;
+
+  mpfr_set_prec(tempfnum, num_prec);
+  mpfr_set_z(tempfnum, mpq_numref(quant), rnd);
+
+  mp_prec_t den_prec =
+    (mpfr_prec_t)mpz_sizeinbase(mpq_denref(quant), 2);
+  den_prec += extend_by_digits*64;
+  if (den_prec < MPFR_PREC_MIN)
+    den_prec = MPFR_PREC_MIN;
+
+  mpfr_set_prec(tempfden, den_prec);
+  mpfr_set_z(tempfden, mpq_denref(quant), rnd);
+
+  mpfr_set_prec(tempfb, num_prec + den_prec);
+  mpfr_div(tempfb, tempfnum, tempfden, rnd);
+
+  if (mpfr_asprintf(bufPtr, "%.*RNf", precision, tempfb) < 0) {
+    mpfr_clear(tempfb);
+    mpfr_clear(tempfnum);
+    mpfr_clear(tempfden);
+    return -1;
+  }
+
+  char * buf = *bufPtr;
+
+  if (zeros_prec >= 0) {
+    size_t index = strlen(buf);
+    size_t point = 0;
+    for (size_t i = 0; i < index; i++) {
+      if (buf[i] == '.') {
+        point = i;
+        break;
+      }
+    }
+    if (point > 0) {
+      while (--index >= (point + 1 + (size_t)zeros_prec) &&
+             buf[index] == '0')
+        buf[index] = '\0';
+      if (index >= (point + (size_t)zeros_prec) &&
+          buf[index] == '.')
+        buf[index] = '\0';
+    }
+  }
+
+  mpfr_clear(tempfb);
+  mpfr_clear(tempfnum);
+  mpfr_clear(tempfden);
+
+  return 0;
+}
+
+void rational_to_str(
+  signed long num,
+  unsigned long den,
+  unsigned int rnd_mode,
+  size_t prec,
+  char ** bufPtr)
+{
+  mpq_t val;
+  mpq_init(val);
+  mpq_set_si(val, num, den);
+  stream_out_mpq(val, prec, -1, rnd_mode, bufPtr);
+  mpq_clear(val);
+}
diff --git a/test/Examples.hs b/test/Examples.hs
new file mode 100644
--- /dev/null
+++ b/test/Examples.hs
@@ -0,0 +1,209 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE QuasiQuotes #-}
+
+module Examples (testExamples) where
+
+import Data.List (intersperse)
+import Data.String.Here.Interpolated
+import Data.Text.Lazy (Text)
+import qualified Data.Text.Lazy as TL
+import Journal.Model
+import Journal.Parse
+import Test.Tasty
+import Test.Tasty.HUnit
+import Text.Megaparsec
+
+testExamples :: TestTree
+testExamples =
+  testGroup
+    "examples"
+    [ baseline,
+      realWorld
+    ]
+
+baseline :: TestTree
+baseline =
+  testGroup
+    "baseline"
+    [ testCase "journal-buy-sell-profit" journalBuySellProfit,
+      testCase "journal-buy-sell-loss-buy" journalBuySellLossBuy
+    ]
+
+journalBuySellProfit :: Assertion
+journalBuySellProfit = ii @--> oo
+  where
+    ii =
+      [i|
+2020-07-02 buy 100 AAPL 260.00
+2020-07-03 sell 100 AAPL 300.00 fees 0.20
+        |]
+    oo =
+      [i|
+2020-07-02 00:00:00 buy 100 AAPL 260.0000 open
+2020-07-03 00:00:00 sell 100 AAPL 300.0000 close fees 0.20
+  gain 3999.800000
+        |]
+
+journalBuySellLossBuy :: Assertion
+journalBuySellLossBuy = ii @--> oo
+  where
+    ii =
+      [i|
+2020-07-02 buy 100 AAPL 260.00
+2020-07-03 sell 100 AAPL 240.00 fees 0.20 wash to A
+2020-07-04 buy 100 AAPL 260.00 apply A 100
+        |]
+    oo =
+      [i|
+2020-07-02 00:00:00 buy 100 AAPL 260.0000 open
+2020-07-03 00:00:00 sell 100 AAPL 240.0000 close fees 0.20 wash to A
+  loss 2000.200000
+2020-07-03 00:00:00 wash 100 AAPL 20.0020 fees 0.20 wash to A
+2020-07-04 00:00:00 buy 100 AAPL 260.0000 open apply A 100
+  washed 2000.200000
+        |]
+
+realWorld :: TestTree
+realWorld =
+  testGroup
+    "real-world"
+    [ testCase "zoom-history" zoomHistory
+    ]
+
+zoomHistory :: Assertion
+zoomHistory = ii @--> oo
+  where
+    ii =
+      [i|
+| Trns |   Qty | Open  |    Basis |    Price | Gain ($) |    |                     |
+|------+-------+-------+----------+----------+----------+----+---------------------|
+| Eqty |   140 | 06/24 |  99.7792 |          |          |    |                     |
+| Eqty |    10 | 06/24 |   89.785 |          |          |    |                     |
+| Eqty |    30 | 06/24 |   106.68 |          |          |    |                     |
+| Eqty |   170 | 06/25 |  85.8415 |          |          |    |                     |
+
+2019-06-24 buy 140 ZM 99.7792 exempt
+2019-06-24 buy 10 ZM 89.785 exempt
+2019-06-24 buy 30 ZM 106.68 exempt
+2019-06-25 buy 170 ZM 85.8415 exempt
+
+2019-07-01 buy 50 ZM 85.80
+| Buy  |    50 |       |          |    85.80 |          |    |                     |
+
+2019-07-01 sell 50 ZM 86.675 fees 0.10
+| Sell |    50 | 06/24 |  99.7792 |   86.673 |  -655.31 |    |                     |
+| Wash |  [50] | 07/01 |          |          |   655.31 | == | 85.80 -> 98.9062    |
+
+2019-07-02 buy 50 ZM 85.50
+| Buy  |    50 |       |          |    85.50 |          |    |                     |
+
+2019-07-03 sell 100 ZM 86.7765 fees 0.19 wash to A
+| Sell |    90 | 06/24 |  99.7792 |  86.7746 | -1170.42 |    |                     |
+| Wash |  [50] | 07/02 |          |          |   650.23 | == | 85.50 -> 98.5046    |
+| Wash |  [40] | 07/29 |          |          |   520.19 | A. |                     |
+| Sell |    10 | 06/24 |   89.785 |   86.775 |   -30.10 |    |                     |
+| Wash |  [10] | 07/29 |          |          |    30.10 | A. |                     |
+
+2019-07-03 sell 100 ZM 88.14 fees 0.20 wash to A
+| Sell |    30 | 06/24 |   106.68 |   88.138 |  -556.26 |    |                     |
+| Wash |  [30] | 07/29 |          |          |   556.26 | A> | 95.7852 -> 98.5516  |
+| Sell |    70 | 06/25 |  85.8415 |  88.1381 |   160.76 |    |                     |
+
+2019-07-12 sell 200 ZM 94.085 fees 0.41 wash to B
+| Sell |   100 | 06/25 |  85.8415 |   94.083 |   824.15 |    |                     |
+| Sell |    50 | 07/01 |  98.9062 |  94.0828 |  -241.17 |    |                     |
+| Sell |    50 | 07/02 |  98.5046 |   94.083 |  -221.08 |    |                     |
+| Wash |  [50] | 07/29 |          |          |   241.17 | B. |                     |
+| Wash |  [50] | 07/29 |          |          |   221.08 | B> | 95.7852 -> 100.4077 |
+
+2019-07-29 buy 500 ZM 95.7852 apply A 400 apply B 100
+| Buy  |   400 |       |          |  98.5516 |          | <A |                     |
+| Buy  |   100 |       |          | 100.4077 |          | <B |                     |
+
+2019-07-29 sell 400 ZM 95.657 fees 0.84 wash 200 @ 0.1303 to C
+| Sell |   400 | 07/29 |  98.5516 |  95.6549 | -1158.67 |    |                     |
+| Wash | [200] | 07/30 |          |          |    26.06 | C> | 96.00 -> 96.1303    |
+
+2019-07-29 sell 100 ZM 96.1841 fees 0.21
+| Sell |   100 | 07/29 | 100.4077 |   96.182 |  -422.57 |    |                     |
+
+2019-07-30 buy 200 ZM 96.00 apply C 200
+| Buy  |   200 |       |          |  96.1303 |          | <C |                     |
+2019-09-06 buy 100 ZM 85.97 commission 5.00
+| Buy  |   100 |       |          |    86.02 |          |    |                     |
+
+2020-02-18 sell 300 ZM 95.00 fees 0.67
+| Sell |   200 | 07/30 | 96.1303  |   95.00  |   897.78 |    |                     |
+| Sell |   100 | 09/06 | 85.9245  |   95.00  |  -226.51 |    |                     |
+        |]
+    oo =
+      [i|
+2019-06-24 00:00:00 buy 140 ZM 99.7792 open exempt
+2019-06-24 00:00:00 buy 10 ZM 89.7850 open exempt
+2019-06-24 00:00:00 buy 30 ZM 106.6800 open exempt
+2019-06-25 00:00:00 buy 170 ZM 85.8415 open exempt
+2019-07-01 00:00:00 buy 50 ZM 85.8000 open
+2019-07-01 00:00:00 sell 50 ZM 86.6750 close fees 0.10
+  loss 655.310000
+2019-07-01 00:00:00 wash 50 ZM 13.1062
+  washed 4290.000000
+2019-07-02 00:00:00 buy 50 ZM 85.5000 open
+2019-07-03 00:00:00 sell 90 ZM 86.7765 close fees 0.171 wash to A
+  loss 1170.414000
+2019-07-03 00:00:00 wash 50 ZM 13.0046
+  washed 4275.000000
+2019-07-03 00:00:00 wash 40 ZM 13.0046 fees 0.076 wash to A
+2019-07-03 00:00:00 sell 10 ZM 86.7765 close fees 0.019 wash to A
+  loss 30.104000
+2019-07-03 00:00:00 wash 10 ZM 3.0104 fees 0.019 wash to A
+2019-07-03 00:00:00 sell 30 ZM 88.1400 close fees 0.06 wash to A
+  loss 556.260000
+2019-07-03 00:00:00 wash 30 ZM 18.5420 fees 0.06 wash to A
+2019-07-03 00:00:00 sell 70 ZM 88.1400 close fees 0.14 wash to A
+  gain 160.755000
+2019-07-12 00:00:00 sell 100 ZM 94.0850 close fees 0.205 wash to B
+  gain 824.145000
+2019-07-12 00:00:00 sell 50 ZM 94.0850 close fees 0.1025 wash to B
+  loss 241.162500
+2019-07-12 00:00:00 wash 50 ZM 4.82325 fees 0.1025 wash to B
+2019-07-12 00:00:00 sell 50 ZM 94.0850 close fees 0.1025 wash to B
+  loss 221.082500
+2019-07-12 00:00:00 wash 50 ZM 4.42165 fees 0.1025 wash to B
+2019-07-29 00:00:00 buy 400 ZM 95.7852 open apply A 400 apply B 100
+  washed 1106.548000
+2019-07-29 00:00:00 buy 100 ZM 95.7852 open apply A 400 apply B 100
+  washed 462.245000
+2019-07-29 00:00:00 sell 400 ZM 95.6570 close fees 0.84 wash 200 @ 0.1303 to C
+  loss 1158.668000
+2019-07-29 00:00:00 wash 400 ZM 2.89667 fees 0.84 wash 200 @ 0.1303 to C
+2019-07-29 00:00:00 sell 100 ZM 96.1841 close fees 0.21
+  loss 422.565000
+2019-07-30 00:00:00 buy 200 ZM 96.0000 open apply C 200
+  washed 26.060000
+2019-09-06 00:00:00 buy 100 ZM 85.9700 open commission 5.00
+2020-02-18 00:00:00 sell 200 ZM 95.0000 close fees 0.446667
+  loss 226.506667
+2020-02-18 00:00:00 sell 100 ZM 95.0000 close fees 0.223333
+  gain 897.776667
+        |]
+
+(@-->) :: Text -> Text -> Assertion
+x @--> y = do
+  y' <- parseProcessPrint "" x
+  trimLines y' @?= trimLines y
+  where
+    trimLines =
+      TL.concat
+        . intersperse "\n"
+        . map TL.strip
+        . TL.splitOn "\n"
+        . TL.strip
+    parseProcessPrint :: MonadFail m => FilePath -> Text -> m Text
+    parseProcessPrint path journal = do
+      actions <- case parse parseJournal path journal of
+        Left e -> fail $ errorBundlePretty e
+        Right res -> pure res
+      case processJournal actions of
+        Left err ->
+          error $ "Error processing journal " ++ path ++ ": " ++ show err
+        Right j -> pure $ printJournal j
diff --git a/test/Main.hs b/test/Main.hs
new file mode 100644
--- /dev/null
+++ b/test/Main.hs
@@ -0,0 +1,14 @@
+module Main where
+
+import Examples
+import ModelTests
+import Test.Tasty
+
+main :: IO ()
+main =
+  defaultMain $
+    testGroup
+      "trade-journal"
+      [ testExamples,
+        testModel
+      ]
diff --git a/test/ModelTests.hs b/test/ModelTests.hs
new file mode 100644
--- /dev/null
+++ b/test/ModelTests.hs
@@ -0,0 +1,427 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module ModelTests (testModel) where
+
+import Control.Exception
+import Control.Lens
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Class
+import Data.Int
+import Data.Ratio
+import Data.Time
+import Data.Typeable
+import Hedgehog hiding (Action)
+import qualified Hedgehog.Gen as Gen
+import qualified Hedgehog.Range as Range
+import Journal.Amount
+import Journal.Model
+import Journal.Types
+import Test.HUnit.Lang (FailureReason (..))
+import Test.Tasty
+import Test.Tasty.HUnit
+import Test.Tasty.Hedgehog
+import Text.Show.Pretty
+
+data MockFailure = MockFailure FailureReason
+  deriving (Eq, Typeable)
+
+instance Show MockFailure where
+  show (MockFailure (Reason msg)) = msg
+  show (MockFailure (ExpectedButGot preface expected actual)) = msg
+    where
+      msg =
+        (case preface of Just str -> str ++ "\n"; Nothing -> "")
+          ++ "expected:\n"
+          ++ expected
+          ++ "\n but got:\n"
+          ++ actual
+
+instance Exception MockFailure
+
+assertEqual' ::
+  (Eq a, PrettyVal a, HasCallStack) =>
+  -- | The message prefix
+  String ->
+  -- | The expected value
+  a ->
+  -- | The actual value
+  a ->
+  Assertion
+assertEqual' preface expected actual =
+  unless (actual == expected) $ do
+    throwIO
+      ( MockFailure
+          ( ExpectedButGot
+              ( if Prelude.null preface
+                  then Nothing
+                  else Just preface
+              )
+              (dumpStr expected)
+              (dumpStr actual)
+          )
+      )
+
+infix 1 @?==
+
+(@?==) :: (MonadIO m, Eq a, PrettyVal a, HasCallStack) => a -> a -> m ()
+actual @?== expected = liftIO $ assertEqual' "" expected actual
+
+testModel :: TestTree
+testModel =
+  testGroup
+    "model"
+    [ baseline
+    ]
+
+genUTCTime :: MonadGen m => m UTCTime
+genUTCTime = do
+  y <- toInteger <$> Gen.int (Range.constant 2000 2019)
+  m <- Gen.int (Range.constant 1 12)
+  d <- Gen.int (Range.constant 1 28)
+  let day = fromGregorian y m d
+  secs <- toInteger <$> Gen.int (Range.constant 0 86401)
+  pure $ UTCTime day (secondsToDiffTime secs)
+
+genAmount :: MonadGen m => Range Int64 -> m (Amount n)
+genAmount range = do
+  d <- Gen.integral range
+  n <- Gen.integral range
+  pure $ Amount (d % n)
+
+genTimed :: MonadGen m => m a -> m (Timed a)
+genTimed gen = do
+  _time <- genUTCTime
+  _item <- gen
+  pure Timed {..}
+
+genLot :: MonadGen m => m Lot
+genLot = do
+  q <- genAmount (Range.linear 1 1000)
+  p <- genAmount (Range.linear 1 2000)
+  pure $ Lot q "FOO" p [] []
+
+baseline :: TestTree
+baseline =
+  testGroup
+    "baseline"
+    [ testProperty "simple-buy" simpleBuy,
+      testProperty "buy-buy" buyBuy,
+      testProperty "buy-sell-breakeven" buySellBreakeven,
+      testProperty "buy-sell-profit" buySellProfit,
+      testProperty "buy-sell-part-profit" buySellPartProfit,
+      testProperty "buy-buy-sell-loss" buyBuySellLoss,
+      testProperty "buy-sell-loss-buy" buySellLossBuy,
+      testProperty "buy-sell-loss" buySellLoss,
+      testProperty "simple-sell" simpleSell,
+      testProperty "sell-buy-profit" sellBuyProfit
+    ]
+
+simpleBuy :: Property
+simpleBuy = property $ do
+  b <- forAll $ genTimed genLot
+  -- A simple buy
+  lift $
+    processActionsWithChanges
+      [Buy <$> b]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open]))
+          ],
+          [Buy <$> (b & item . details <>~ [Position Open])]
+        )
+
+buyBuy :: Property
+buyBuy = property $ do
+  b <- forAll $ genTimed genLot
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b,
+        Buy <$> b
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open]))
+          ],
+          [ Buy <$> (b & item . details <>~ [Position Open]),
+            Buy <$> (b & item . details <>~ [Position Open])
+          ]
+        )
+
+buySellBreakeven :: Property
+buySellBreakeven = property $ do
+  b <- forAll $ genTimed genLot
+  -- A buy and sell at break-even
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b,
+        Sell <$> b
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Sell <$> b),
+            Result
+              ( Sell
+                  <$> (b & item . details <>~ [Position Close, Gain 0])
+              ),
+            RemoveEvent 1
+          ],
+          [ Buy <$> (b & item . details <>~ [Position Open]),
+            Sell <$> (b & item . details <>~ [Position Close, Gain 0])
+          ]
+        )
+
+buySellProfit :: Property
+buySellProfit = property $ do
+  b <- forAll $ genTimed genLot
+  let s = b
+      sp = s & item . price +~ 10
+  -- A buy and sell at a profit
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b,
+        Sell <$> sp
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Sell <$> sp),
+            Result
+              ( Sell
+                  <$> (sp & item . details <>~ [Position Close, Gain 10])
+              ),
+            RemoveEvent 1
+          ],
+          [ Buy <$> (b & item . details <>~ [Position Open]),
+            Sell <$> (sp & item . details <>~ [Position Close, Gain 10])
+          ]
+        )
+
+buySellPartProfit :: Property
+buySellPartProfit = property $ do
+  b <- forAll $ genTimed genLot
+  let b2 = b & item . amount *~ 2
+      s = b
+      sp = s & item . price +~ 10
+  -- A buy and sell at a partial profit
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b2,
+        Sell <$> sp
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b2),
+            AddEvent (Opened True <$> b2),
+            Result (Buy <$> (b2 & item . details <>~ [Position Open])),
+            SawAction (Sell <$> sp),
+            Result
+              ( Sell
+                  <$> (sp & item . details <>~ [Position Close, Gain 10])
+              ),
+            ReplaceEvent 1 (Opened True <$> b)
+          ],
+          [ Buy <$> (b2 & item . details <>~ [Position Open]),
+            Sell <$> (sp & item . details <>~ [Position Close, Gain 10])
+          ]
+        )
+
+buySellLoss :: Property
+buySellLoss = property $ do
+  b <- forAll $ genTimed genLot
+  let s = b
+      sl =
+        s & item . price -~ 1
+  -- A buy and sell at a loss
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b,
+        Sell <$> sl
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Sell <$> sl),
+            Result
+              ( Sell
+                  <$> ( sl & item . details
+                          <>~ [Position Close, Loss 1]
+                      )
+              ),
+            RemoveEvent 1,
+            Submit (sl & item . price .~ 1),
+            SubmitEnd
+          ],
+          [ Buy <$> (b & item . details <>~ [Position Open]),
+            Sell <$> (sl & item . details <>~ [Position Close, Loss 1])
+          ]
+        )
+
+buySellLossBuy :: Property
+buySellLossBuy = property $ do
+  b <- forAll $ genTimed genLot
+  let s = b
+      sl =
+        s & item . price -~ 1
+          & item . details <>~ [WashTo "A" Nothing]
+      b2 =
+        b & item . details <>~ [WashApply "A" (b ^. item . amount)]
+  -- A buy and sell at a loss, followed by a buy
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b,
+        Sell <$> sl,
+        Buy <$> b2
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Sell <$> sl),
+            Result
+              ( Sell
+                  <$> ( sl & item . details
+                          <>~ [Position Close, Loss 1]
+                      )
+              ),
+            RemoveEvent 1,
+            Submit (sl & item . price .~ 1),
+            SaveWash "A" (sl & item . price .~ 1),
+            Result (Wash <$> (sl & item . price .~ 1)),
+            SubmitEnd,
+            SawAction (Buy <$> b2),
+            AddEvent
+              ( Opened True
+                  <$> ( b2 & item . details
+                          <>~ [Washed 1]
+                      )
+              ),
+            Result
+              ( Buy
+                  <$> ( b2 & item . details
+                          <>~ [ Position Open,
+                                Washed 1
+                              ]
+                      )
+              )
+          ],
+          [ Buy <$> (b & item . details <>~ [Position Open]),
+            Sell
+              <$> ( sl & item . details
+                      <>~ [ Position Close,
+                            Loss 1
+                          ]
+                  ),
+            Wash <$> (sl & item . price .~ 1),
+            Buy
+              <$> ( b2 & item . details
+                      <>~ [ Position Open,
+                            Washed 1
+                          ]
+                  )
+          ]
+        )
+
+buyBuySellLoss :: Property
+buyBuySellLoss = property $ do
+  b <- forAll $ genTimed genLot
+  let s = b
+      sl = s & item . price -~ 1
+  -- A buy, a buy and then a sell at a loss
+  lift $
+    processActionsWithChanges
+      [ Buy <$> b,
+        Buy <$> b,
+        Sell <$> sl
+      ]
+      @?== Right
+        ( [ SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Buy <$> b),
+            AddEvent (Opened True <$> b),
+            Result (Buy <$> (b & item . details <>~ [Position Open])),
+            SawAction (Sell <$> sl),
+            Result
+              ( Sell
+                  <$> ( sl & item . details
+                          <>~ [Position Close, Loss 1]
+                      )
+              ),
+            RemoveEvent 1,
+            Submit (sl & item . price .~ 1),
+            RemoveEvent 2,
+            AddEvent
+              ( Opened True
+                  <$> ( b & item . details
+                          <>~ [Washed 1]
+                      )
+              ),
+            Result
+              ( Wash
+                  <$> ( b & item . price .~ 1
+                          & item . details <>~ [Washed (b ^. item . price)]
+                      )
+              ),
+            SubmitEnd
+          ],
+          [ Buy <$> (b & item . details <>~ [Position Open]),
+            Buy <$> (b & item . details <>~ [Position Open]),
+            Sell
+              <$> (sl & item . details <>~ [Position Close, Loss 1]),
+            Wash
+              <$> ( b & item . price .~ 1
+                      & item . details <>~ [Washed (b ^. item . price)]
+                  )
+          ]
+        )
+
+simpleSell :: Property
+simpleSell = property $ do
+  s <- forAll $ genTimed genLot
+  -- A simple sell
+  lift $
+    processActionsWithChanges
+      [Sell <$> s]
+      @?== Right
+        ( [ SawAction (Sell <$> s),
+            AddEvent (Opened False <$> s),
+            Result (Sell <$> (s & item . details <>~ [Position Open]))
+          ],
+          [Sell <$> (s & item . details <>~ [Position Open])]
+        )
+
+sellBuyProfit :: Property
+sellBuyProfit = property $ do
+  b <- forAll $ genTimed genLot
+  let s = b
+  -- A sell and buy at a profit
+  lift $
+    processActionsWithChanges
+      [ Sell <$> s,
+        Buy <$> b
+      ]
+      @?== Right
+        ( [ SawAction (Sell <$> s),
+            AddEvent (Opened False <$> s),
+            Result (Sell <$> (s & item . details <>~ [Position Open])),
+            SawAction (Buy <$> b),
+            Result
+              ( Buy
+                  <$> (b & item . details <>~ [Position Close, Gain 0])
+              ),
+            RemoveEvent 1
+          ],
+          [ Sell <$> (s & item . details <>~ [Position Open]),
+            Buy <$> (b & item . details <>~ [Position Close, Gain 0])
+          ]
+        )
diff --git a/trade-journal.cabal b/trade-journal.cabal
new file mode 100644
--- /dev/null
+++ b/trade-journal.cabal
@@ -0,0 +1,109 @@
+cabal-version: 1.12
+
+-- This file has been generated from package.yaml by hpack version 0.34.2.
+--
+-- see: https://github.com/sol/hpack
+--
+-- hash: bcab8d5bdeae3d554c45f80204fd191d5ad66fc5bcca8615b115e202dd2787cd
+
+name:           trade-journal
+version:        0.0.1
+description:    Command-line reporting utility for processing trade journals.
+author:         John Wiegley
+maintainer:     johnw@newartisans.com
+license:        BSD3
+license-file:   LICENSE
+build-type:     Simple
+
+library
+  exposed-modules:
+      Journal.Amount
+      Journal.Model
+      Journal.Parse
+      Journal.Split
+      Journal.ThinkOrSwim
+      Journal.Types
+      Journal.Utils
+  other-modules:
+      Paths_trade_journal
+  hs-source-dirs:
+      src
+  c-sources:
+      src/Journal/mpfr_printf.c
+  extra-libraries:
+      mpfr
+      gmp
+  build-depends:
+      aeson
+    , base >=4.5 && <5.0
+    , bytestring
+    , cassava
+    , containers
+    , data-default
+    , lens
+    , megaparsec
+    , mtl
+    , pretty
+    , pretty-show
+    , profunctors
+    , split
+    , text
+    , time
+    , transformers
+    , unordered-containers
+    , vector
+  default-language: Haskell2010
+
+executable trade-journal
+  main-is: Main.hs
+  other-modules:
+      Options
+  build-depends:
+      aeson
+    , base >=4.5 && <5.0
+    , bytestring
+    , cassava
+    , containers
+    , lens
+    , megaparsec
+    , mtl
+    , optparse-applicative
+    , pretty-show
+    , text
+    , time
+    , trade-journal
+    , transformers
+    , unordered-containers
+  default-language: Haskell2010
+
+test-suite trade-journal-tests
+  type: exitcode-stdio-1.0
+  main-is: Main.hs
+  other-modules:
+      Examples
+      ModelTests
+      Paths_trade_journal
+  hs-source-dirs:
+      test
+  build-depends:
+      HUnit
+    , aeson
+    , base >=4.5 && <5.0
+    , bytestring
+    , cassava
+    , containers
+    , hedgehog
+    , here
+    , lens
+    , megaparsec
+    , mtl
+    , pretty-show
+    , tasty
+    , tasty-hedgehog
+    , tasty-hunit
+    , text
+    , time
+    , trade-journal
+    , transformers
+    , unordered-containers
+  default-language: Haskell2010