1{-# LANGUAGE CPP #-}
2
3-----------------------------------------------------------------------------
4-- |
5-- Module      :  Text.Hyphenation.Exception
6-- Copyright   :  (C) 2012-2019 Edward Kmett
7-- License     :  BSD-style (see the file LICENSE)
8--
9-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
10-- Stability   :  provisional
11-- Portability :  portable
12--
13----------------------------------------------------------------------------
14module Text.Hyphenation.Exception
15  (
16  -- * Pattern file support
17    Exceptions
18  , addException
19  , lookupException
20  , scoreException
21  , parseExceptions
22  ) where
23
24import qualified Data.HashMap.Strict as HM
25import Prelude hiding (lookup)
26
27#if !(MIN_VERSION_base(4,8,0))
28import Data.Monoid (Monoid(..))
29#endif
30
31#if !(MIN_VERSION_base(4,11,0))
32import Data.Semigroup (Semigroup(..))
33#endif
34
35-- | Hyphenation exceptions are special cases that should use the specified hyphenation points.
36newtype Exceptions = Exceptions (HM.HashMap String [Int])
37  deriving Show
38
39zipMin :: [Int] -> [Int] -> [Int]
40zipMin (x:xs) (y:ys) = min x y : zipMin xs ys
41zipMin _ _ = []
42
43-- | Exceptions permit an exact list of hyphenation locations
44-- but merging exceptions is used to restrict the set when both contain the same word
45instance Semigroup Exceptions where
46  Exceptions m <> Exceptions n = Exceptions (HM.unionWith zipMin m n)
47
48-- | Exceptions permit an exact list of hyphenation locations
49-- but merging exceptions is used to restrict the set when both contain the same word
50instance Monoid Exceptions where
51  mempty = Exceptions mempty
52#if !(MIN_VERSION_base(4,11,0))
53  mappend = (<>)
54#endif
55
56-- | add an exception to the exception table.
57-- if it is already present, this will restrict the set of hyphenations to the
58-- intersection of the set provided and the set present.
59addException :: String -> Exceptions -> Exceptions
60addException s (Exceptions m) = Exceptions $
61  HM.insertWith zipMin (filter (/= '-') s) (scoreException s) m
62
63-- | Try to find a matching hyphenation exception.
64lookupException :: String -> Exceptions -> Maybe [Int]
65lookupException s (Exceptions m) = HM.lookup s m
66
67-- | Convert an exception string to a score.
68scoreException :: String -> [Int]
69scoreException []         = [0]
70scoreException (x:ys)
71  | x == '-'  = 1 : if null ys then [] else scoreException (tail ys)
72  | otherwise = 0 : scoreException ys
73
74-- | Parse one exception per line from an input string
75parseExceptions :: String -> Exceptions
76parseExceptions = foldr addException mempty . lines
77