{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NoImplicitPrelude     #-}
{-# LANGUAGE StrictData            #-}
{-# LANGUAGE ViewPatterns          #-}

module Data.Raft.Log
  ( Log (..)
  -- Properties
  , lastEntryIndex
  , lastEntry
  , lastEntryReference
  -- Actions
  , append
  , commit
  , prune
  ) where

import qualified Data.Sequence    as Seq

import           Data.Raft.Entry
import           Data.Raft.Index
import           Data.Raft.Term
import           Data.RaftPrelude

data Log a
  = Log (Seq (Entry a)) CommittedEntryReference
  deriving (Show)

instance Default (Log a) where
  def = Log Seq.empty (EntryReference (Index 0) (Term 0))

class HasLog a e where
  log :: Lens' a (Log e)

-- Properties

instance HasCommitted (Log a) where
  committed f l@(Log _ (EntryReference idx _)) = fmap (\_ -> l) (f idx)

lastEntryIndex :: Lens' (Log a) Index
lastEntryIndex = lastEntryReference . index

lastEntry :: Log a -> Maybe (Entry a)
lastEntry (Log entries _) =
  case Seq.viewr entries of
    EmptyR     -> Nothing
    _ :> entry -> Just entry

instance HasLastEntryReference (Log a) where
  lastEntryReference f l@(Log entries committed) = fmap (\_ -> l) (f last)
    where
      last = case Seq.viewr entries of
               EmptyR     -> committed
               _ :> entry -> entry ^. entryReference

-- Handle Append

append :: PreviousEntryReference -> Seq (Entry a) -> Log a -> Maybe (Log a)
append prev@(EntryReference pidx pterm) entries (Log log' logCommit')
  | Seq.null entries = if prev == logCommit' then Just (Log log' logCommit') else Nothing
  | otherwise =
    flip Log logCommit' <$> (foldl' attach (Just alignedLog) entries)
  where
    (_, alignedLog) = Seq.breakr (\(Entry idx term _) -> idx == pidx && term == pterm) log'

    attach Nothing     _                    = Nothing
    attach (Just alog) new@(Entry idx' _ _) =
      case Seq.viewr alog of
        EmptyR ->
          if prev == logCommit'
          then Just (Seq.singleton new)
          else Nothing
        _ :> (Entry pidx' _ _) ->
          if idx' `distance` pidx' == 1
          then Just (alog Seq.|> new)
          else Nothing

-- Handle Commit

commit :: Index -> Log a -> Log a
commit idx (Log s oldRef)
  | idx < (oldRef ^. index) = Log s oldRef
  | otherwise =
    case findElemL (\(Entry eIdx _ _) -> idx == eIdx) s of
      Nothing ->
        case Seq.viewr s of
          EmptyR     -> Log s oldRef
          _ :> last' -> Log s (last' ^. entryReference)
      Just entry -> Log s (entry ^. entryReference)

findElemL :: (a -> Bool) -> Seq a -> Maybe a
findElemL _ (Seq.viewl -> EmptyL) = Nothing
findElemL f (Seq.viewl -> a :< s)
  | f a       = Just a
  | otherwise = findElemL f s
findElemL _ _ = Nothing -- This case will never occur, but GHC can't prove that.

-- Handle Prune

prune :: Log a -> (Seq (Entry a), Log a)
prune (Log s c) =
  let (pruned, remain) = Seq.spanl (\(Entry idx _ _) -> idx <= (c ^. index)) s
  in (pruned, Log remain c)
