Render.hs

{-# LANGUAGE NoImplicitPrelude
           , UnicodeSyntax
           , PackageImports
           , RecordWildCards
  #-}

module Text.Numeral.Render
    ( -- * Rendering numerals
      render
      -- * Representation of numerals
    , Repr(..), defaultRepr
      -- * Context of expressions
    , Ctx(..)
    )
    where


-------------------------------------------------------------------------------
-- Imports
-------------------------------------------------------------------------------

import "base"                 Data.Function       ( ($) )
import "base"                 Data.Functor        ( (<$>) )
import "base"                 Data.Maybe          ( Maybe(Nothing, Just) )
import "base"                 Data.Monoid         ( Monoid )
import "base-unicode-symbols" Data.Monoid.Unicode ( (⊕) )
import "base-unicode-symbols" Prelude.Unicode     ( ℤ )
import "base"                 Text.Show           ( Show )
import "this"                 Text.Numeral.Exp    ( Exp(..), Side(L, R) )


-------------------------------------------------------------------------------
-- Rendering numerals
-------------------------------------------------------------------------------

-- | Renders an expression to a string-like value according to a
-- certain representation.
render ∷ (Monoid s) ⇒ Repr s → Exp → Maybe s
render (Repr {..}) e = go CtxEmpty e
    where
      go _   Unknown = reprUnknown
      go ctx (Lit n) = ($ ctx) <$> reprValue n
      go ctx (Scale b o r) = reprScale b o r ctx
      go ctx (Neg x) = do x' ← go (CtxNeg ctx) x
                          rn ← reprNeg
                          rnc ← reprNegCombine
                          Just $ rnc (rn x ctx) x'
      go ctx (Add x y) = do x' ← go (CtxAdd L y ctx) x
                            y' ← go (CtxAdd R x ctx) y
                            ra ← reprAdd
                            rac ← reprAddCombine
                            Just $ rac (ra x y ctx) x' y'
      go ctx (Mul x y) = do x' ← go (CtxMul L y ctx) x
                            y' ← go (CtxMul R x ctx) y
                            rm ← reprMul
                            rmc ← reprMulCombine
                            Just $ rmc (rm x y ctx) x' y'
      go ctx (Sub x y) = do x' ← go (CtxSub L y ctx) x
                            y' ← go (CtxSub R x ctx) y
                            rs ← reprSub
                            rsc ← reprSubCombine
                            Just $ rsc (rs x y ctx) x' y'


--------------------------------------------------------------------------------
-- Representation of numerals
--------------------------------------------------------------------------------

-- | A representation for numerals.
--
-- A 'Repr' contains all the information on how to render an
-- 'Exp'ression to a string-like value.
data Repr s =
    Repr
    { -- | Representation for unknown values.
      reprUnknown ∷ Maybe s
      -- | Renders a literal value. Not necessarily defined for every
      -- value.
    , reprValue ∷ ℤ → Maybe (Ctx Exp → s)
      -- | Renders a step in a scale of large values. The arguments
      -- are in order: base, offset and rank of the step and the
      -- context of the rank. The value represented by the step is 10
      -- ^ (rank * base + offset).
    , reprScale ∷ ℤ → ℤ → Exp → Ctx Exp → Maybe s
      -- | Renders a negation. This concerns the negation itself, not
      -- the thing being negated.
    , reprNeg ∷ Maybe (Exp       → Ctx Exp → s)
      -- | Renders an addition. This concerns the addition itself, not
      -- the things being added. For example: In \"one hundred and
      -- eighty\" this function would be responsible for rendering the
      -- \"and\".
    , reprAdd ∷ Maybe (Exp → Exp → Ctx Exp → s)
      -- | Renders a multiplication. This concerns the multiplication
      -- itself, not the things being multiplied.
    , reprMul ∷ Maybe (Exp → Exp → Ctx Exp → s)
      -- | Renders a subtraction. This concerns the subtraction
      -- itself, not the things being subtracted.
    , reprSub ∷ Maybe (Exp → Exp → Ctx Exp → s)
      -- | Combines a negation and the thing being negated. For
      -- example: this would combine \"minus\" and \"three\" into
      -- \"minus three\".
    , reprNegCombine ∷ Maybe (s → s     → s)
      -- | Combines an addition and the things being added.
    , reprAddCombine ∷ Maybe (s → s → s → s)
      -- | Combines a multiplication and the things being multiplied.
    , reprMulCombine ∷ Maybe (s → s → s → s)
      -- | Combines a subtraction and the things being subtracted.
    , reprSubCombine ∷ Maybe (s → s → s → s)
    }

-- | The default representation.
--
-- Only the combining functions are defined. The rest are either
-- 'Nothing' or always produce 'Nothing'.
defaultRepr ∷ (Monoid s) ⇒ Repr s
defaultRepr =
    Repr { reprUnknown = Nothing
         , reprValue = \_       → Nothing
         , reprScale = \_ _ _ _ → Nothing
         , reprNeg   = Nothing
         , reprAdd   = Nothing
         , reprMul   = Nothing
         , reprSub   = 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
         }


--------------------------------------------------------------------------------
-- Context of expressions
--------------------------------------------------------------------------------

-- | A context in which an 'Exp'ression appears.
data Ctx α   -- | The empty context. Used for top level expressions.
           = CtxEmpty
             -- | Negation context.
           | CtxNeg (Ctx α)
             -- | Addition context.
           | CtxAdd Side α (Ctx α)
             -- | Multiplication context.
           | CtxMul Side α (Ctx α)
             -- | Subtraction context.
           | CtxSub Side α (Ctx α)
             -- | Scale context.
           | CtxScale (Ctx α)
             deriving Show