module Text.Numeral.Render
(
render
, Repr(..)
, ScaleRepr
, defaultRepr
, Ctx(..)
, posIndex
, isOutside
) where
import "base" Data.Monoid ( (<>) )
import "text" Data.Text ( Text )
import "this" Text.Numeral.Exp ( Exp(..), Side(L, R) )
import "this" Text.Numeral.Grammar ( Inflection(..) )
render :: Repr
-> Inflection
-> Exp
-> Maybe Text
render (Repr {..}) = go CtxEmpty
where
go _ _ Unknown = reprUnknown
go ctx inf (Lit n) = ($ ctx) <$> reprValue inf n
go ctx inf (Neg x) = do x' <- go (CtxNeg ctx) inf x
rn <- reprNeg
rnc <- reprNegCombine
Just $ rnc (rn x ctx) x' x
go ctx inf (Add x y) = do x' <- go (CtxAdd L y ctx) inf x
y' <- go (CtxAdd R x ctx) inf y
ra <- reprAdd
rac <- reprAddCombine
Just $ rac (ra x y ctx) x' x y' y
go ctx inf (Mul x y) = do x' <- go (CtxMul L y ctx) inf x
y' <- go (CtxMul R x ctx) inf y
rm <- reprMul
rmc <- reprMulCombine
Just $ rmc (rm x y ctx) x' x y' y
go ctx inf (Sub x y) = do x' <- go (CtxSub L y ctx) inf x
y' <- go (CtxSub R x ctx) inf y
rs <- reprSub
rsc <- reprSubCombine
Just $ rsc (rs x y ctx) x' x y' y
go ctx inf (Frac x y) = do x' <- go (CtxFrac L y ctx) inf x
y' <- go (CtxFrac R x ctx) inf y
rf <- reprFrac
rfc <- reprFracCombine
Just $ rfc (rf x y ctx) x' x y' y
go ctx inf (Scale b o r) = reprScale inf b o r ctx
go ctx inf (ChangeCase mbCase x) = go ctx (inf {iCase = mbCase }) x
go ctx inf (ChangeGender mbGender x) = go ctx (inf {iGender = mbGender}) x
go ctx inf (ChangeNumber mbNumber x) = go ctx (inf {iNumber = mbNumber}) x
data Repr =
Repr
{
reprUnknown :: Maybe Text
, reprValue :: Inflection -> Integer -> Maybe (Ctx Exp -> Text)
, reprNeg :: Maybe (Exp -> Ctx Exp -> Text)
, reprAdd :: Maybe (Exp -> Exp -> Ctx Exp -> Text)
, reprMul :: Maybe (Exp -> Exp -> Ctx Exp -> Text)
, reprSub :: Maybe (Exp -> Exp -> Ctx Exp -> Text)
, reprFrac :: Maybe (Exp -> Exp -> Ctx Exp -> Text)
, reprScale :: ScaleRepr
, reprNegCombine :: Maybe (Text -> Text -> Exp -> Text)
, reprAddCombine :: Maybe (Text -> Text -> Exp -> Text -> Exp -> Text)
, reprMulCombine :: Maybe (Text -> Text -> Exp -> Text -> Exp -> Text)
, reprSubCombine :: Maybe (Text -> Text -> Exp -> Text -> Exp -> Text)
, reprFracCombine :: Maybe (Text -> Text -> Exp -> Text -> Exp -> Text)
}
type ScaleRepr = Inflection
-> Integer
-> Integer
-> Exp
-> Ctx Exp
-> Maybe Text
defaultRepr :: Repr
defaultRepr =
Repr { reprUnknown = Nothing
, reprValue = \_ _ -> Nothing
, reprNeg = Nothing
, reprAdd = Nothing
, reprMul = Nothing
, reprSub = Nothing
, reprFrac = Nothing
, reprScale = \_ _ _ _ _ -> Nothing
, reprNegCombine = Just $ \n x _ -> n <> x
, reprAddCombine = Just $ \a x _ y _ -> x <> a <> y
, reprMulCombine = Just $ \m x _ y _ -> x <> m <> y
, reprSubCombine = Just $ \s x _ y _ -> x <> s <> y
, reprFracCombine = Just $ \f n _ d _ -> n <> f <> d
}
data Ctx a
= CtxEmpty
| CtxNeg (Ctx a)
| CtxAdd Side a (Ctx a)
| CtxMul Side a (Ctx a)
| CtxSub Side a (Ctx a)
| CtxFrac Side a (Ctx a)
| CtxScale (Ctx a)
deriving (Eq, Show)
posIndex :: Ctx a -> Integer
posIndex c = go 0 c
where
go :: Integer -> Ctx a -> Integer
go acc CtxEmpty = acc
go acc (CtxNeg nc) = go acc nc
go acc (CtxAdd as _ ac) = go (acc + if as == L then 1 else 1) ac
go acc (CtxMul ms _ mc) = go (acc + if ms == L then 1 else 1) mc
go acc (CtxSub ss _ sc) = go (acc + if ss == L then 1 else 1) sc
go acc (CtxFrac fs _ fc) = go (acc + if fs == L then 1 else 1) fc
go acc (CtxScale sc) = go acc sc
isOutside :: Side -> Ctx a -> Bool
isOutside s c = go c
where
go :: Ctx a -> Bool
go CtxEmpty = True
go (CtxNeg nc) = go nc
go (CtxAdd as _ ac) | as == s = go ac
| otherwise = False
go (CtxMul ms _ mc) | ms == s = go mc
| otherwise = False
go (CtxSub ss _ sc) | ss == s = go sc
| otherwise = False
go (CtxFrac fs _ fc) | fs == s = go fc
| otherwise = False
go (CtxScale sc) = go sc