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
_ -> []
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) )
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
(\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
"")
buildChain [String
x] = String -> Parser Text
parseLigature String
x
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
forall (m :: * -> *) a. Monad m => a -> m a
return (Char -> Text
T.singleton Char
c)