module Graphics.PDF.Typesetting.WritingSystem(
WritingSystem(..)
, mapToSpecialGlyphs
) where
import qualified Data.Text as T
import Graphics.PDF.LowLevel.Types
import qualified Text.Hyphenation as H
import Data.List(intersperse)
import Data.Char
import Data.List(unfoldr)
data WritingSystem = Latin H.Hyphenator
| UnknownWritingSystem
myWords' :: T.Text -> Maybe (T.Text, T.Text)
myWords' :: Text -> Maybe (Text, Text)
myWords' Text
l | Text -> Bool
T.null Text
l = forall a. Maybe a
Nothing
| Bool
otherwise = if Text -> Bool
T.null Text
h then forall a. a -> Maybe a
Just (Text
h', Text
t') else forall a. a -> Maybe a
Just (Char -> Text
T.singleton Char
' ', Text
t)
where
(Text
h, Text
t) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isSpace Text
l
(Text
h', Text
t') = (Char -> Bool) -> Text -> (Text, Text)
T.span (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
l
myWords :: T.Text -> [T.Text]
myWords :: Text -> [Text]
myWords Text
l = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
onlyWord forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Text -> Maybe (Text, Text)
myWords' forall a b. (a -> b) -> a -> b
$ Text
l
where
onlyWord :: Text -> [Text]
onlyWord Text
s =
let (Text
w,Text
p) = (Char -> Bool) -> Text -> (Text, Text)
T.span Char -> Bool
isAlpha Text
s in
case (Text -> Bool
T.null Text
w,Text -> Bool
T.null Text
p) of
(Bool
True,Bool
True) -> []
(Bool
False,Bool
True) -> [Text
w]
(Bool
True,Bool
False) -> [Text
p]
(Bool
False,Bool
False) -> [Text
w,Text
p]
addHyphens :: H.Hyphenator -> T.Text -> T.Text
addHyphens :: Hyphenator -> Text -> Text
addHyphens Hyphenator
hn Text
f =
[Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.concat forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
"/-") forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
hyphenate) forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
myWords forall a b. (a -> b) -> a -> b
$ Text
f
where
hyphenate :: Text -> [Text]
hyphenate = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hyphenator -> String -> [String]
H.hyphenate Hyphenator
hn forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack
mapToSpecialGlyphs :: WritingSystem -> T.Text -> [SpecialChar]
mapToSpecialGlyphs :: WritingSystem -> Text -> [SpecialChar]
mapToSpecialGlyphs WritingSystem
UnknownWritingSystem Text
theText =
let getBreakingGlyphs :: String -> [SpecialChar]
getBreakingGlyphs (Char
' ':String
l) = SpecialChar
NormalSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
a:String
l) = Char -> SpecialChar
NormalChar Char
aforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs [] = []
in String -> [SpecialChar]
getBreakingGlyphs (Text -> String
T.unpack Text
theText)
mapToSpecialGlyphs (Latin Hyphenator
hn) Text
theText =
let getBreakingGlyphs :: String -> [SpecialChar]
getBreakingGlyphs [] = []
getBreakingGlyphs (Char
a:Char
'/':Char
'-':Char
d:String
l) = (Char -> SpecialChar
NormalChar Char
a)forall a. a -> [a] -> [a]
:SpecialChar
BreakingHyphenforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs (Char
dforall a. a -> [a] -> [a]
:String
l)
getBreakingGlyphs (Char
',':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
','forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
';':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
';'forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
'.':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
'.'forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
':':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
':'forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
'!':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
'!'forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
'?':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
'?'forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
' ':String
l) = SpecialChar
NormalSpaceforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
getBreakingGlyphs (Char
a:String
l) = Char -> SpecialChar
NormalChar Char
aforall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
in String -> [SpecialChar]
getBreakingGlyphs (Text -> String
T.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hyphenator -> Text -> Text
addHyphens Hyphenator
hn forall a b. (a -> b) -> a -> b
$ Text
theText)