{-# LANGUAGE CPP              #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TemplateHaskell  #-}

-- | Internal stream related functions.
--   These are exported because they're tested like this.
--   It's not expected a user would need this.
module Codec.Xlsx.Writer.Internal.Stream
  ( upsertSharedString
  , initialSharedString
  , string_map
  , SharedStringState(..)
  ) where


#ifdef USE_MICROLENS
import Lens.Micro.Platform
#else
import Control.Lens
#endif
import Control.Monad.State.Strict
import Data.Map.Strict (Map)
import Data.Maybe
import Data.Text (Text)

newtype SharedStringState = MkSharedStringState
  { SharedStringState -> Map Text Int
_string_map :: Map Text Int
  }
makeLenses 'MkSharedStringState

initialSharedString :: SharedStringState
initialSharedString :: SharedStringState
initialSharedString = Map Text Int -> SharedStringState
MkSharedStringState forall a. Monoid a => a
mempty

-- properties:
-- for a list of [text], every unique text gets a unique number.
upsertSharedString :: MonadState SharedStringState m => Text -> m (Text,Int)
upsertSharedString :: forall (m :: * -> *).
MonadState SharedStringState m =>
Text -> m (Text, Int)
upsertSharedString Text
current = do
  Map Text Int
strings  <- forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Iso' SharedStringState (Map Text Int)
string_map

  let mIdx :: Maybe Int
      mIdx :: Maybe Int
mIdx = Map Text Int
strings forall s a. s -> Getting (First a) s a -> Maybe a
^? forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Text
current

      idx :: Int
      idx :: Int
idx = forall a. a -> Maybe a -> a
fromMaybe (forall (t :: * -> *) a. Foldable t => t a -> Int
length Map Text Int
strings) Maybe Int
mIdx

      newMap :: Map Text Int
      newMap :: Map Text Int
newMap = forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
current forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
idx forall a b. (a -> b) -> a -> b
$ Map Text Int
strings

  Iso' SharedStringState (Map Text Int)
string_map forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Map Text Int
newMap
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
current, Int
idx)