{-# 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 Map Text Int
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 :: Text -> m (Text, Int)
upsertSharedString Text
current = do
  Map Text Int
strings  <- Getting (Map Text Int) SharedStringState (Map Text Int)
-> m (Map Text Int)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Map Text Int) SharedStringState (Map Text Int)
Iso' SharedStringState (Map Text Int)
string_map

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

      idx :: Int
      idx :: Int
idx = Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe (Map Text Int -> Int
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 = Index (Map Text Int)
-> Lens' (Map Text Int) (Maybe (IxValue (Map Text Int)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Text
Index (Map Text Int)
current ((Maybe Int -> Identity (Maybe Int))
 -> Map Text Int -> Identity (Map Text Int))
-> Int -> Map Text Int -> Map Text Int
forall s t a b. ASetter s t a (Maybe b) -> b -> s -> t
?~ Int
idx (Map Text Int -> Map Text Int) -> Map Text Int -> Map Text Int
forall a b. (a -> b) -> a -> b
$ Map Text Int
strings

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