--------------------------------------------------------------------------------
-- |
--
-- Module      :  Data.Memoizer.Commands
-- Description :  A memoizer for sequences of commands
-- Copyright   :  (c) Alice Rixte 2024
-- License     :  BSD 3
-- Maintainer  :  alice.rixte@u-bordeaux.fr
-- Stability   :  unstable
-- Portability :  portable
--
-- A data structure to memoize the result of the execution of a sequence of
-- commands.
--
-- As long as the sequence of commands is identical to the one memoized, we can
-- avoid executing them. As soon as there is one command that differs from the
-- memoized sequence, then we should discard all remaining memoized results.
--
-- = Usage
--
--
-- Let's store the result of some commands (we alternate between @memo@ and
-- @memo'@ to avoid recursive definitions)
--
-- >>> import Prelude hiding (lookup)
-- >>> memo' = storeResult "x=1" "" empty :: CmdMemoizer String String
-- >>> memo = storeResult "y=2" "" memo'
-- >>> memo' = storeResult "x+y" "3" memo
--
--
--
-- Suppose there are no more commands in the sequence. Now we want to execute
-- that sequence of commands again but some commands may have changed in
-- between. We use memoized commands as long as all commands are equal to the
-- previous ones:
--
-- >>> memo = restart memo'
-- >>> lookup "x=1" memo
-- Just ""
--
-- Since the command was memoized, we avoid executing is again. Now suppose the command @"y=2"@ was replaced by @"y=3"@
--
-- >>> memo' = nextCmd memo
-- >>> lookup "y=3" memo'
-- Nothing
--
-- Since the command was not memoized, we have to execute it:
--
-- >>> memo = storeResult "y=3" "" memo'
--
-- Now none of the subsequent commands will use the memoized version:
--
-- >>> memo' = nextCmd memo
-- >>> lookup "x+y" memo'
-- Nothing
--
--------------------------------------------------------------------------------

module Data.Memoizer.Commands
  ( CmdMemoizer
  , empty
  , storeResult
  , deleteResult
  , lookup
  , restart
  , nextCmd
  )
where


import Prelude hiding (lookup)

import qualified Data.IntMap as Map

