{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}

-- |
module Language.IPA.QQ
    ( -- * IPA
      syllable
    , segment
    , syllables
      -- * X-SAMPA
    , segmentXS
    , syllableXS
    , syllablesXS
    ) where

import           Control.Exception          ( displayException )

import           Data.Text                  ( Text )
import qualified Data.Text                  as T

import           Language.Haskell.TH.Quote  ( QuasiQuoter(..) )
import           Language.Haskell.TH.Syntax ( Lift(lift) )
import           Language.IPA.Parser
                 ( parseSegment
                 , parseSegmentXSampa
                 , parseSyllable
                 , parseSyllableXSampa
                 , parseSyllables
                 , parseSyllablesXSampa
                 )
import           Language.IPA.Types         ( IPAException )

-- | Construct a compile-time 'Language.IPA.Types.Segment' using IPA notation
--
-- >>> [segment|ɣ|]
-- Consonant (Pulmonic Voiced Velar (Fricative NonSibilant))
segment :: QuasiQuoter
segment :: QuasiQuoter
segment = (Text -> Either IPAException Segment) -> QuasiQuoter
forall a. Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ Text -> Either IPAException Segment
parseSegment

-- | Construct a compile-time 'Language.IPA.Types.Syllable' using IPA notation
--
-- >>> [syllable|ɣa˧˨|]
-- WithSuprasegmentalFeature (LexicalToneContour LowFalling)
--   (Syllable [ Consonant (Pulmonic Voiced Velar (Fricative NonSibilant))
--             , Vowel (Pure Open Front Unrounded)
--             ])
syllable :: QuasiQuoter
syllable :: QuasiQuoter
syllable = (Text -> Either IPAException (Syllable [])) -> QuasiQuoter
forall a. Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ (MultiSegment [] => Text -> Either IPAException (Syllable [])
forall (t :: * -> *).
MultiSegment t =>
Text -> Either IPAException (Syllable t)
parseSyllable @[])

-- | Construct a compile-time @['Language.IPA.Types.Syllable']@ using IPA notation
syllables :: QuasiQuoter
syllables :: QuasiQuoter
syllables = (Text -> Either IPAException [Syllable []]) -> QuasiQuoter
forall a. Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ ((MultiSegment [], Monoid [Syllable []]) =>
Text -> Either IPAException [Syllable []]
forall (t :: * -> *).
(MultiSegment t, Monoid (t (Syllable t))) =>
Text -> Either IPAException (t (Syllable t))
parseSyllables @[])

-- | Construct a compile-time 'Language.IPA.Types.Segment' using X-SAMPA notation.
-- This may be more convenient than using text values - X-SAMPA inexplicably chose
-- to use backslashes as semantic tokens, which of course must be escaped
--
-- >>> [segmentXS|?\|]
-- Consonant (Pulmonic Voiced Pharyngeal (Fricative NonSibilant))
segmentXS :: QuasiQuoter
segmentXS :: QuasiQuoter
segmentXS = (Text -> Either IPAException Segment) -> QuasiQuoter
forall a. Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ Text -> Either IPAException Segment
parseSegmentXSampa

-- | Construct a compile-time 'Language.IPA.Types.Syllable' using X-SAMPA notation
syllableXS :: QuasiQuoter
syllableXS :: QuasiQuoter
syllableXS = (Text -> Either IPAException (Syllable [])) -> QuasiQuoter
forall a. Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ (MultiSegment [] => Text -> Either IPAException (Syllable [])
forall (t :: * -> *).
MultiSegment t =>
Text -> Either IPAException (Syllable t)
parseSyllableXSampa @[])

-- | Construct a compile-time @['Language.IPA.Types.Syllable']@ using
-- X-SAMPA notation
syllablesXS :: QuasiQuoter
syllablesXS :: QuasiQuoter
syllablesXS = (Text -> Either IPAException [Syllable []]) -> QuasiQuoter
forall a. Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ ((MultiSegment [], Monoid [Syllable []]) =>
Text -> Either IPAException [Syllable []]
forall (t :: * -> *).
(MultiSegment t, Monoid (t (Syllable t))) =>
Text -> Either IPAException (t (Syllable t))
parseSyllablesXSampa @[])

liftQQ :: Lift a => (Text -> Either IPAException a) -> QuasiQuoter
liftQQ :: (Text -> Either IPAException a) -> QuasiQuoter
liftQQ Text -> Either IPAException a
f = QuasiQuoter :: (String -> Q Exp)
-> (String -> Q Pat)
-> (String -> Q Type)
-> (String -> Q [Dec])
-> QuasiQuoter
QuasiQuoter { String -> Q [Dec]
String -> Q Exp
String -> Q Pat
String -> Q Type
forall (m :: * -> *) p a. MonadFail m => p -> m a
quoteExp :: String -> Q Exp
quotePat :: String -> Q Pat
quoteDec :: String -> Q [Dec]
quoteType :: String -> Q Type
quoteDec :: forall (m :: * -> *) p a. MonadFail m => p -> m a
quoteType :: forall (m :: * -> *) p a. MonadFail m => p -> m a
quotePat :: forall (m :: * -> *) p a. MonadFail m => p -> m a
quoteExp :: String -> Q Exp
.. }
  where
    quoteExp :: String -> Q Exp
quoteExp String
str = (IPAException -> Q Exp)
-> (a -> Q Exp) -> Either IPAException a -> Q Exp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Q Exp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Q Exp)
-> (IPAException -> String) -> IPAException -> Q Exp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IPAException -> String
forall e. Exception e => e -> String
displayException) a -> Q Exp
forall t. Lift t => t -> Q Exp
lift (Text -> Either IPAException a
f (Text -> Either IPAException a) -> Text -> Either IPAException a
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack String
str)

    quotePat :: p -> m a
quotePat p
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMsg

    quoteType :: p -> m a
quoteType p
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMsg

    quoteDec :: p -> m a
quoteDec p
_ = String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
errorMsg

    errorMsg :: String
errorMsg     = String
"Unsupported"