Uid.hs

{- This file is part of razom-text-util.
 -
 - Written in 2015 by fr33domlover <fr33domlover@rel4tion.org>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

module Text.Razom.Uid
    ( uid
    , generator
    , escapeUid
    , unescapeUid
    )
where

import Data.Char (isSpace)
import Text.Razom.Char
import Text.Razom.Types
import Text.Regex.Applicative

uidcharp c = isGraphical c
          && not (isSpace c)
          && c /= '\\'
          && c /= '>'
uidfstp c  = uidcharp c && c /= '%'

uidopen  = sym '<'
uidclose = sym '>'

-- | Regex which matches and returns a Uid, unescaped and with delimiters
-- removed.
--
-- >>> match uid "<12<34\\>56\\\\7>"
-- Just "12<34>56\\7"
uid :: Regex String
uid = unescapeUid <$> (uidopen *> uidbody <* uidclose)
    where
    uidbody  = snd <$> withMatched (uidfirst <* many (mkpart uidcharp))
    uidfirst = Nothing <$ string "\\%" <|> Nothing <$ mkpart uidfstp
    mkpart p = Nothing <$ psym p
           <|> Nothing <$ string "\\\\"
           <|> Nothing <$ string "\\>"

-- | Regex which matches and returns a Uid generator, without delimiters and
-- the leading prefix character.
--
-- >>> match generator "<%>"
-- Just ""
--
-- >>> match generator "<%mylabel>"
-- Just "mylabel"
generator :: Regex String
generator = (:) <$> uidopen *> sym '%' *> many (psym uidcharp) <* uidclose

escapeUidChar :: Char -> String
escapeUidChar '\\' = "\\\\"
escapeUidChar '>'  = "\\>"
escapeUidChar c    = [c]

unescapeUidChar :: String -> (Char, String)
unescapeUidChar ('\\':c:cs) =
    case c of
        '\\' -> ('\\', cs)
        '>'  -> ('>',  cs)
        x    -> error $ "invalid escape sequence: \\" ++ [x]
unescapeUidChar (c:cs)   = (c, cs)
unescapeUidChar []       = error "empty string"

-- | Convert a Uid string into a form which can be put in a semantic document.
-- It doesn't add delimiters.
--
-- >>> escapeUid "1>2\\3"
-- "1\\>2\\\\3"
--
-- To prevent confusion, the above is the same as:
--
-- > ['1', '\\', '>', '2', '\\', '\\', '3']
escapeUid :: String -> String
escapeUid s =
    case s of
        ('%':cs) -> '\\' : '%' : f cs
        cs       -> f cs
    where
    f = foldr ((++) . escapeUidChar) ""

-- | Convert a Uid as encoded in a semantic document into normal form, i.e.
-- converting escape sequences to their target characters.
--
-- >>> unescapeUid "1\\>2\\\\3"
-- "1>2\\3"
unescapeUid :: String -> String
unescapeUid s =
    case s of
        []            -> []
        ('\\':'%':cs) -> '%' : f cs
        cs            -> f cs
    where
    f [] = []
    f s  = let (c, cs) = unescapeUidChar s in c : f cs