{-# LANGUAGE CPP #-}

-----------------------------------------------------------------------------
-- |
-- Module      :  Text.Hyphenation.Exception
-- Copyright   :  (C) 2012-2019 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
----------------------------------------------------------------------------
module Text.Hyphenation.Exception
  (
  -- * Pattern file support
    Exceptions
  , addException
  , lookupException
  , scoreException
  , parseExceptions
  ) where

import qualified Data.HashMap.Strict as HM
import Prelude hiding (lookup)

#if !(MIN_VERSION_base(4,8,0))
import Data.Monoid (Monoid(..))
#endif

#if !(MIN_VERSION_base(4,11,0))
import Data.Semigroup (Semigroup(..))
#endif

-- | Hyphenation exceptions are special cases that should use the specified hyphenation points.
newtype Exceptions = Exceptions (HM.HashMap String [Int])
  deriving Int -> Exceptions -> ShowS
[Exceptions] -> ShowS
Exceptions -> String
(Int -> Exceptions -> ShowS)
-> (Exceptions -> String)
-> ([Exceptions] -> ShowS)
-> Show Exceptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Exceptions] -> ShowS
$cshowList :: [Exceptions] -> ShowS
show :: Exceptions -> String
$cshow :: Exceptions -> String
showsPrec :: Int -> Exceptions -> ShowS
$cshowsPrec :: Int -> Exceptions -> ShowS
Show

zipMin :: [Int] -> [Int] -> [Int]
zipMin :: [Int] -> [Int] -> [Int]
zipMin (Int
x:[Int]
xs) (Int
y:[Int]
ys) = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
x Int
y Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: [Int] -> [Int] -> [Int]
zipMin [Int]
xs [Int]
ys
zipMin [Int]
_ [Int]
_ = []

-- | Exceptions permit an exact list of hyphenation locations
-- but merging exceptions is used to restrict the set when both contain the same word
instance Semigroup Exceptions where
  Exceptions HashMap String [Int]
m <> :: Exceptions -> Exceptions -> Exceptions
<> Exceptions HashMap String [Int]
n = HashMap String [Int] -> Exceptions
Exceptions (([Int] -> [Int] -> [Int])
-> HashMap String [Int]
-> HashMap String [Int]
-> HashMap String [Int]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> HashMap k v -> HashMap k v -> HashMap k v
HM.unionWith [Int] -> [Int] -> [Int]
zipMin HashMap String [Int]
m HashMap String [Int]
n)

-- | Exceptions permit an exact list of hyphenation locations
-- but merging exceptions is used to restrict the set when both contain the same word
instance Monoid Exceptions where
  mempty :: Exceptions
mempty = HashMap String [Int] -> Exceptions
Exceptions HashMap String [Int]
forall a. Monoid a => a
mempty
#if !(MIN_VERSION_base(4,11,0))
  mappend = (<>)
#endif

-- | add an exception to the exception table.
-- if it is already present, this will restrict the set of hyphenations to the
-- intersection of the set provided and the set present.
addException :: String -> Exceptions -> Exceptions
addException :: String -> Exceptions -> Exceptions
addException String
s (Exceptions HashMap String [Int]
m) = HashMap String [Int] -> Exceptions
Exceptions (HashMap String [Int] -> Exceptions)
-> HashMap String [Int] -> Exceptions
forall a b. (a -> b) -> a -> b
$
  ([Int] -> [Int] -> [Int])
-> String -> [Int] -> HashMap String [Int] -> HashMap String [Int]
forall k v.
(Eq k, Hashable k) =>
(v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
HM.insertWith [Int] -> [Int] -> [Int]
zipMin ((Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-') String
s) (String -> [Int]
scoreException String
s) HashMap String [Int]
m

-- | Try to find a matching hyphenation exception.
lookupException :: String -> Exceptions -> Maybe [Int]
lookupException :: String -> Exceptions -> Maybe [Int]
lookupException String
s (Exceptions HashMap String [Int]
m) = String -> HashMap String [Int] -> Maybe [Int]
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HM.lookup String
s HashMap String [Int]
m

-- | Convert an exception string to a score.
scoreException :: String -> [Int]
scoreException :: String -> [Int]
scoreException []         = [Int
0]
scoreException (Char
x:String
ys)
  | Char
x Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-'  = Int
1 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
ys then [] else String -> [Int]
scoreException (ShowS
forall a. [a] -> [a]
tail String
ys)
  | Bool
otherwise = Int
0 Int -> [Int] -> [Int]
forall a. a -> [a] -> [a]
: String -> [Int]
scoreException String
ys

-- | Parse one exception per line from an input string
parseExceptions :: String -> Exceptions
parseExceptions :: String -> Exceptions
parseExceptions = (String -> Exceptions -> Exceptions)
-> Exceptions -> [String] -> Exceptions
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr String -> Exceptions -> Exceptions
addException Exceptions
forall a. Monoid a => a
mempty ([String] -> Exceptions)
-> (String -> [String]) -> String -> Exceptions
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines