truncateHistory hist cntr =
    case hs_entry hist of
      HistoryRun tid c | c == cntr -> Right hist
                       | c < cntr ->
                           Left "truncate tried to extend history"
                       | otherwise ->
                           case stripNonRun (hs_parent hist) of
                             (HistoryRoot _) ->
                                 Right $ appendHistory (hs_parent hist) (HistoryRun tid cntr)
                             runParent ->
                                 case hs_entry runParent of
                                   HistoryRun _ c'
                                     | c' >= cntr ->
                                         truncateHistory runParent cntr
                                     | otherwise ->
                                         Right $ appendHistory (hs_parent hist) (HistoryRun tid cntr)
                                   _ -> error "stripNonRun misbehaving"
      _ ->
          case stripNonRun (hs_parent hist) of
            (HistoryRoot _) ->
                if cntr == (Finite $ AccessNr 0)
                then Right hist
                else Left "truncate history with only non-run entries"
            runParent ->
                case hs_entry runParent of
                  HistoryRun _ c'
                    | c' >= cntr ->
                        truncateHistory runParent cntr
                    | otherwise ->
                        Left "truncate tried to extend history (ends in non-run)"
                  _ -> error "stripNonRun misbehaving"
truncateHistory hist cntr =
    case hs_entry hist of
      HistoryRun tid c | c == cntr -> Right hist
                       | c < cntr ->
                           Left "truncate tried to extend history"
                       | otherwise ->
                           case stripNonRun (hs_parent hist) of
                             (HistoryRoot _) ->
                                 Right $ appendHistory (hs_parent hist) (HistoryRun tid cntr)
                             runParent ->
                                 case hs_entry runParent of
                                   HistoryRun _ c'
                                     | c' >= cntr ->
                                         truncateHistory runParent cntr
                                     | otherwise ->
                                         Right $ appendHistory (hs_parent hist) (HistoryRun tid cntr)
                                   _ -> error "stripNonRun misbehaving"
      _ ->
          case stripNonRun (hs_parent hist) of
            (HistoryRoot _) ->
                if cntr == (Finite $ AccessNr 0)
                then Right hist
                else Left "truncate history with only non-run entries"
            runParent ->
                case hs_entry runParent of
                  HistoryRun _ c'
                    | c' >= cntr ->
                        truncateHistory runParent cntr
                    | otherwise ->
                        Left "truncate tried to extend history (ends in non-run)"
                  _ -> error "stripNonRun misbehaving"
truncateHistory hist cntr =
    case hs_entry hist of
      HistoryRun tid c | c == cntr -> Right hist
                       | c < cntr ->
                           Left "truncate tried to extend history"
                       | otherwise ->
                           case stripNonRun (hs_parent hist) of
                             (HistoryRoot _) ->
                                 Right $ appendHistory (hs_parent hist) (HistoryRun tid cntr)
                             runParent ->
                                 case hs_entry runParent of
                                   HistoryRun _ c'
                                     | c' >= cntr ->
                                         truncateHistory runParent cntr
                                     | otherwise ->
                                         Right $ appendHistory (hs_parent hist) (HistoryRun tid cntr)
                                   _ -> error "stripNonRun misbehaving"
      _ ->
          case stripNonRun (hs_parent hist) of
            (HistoryRoot _) ->
                if cntr == (Finite $ AccessNr 0)
                then Right hist
                else Left "truncate history with only non-run entries"
            runParent ->
                case hs_entry runParent of
                  HistoryRun _ c'
                    | c' >= cntr ->
                        truncateHistory runParent cntr
                    | otherwise ->
                        Left "truncate tried to extend history (ends in non-run)"
                  _ -> error "stripNonRun misbehaving"