---------------------------------------------------------
-- |
-- Copyright   : (c) 2006-2016, alpheccar.org
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- PDF Font
---------------------------------------------------------
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 = Maybe (Text, Text)
forall a. Maybe a
Nothing
            | Bool
otherwise = if Text -> Bool
T.null Text
h then (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
h', Text
t') else (Text, Text) -> Maybe (Text, Text)
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 (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace) Text
l
 
 
-- | Split a sentence into words keeping the space but shortening them to 1 space
myWords :: T.Text -> [T.Text]     
myWords :: Text -> [Text]
myWords Text
l = (Text -> [Text]) -> [Text] -> [Text]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Text -> [Text]
onlyWord ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Maybe (Text, Text)) -> Text -> [Text]
forall b a. (b -> Maybe (a, b)) -> b -> [a]
unfoldr Text -> Maybe (Text, Text)
myWords' (Text -> [Text]) -> Text -> [Text]
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 ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map ([Text] -> Text
T.concat ([Text] -> Text) -> (Text -> [Text]) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
intersperse (String -> Text
T.pack String
"/-") ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
hyphenate) ([Text] -> [Text]) -> (Text -> [Text]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
myWords (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text
f
  where
    hyphenate :: Text -> [Text]
hyphenate = (String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> Text
T.pack ([String] -> [Text]) -> (Text -> [String]) -> Text -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hyphenator -> String -> [String]
H.hyphenate Hyphenator
hn (String -> [String]) -> (Text -> String) -> Text -> [String]
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
NormalSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l 
      getBreakingGlyphs (Char
a:String
l) = Char -> SpecialChar
NormalChar Char
aSpecialChar -> [SpecialChar] -> [SpecialChar]
forall 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)SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BreakingHyphenSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs (Char
dChar -> String -> String
forall a. a -> [a] -> [a]
:String
l)
      getBreakingGlyphs (Char
',':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
','SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
';':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
';'SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
'.':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
'.'SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
':':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
':'SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
'!':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
'!'SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
'?':Char
' ':String
l) = Char -> SpecialChar
NormalChar Char
'?'SpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:SpecialChar
BiggerSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
' ':String
l) = SpecialChar
NormalSpaceSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
      getBreakingGlyphs (Char
a:String
l) = Char -> SpecialChar
NormalChar Char
aSpecialChar -> [SpecialChar] -> [SpecialChar]
forall a. a -> [a] -> [a]
:String -> [SpecialChar]
getBreakingGlyphs String
l
  in String -> [SpecialChar]
getBreakingGlyphs (Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Hyphenator -> Text -> Text
addHyphens Hyphenator
hn (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Text
theText)