module Codec.Xlsx.Types.SharedStringTable (
SharedStringTable(..)
, StringItem(..)
, sstConstruct
, sstLookupText
, sstLookupRich
, sstItem
, sharedStringTable
) where
import Control.Lens hiding (element)
import Control.Monad
import Data.Maybe (mapMaybe)
import Data.Text (Text)
import Data.Vector (Vector)
import Numeric.Search.Range (searchFromTo)
import Text.XML
import Text.XML.Cursor
import qualified Data.Map as Map
import qualified Data.Set as Set
import qualified Data.Vector as V
import Codec.Xlsx.Parser.Internal
import Codec.Xlsx.Types
import Codec.Xlsx.Writer.Internal
data SharedStringTable = SharedStringTable {
_sharedStringTable :: Vector StringItem
}
deriving (Show, Eq, Ord)
data StringItem =
StringItemText Text
| StringItemRich [RichTextRun]
deriving (Show, Eq, Ord)
makeLenses ''SharedStringTable
instance ToDocument SharedStringTable where
toDocument = documentFromElement "Shared string table generated by xlsx"
. toElement "sst"
instance ToElement SharedStringTable where
toElement nm SharedStringTable{..} = Element {
elementName = nm
, elementAttributes = Map.empty
, elementNodes = map (NodeElement . toElement "si")
$ V.toList _sharedStringTable
}
instance ToElement StringItem where
toElement nm si = Element {
elementName = nm
, elementAttributes = Map.empty
, elementNodes = map NodeElement $
case si of
StringItemText text -> [elementContent "t" text]
StringItemRich rich -> map (toElement "r") rich
}
instance FromCursor SharedStringTable where
fromCursor cur = do
let
items = cur $/ element (n"si") >=> fromCursor
return (SharedStringTable (V.fromList items))
instance FromCursor StringItem where
fromCursor cur = do
let
ts = cur $/ element (n"t") >=> contentOrEmpty
contentOrEmpty c = case c $/ content of
[t] -> [t]
[] -> [""]
_ -> error "invalid item: more than one text nodes under <t>!"
rs = cur $/ element (n"r") >=> fromCursor
case (ts,rs) of
([t], []) ->
return $ StringItemText t
([], _:_) ->
return $ StringItemRich rs
_ ->
fail "invalid item"
sstConstruct :: [Worksheet] -> SharedStringTable
sstConstruct =
SharedStringTable . V.fromList . uniq . concatMap goSheet
where
goSheet :: Worksheet -> [StringItem]
goSheet = mapMaybe (_cellValue >=> sstEntry) . Map.elems . _wsCells
sstEntry :: CellValue -> Maybe StringItem
sstEntry (CellText text) = Just $ StringItemText text
sstEntry (CellRich rich) = Just $ StringItemRich rich
sstEntry _ = Nothing
uniq :: Ord a => [a] -> [a]
uniq = Set.elems . Set.fromList
sstLookupText :: SharedStringTable -> Text -> Int
sstLookupText sst = sstLookup sst . StringItemText
sstLookupRich :: SharedStringTable -> [RichTextRun] -> Int
sstLookupRich sst = sstLookup sst . StringItemRich
sstLookup :: SharedStringTable -> StringItem -> Int
sstLookup SharedStringTable{_sharedStringTable = shared} si =
case searchFromTo (\p -> shared V.! p >= si) 0 (V.length shared 1) of
Just i -> i
Nothing -> error $ "SST entry for " ++ show si ++ " not found"
sstItem :: SharedStringTable -> Int -> StringItem
sstItem SharedStringTable{_sharedStringTable = shared} = (V.!) shared