module Draw.NormalizeSvg (normalizeSvgFile) where



import           Control.Monad
import           Data.List.Extended
import           Data.Ord
import           Data.Text                       (Text)
import qualified Data.Text                       as T
import           Data.Text.AhoCorasick.Automaton as ACA
import qualified Data.Text.AhoCorasick.Replacer  as ACR
import qualified Data.Text.IO                    as T
import           System.FilePath
import           System.IO
import           Text.Regex.TDFA



-- | Cairo has nondeterministic output, since it seems to generate its running IDs from some shared counter.
-- This remedies that by renumbering all offending fields by time of occurrence in
-- the file.
normalizeSvgFile :: FilePath -> IO ()
normalizeSvgFile :: String -> IO ()
normalizeSvgFile String
filename = Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String -> String
takeExtension String
filename String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
".svg") (String -> (Text -> Text) -> IO ()
modifyFileContent String
filename Text -> Text
sanitizeSvgContent)

findAllMatches :: Text -> Text -> [Text]
findAllMatches :: Text -> Text -> [Text]
findAllMatches Text
input Text
regex = AllTextMatches [] Text -> [Text]
forall (f :: * -> *) b. AllTextMatches f b -> f b
getAllTextMatches (Text
input Text -> Text -> AllTextMatches [] Text
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ Text
regex)

modifyFileContent :: FilePath -> (Text -> Text) -> IO ()
modifyFileContent :: String -> (Text -> Text) -> IO ()
modifyFileContent String
filename Text -> Text
f = do
    Text
content <- String -> IOMode -> (Handle -> IO Text) -> IO Text
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
filename IOMode
ReadMode Handle -> IO Text
T.hGetContents
    String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
filename IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
h -> Handle -> Text -> IO ()
T.hPutStr Handle
h (Text -> Text
f Text
content)

-- This has terrible performance because it copies the input file once for each unique nondeterministic
-- string, ugh.
sanitizeSvgContent :: Text -> Text
sanitizeSvgContent :: Text -> Text
sanitizeSvgContent Text
input
  = let nondeterministicStrings :: [Text]
nondeterministicStrings = Text -> Text -> [Text]
findAllMatches Text
input (String -> Text
T.pack String
"(surface|mask|clip|glyph[0-9]+-)[0-9]+")
        uniques :: [Text]
uniques = [Text] -> [Text]
forall a. Ord a => [a] -> [a]
nubOrd [Text]
nondeterministicStrings
        uniquesNumbered :: [(Text, Integer)]
uniquesNumbered = [Text] -> [Integer] -> [(Text, Integer)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
uniques [Integer
1..]
        translationTable :: [(Text, Text)]
translationTable = [(Text
unique, String -> Text
T.pack (String
"id" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
i)) | (Text
unique, Integer
i) <- [(Text, Integer)]
uniquesNumbered]

        -- We reverse the originals so we replace foo123 before foo1, which would yield be a collision
        reverseTranslationTable :: [(Text, Text)]
reverseTranslationTable = ((Text, Text) -> Down Text) -> [(Text, Text)] -> [(Text, Text)]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (\(Text
unique, Text
_) -> Text -> Down Text
forall a. a -> Down a
Down Text
unique) [(Text, Text)]
translationTable

        replaceAll :: Text -> Text
replaceAll = Replacer -> Text -> Text
ACR.run (CaseSensitivity -> [(Text, Text)] -> Replacer
ACR.build CaseSensitivity
ACA.CaseSensitive [(Text, Text)]
reverseTranslationTable)
    in Text -> Text
replaceAll Text
input