-- | A container for the memoized result of the execution of a sequence of
-- commands
--
-- * @a@ is the type of commands
-- * @b@ is the type of results
--
data CmdMemoizer a b = CmdMemoizer
  { forall a b. CmdMemoizer a b -> IntMap (a, b)
memoizerMap :: Map.IntMap (a,b)
  , forall a b. CmdMemoizer a b -> Int
currentIndex :: Int
  , forall a b. CmdMemoizer a b -> Bool
foundModif :: Bool
  }
  deriving (Int -> CmdMemoizer a b -> ShowS
[CmdMemoizer a b] -> ShowS
CmdMemoizer a b -> String
(Int -> CmdMemoizer a b -> ShowS)
-> (CmdMemoizer a b -> String)
-> ([CmdMemoizer a b] -> ShowS)
-> Show (CmdMemoizer a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall a b. (Show a, Show b) => Int -> CmdMemoizer a b -> ShowS
forall a b. (Show a, Show b) => [CmdMemoizer a b] -> ShowS
forall a b. (Show a, Show b) => CmdMemoizer a b -> String
$cshowsPrec :: forall a b. (Show a, Show b) => Int -> CmdMemoizer a b -> ShowS
showsPrec :: Int -> CmdMemoizer a b -> ShowS
$cshow :: forall a b. (Show a, Show b) => CmdMemoizer a b -> String
show :: CmdMemoizer a b -> String
$cshowList :: forall a b. (Show a, Show b) => [CmdMemoizer a b] -> ShowS
showList :: [CmdMemoizer a b] -> ShowS
Show, CmdMemoizer a b -> CmdMemoizer a b -> Bool
(CmdMemoizer a b -> CmdMemoizer a b -> Bool)
-> (CmdMemoizer a b -> CmdMemoizer a b -> Bool)
-> Eq (CmdMemoizer a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall a b.
(Eq a, Eq b) =>
CmdMemoizer a b -> CmdMemoizer a b -> Bool
$c== :: forall a b.
(Eq a, Eq b) =>
CmdMemoizer a b -> CmdMemoizer a b -> Bool
== :: CmdMemoizer a b -> CmdMemoizer a b -> Bool
$c/= :: forall a b.
(Eq a, Eq b) =>
CmdMemoizer a b -> CmdMemoizer a b -> Bool
/= :: CmdMemoizer a b -> CmdMemoizer a b -> Bool
Eq)

-- | Memoizer of an empty sequence of commands
--
empty :: CmdMemoizer a b
empty :: forall a b. CmdMemoizer a b
empty = IntMap (a, b) -> Int -> Bool -> CmdMemoizer a b
forall a b. IntMap (a, b) -> Int -> Bool -> CmdMemoizer a b
CmdMemoizer IntMap (a, b)
forall a. IntMap a
Map.empty Int
0 Bool
False

-- | Restart the sequence of commands
--
-- Memoized results will now be accessible until @'storeResult'@ or
-- @'deleteResult'@ are used.
--
restart :: CmdMemoizer a b -> CmdMemoizer a b
restart :: forall a b. CmdMemoizer a b -> CmdMemoizer a b
restart CmdMemoizer a b
m = CmdMemoizer a b
m {currentIndex = 0, foundModif = False}


-- | Store the result of the execution of a command.
--
-- This will override the current memoized command, and prevent access to
-- any memoized result until @'restart'@ is used.
--
storeResult :: a -> b -> CmdMemoizer a b -> CmdMemoizer a b
storeResult :: forall a b. a -> b -> CmdMemoizer a b -> CmdMemoizer a b
storeResult a
a b
b (CmdMemoizer IntMap (a, b)
m Int
i Bool
_) =
  IntMap (a, b) -> Int -> Bool -> CmdMemoizer a b
forall a b. IntMap (a, b) -> Int -> Bool -> CmdMemoizer a b
CmdMemoizer (Int -> (a, b) -> IntMap (a, b) -> IntMap (a, b)
forall a. Int -> a -> IntMap a -> IntMap a
Map.insert Int
i (a
a,b
b) IntMap (a, b)
m) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
True

-- | Delete the result of the current memoized command.
--
-- This will override the current memoized command, and prevent access to any
-- memoized result until @'restart'@ is used.
--
deleteResult :: CmdMemoizer a b -> CmdMemoizer a b
deleteResult :: forall a b. CmdMemoizer a b -> CmdMemoizer a b
deleteResult (CmdMemoizer IntMap (a, b)
m Int
i Bool
_) = IntMap (a, b) -> Int -> Bool -> CmdMemoizer a b
forall a b. IntMap (a, b) -> Int -> Bool -> CmdMemoizer a b
CmdMemoizer (Int -> IntMap (a, b) -> IntMap (a, b)
forall a. Int -> IntMap a -> IntMap a
Map.delete Int
i IntMap (a, b)
m) (Int
iInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) Bool
True


-- | Access the memoized result of a command if it is equal to the current
-- memoized command
--
lookup :: Eq a => a -> CmdMemoizer a b -> Maybe b
lookup :: forall a b. Eq a => a -> CmdMemoizer a b -> Maybe b
lookup a
a (CmdMemoizer IntMap (a, b)
m Int
i Bool
modif) =
  if Bool
modif then
    Maybe b
forall a. Maybe a
Nothing
  else
    case Int -> IntMap (a, b) -> Maybe (a, b)
forall a. Int -> IntMap a -> Maybe a
Map.lookup Int
i IntMap (a, b)
m of
      Maybe (a, b)
Nothing -> Maybe b
forall a. Maybe a
Nothing
      Just (a
a', b
b) ->
        if a
a a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
a' then
          b -> Maybe b
forall a. a -> Maybe a
Just b
b
        else
          Maybe b
forall a. Maybe a
Nothing

-- | Move to the next memoized command
--
nextCmd :: CmdMemoizer a b -> CmdMemoizer a b
nextCmd :: forall a b. CmdMemoizer a b -> CmdMemoizer a b
nextCmd CmdMemoizer a b
m = CmdMemoizer a b
m {currentIndex = currentIndex m + 1 }