{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeApplications #-}
module Language.IPA.QQ
(
syllable
, segment
, syllables
, 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 )
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
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 @[])
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 @[])
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
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 @[])
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"