module Diagrams.SVG.Fonts.CharReference (charsFromFullName, characterStrings) where
import Control.Applicative ((<|>), many)
import Data.Attoparsec.Text
import qualified Data.Text as T
import Data.List (sortBy)

charRef :: Parser Int
charRef :: Parser Int
charRef
    = do
      Text
_ <- forall i a. Parser i a -> Parser i a
try (Text -> Parser Text
string (String -> Text
T.pack String
"&#x"))
      Int
d <- forall a. (Integral a, Bits a) => Parser a
hexadecimal
      Char
_ <- Char -> Parser Char
char Char
';'
      forall (m :: * -> *) a. Monad m => a -> m a
return Int
d
 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  do
      Text
_ <- forall i a. Parser i a -> Parser i a
try (Text -> Parser Text
string (String -> Text
T.pack String
"&#"))
      Int
d <- forall a. Integral a => Parser a
decimal
      Char
_ <- Char -> Parser Char
char Char
';'
      forall (m :: * -> *) a. Monad m => a -> m a
return Int
d
 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|>  do
      Char
c <- Parser Char
anyChar
      forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Enum a => a -> Int
fromEnum Char
c)
      forall i a. Parser i a -> String -> Parser i a
<?> String
"character reference"

charRefs :: Parser [Int]
charRefs :: Parser [Int]
charRefs = do [Int]
l <- forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 Parser Int
charRef
              forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
l

fromCharRefs :: T.Text -> [Int]
fromCharRefs :: Text -> [Int]
fromCharRefs Text
str
  = case (forall a. Parser a -> Text -> Either String a
parseOnly Parser [Int]
charRefs Text
str) of
           Right [Int]
x -> [Int]
x
           Left String
_ -> []

-- | Parsing of xml character references.

--

--   I.e. \"\&\#x2e\;\&\#x2e\;\&\#x2e\;\" is converted into a list of three Chars.

--

--        \"ffb\" is also parsed and converted into three Chars (not changing it).

charsFromFullName :: String -> String
charsFromFullName :: String -> String
charsFromFullName String
str = forall a b. (a -> b) -> [a] -> [b]
map forall a. Enum a => Int -> a
toEnum ( Text -> [Int]
fromCharRefs (String -> Text
T.pack String
str) )


-- | A string represents a glyph, i.e. the ligature \"ffi\" is a string that represents the ligature glyph ffi

characterStrings :: String -> [String] -> [T.Text]
characterStrings :: String -> [String] -> [Text]
characterStrings String
str [String]
ligs | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
ligs = forall a b. (a -> b) -> [a] -> [b]
map ((String -> Text
T.pack)forall b c a. (b -> c) -> (a -> b) -> a -> c
.(\Char
x->[Char
x])) String
str
                          | Bool
otherwise = case forall a. Parser a -> Text -> Either String a
parseOnly Parser Text [Text]
myParser (String -> Text
T.pack String
str)
                                           of Right [Text]
x -> [Text]
x
                                              Left  String
_ -> []
  where myParser :: Parser Text [Text]
myParser = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (forall i a. Parser i a -> Parser i a
try Parser Text
ligatures forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser Text
charToText)
        ligatures :: Parser Text
ligatures = [String] -> Parser Text
buildChain forall a b. (a -> b) -> a -> b
$ forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy -- sort so that the longest ligatures come first, i.e. "ffi", "ff", ..

                                 (\String
x String
y -> forall a. Ord a => a -> a -> Ordering
compare (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
y) (forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x)) forall a b. (a -> b) -> a -> b
$ [String]
ligs
        buildChain :: [String] -> Parser Text
buildChain []     = Text -> Parser Text
string (String -> Text
T.pack String
"") -- will never be called, just to get rid of the warning message

        buildChain [String
x]    = String -> Parser Text
parseLigature String
x -- try to parse with the first parsers in the chain first

        buildChain (String
x:[String]
xs) = forall i a. Parser i a -> Parser i a
try (String -> Parser Text
parseLigature String
x) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> [String] -> Parser Text
buildChain [String]
xs
        parseLigature :: String -> Parser Text
parseLigature String
x = Text -> Parser Text
string (String -> Text
T.pack String
x)
        charToText :: Parser Text
charToText = do Char
c <- Parser Char
anyChar -- or accept a single char

                        forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text
T.singleton Char
c)