---------------------------------------------------------
-- |
-- 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 = 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
 
 
-- | 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 = 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)