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

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

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

                                 (\String
x String
y -> Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
y) (String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
x)) ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
ligs
        buildChain :: [String] -> Parser Text Text
buildChain []     = Text -> Parser Text 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 Text
parseLigature String
x -- try to parse with the first parsers in the chain first

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

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