{-# LANGUAGE ApplicativeDo #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TypeFamilyDependencies #-}
{-# LANGUAGE TypeOperators #-}
{- |
This module provides common skeletons for creating multilingual output.
Provided interfaces can be used to generate simultaneous multilingual output
as well as output which can be rendered in different Languages
(when the specific Language is provided)
-}
module Control.OutputCapable.Blocks.Generic (
  FunctorTrans (..),
  -- * Monad for translations
  GenericLangM (LangM, unLangM),
  GenericReportT (..),
  -- * Output monad
  GenericOutputCapable (..),
  RunnableOutputCapable (..),
  abortWith,
  alignOutput,
  combineReports,
  combineTwoReports,
  format,
  recoverFrom,
  recoverWith,
  toAbort,
  -- * Translation
  mapLangM,
  -- * Helper functions
  ($=<<),
  ($>>),
  ($>>=),
  collapsed,
  evalLangM,
  execLangM,
  runLangMReport,
  runLangMReportMultiLang,
  translate,
  translateCode,
  translations,
  withLang,
  ) where

import qualified Control.OutputCapable.Blocks.Report.Generic as Report (
  alignOutput,
  combineReports,
  combineTwoReports,
  toAbort,
  )

import qualified Data.Map                         as M (empty, lookup)

import Control.OutputCapable.Blocks.Report.Generic (
  GenericOut (..),
  GenericReportT (..),
  getOutsWithResult,
  )


import Control.Applicative              (Alternative ((<|>)))
import Control.Functor.Trans            (FunctorTrans (lift))
import Control.Monad                    (unless, void)
import Control.Monad.State              (State, execState)
import Control.Monad.Writer (
  MonadWriter (tell),
  )
import Data.Bifunctor                   (Bifunctor (second))
import Data.Kind                        (Type)
import Data.Foldable (
#if !MIN_VERSION_base(4,20,0)
  foldl',
#endif
  sequenceA_,
  traverse_,
  )
import Data.Functor.Identity            (Identity (Identity))
import Data.Map                         (Map)
import Data.Maybe                       (fromMaybe)

newtype GenericLangM l m a = LangM { forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM :: m a }
  deriving (Functor (GenericLangM l m)
Functor (GenericLangM l m) =>
(forall a. a -> GenericLangM l m a)
-> (forall a b.
    GenericLangM l m (a -> b)
    -> GenericLangM l m a -> GenericLangM l m b)
-> (forall a b c.
    (a -> b -> c)
    -> GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m c)
-> (forall a b.
    GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m b)
-> (forall a b.
    GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m a)
-> Applicative (GenericLangM l m)
forall a. a -> GenericLangM l m a
forall a b.
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m a
forall a b.
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m b
forall a b.
GenericLangM l m (a -> b)
-> GenericLangM l m a -> GenericLangM l m b
forall a b c.
(a -> b -> c)
-> GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m c
forall l (m :: * -> *). Applicative m => Functor (GenericLangM l m)
forall l (m :: * -> *) a. Applicative m => a -> GenericLangM l m a
forall l (m :: * -> *) a b.
Applicative m =>
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m a
forall l (m :: * -> *) a b.
Applicative m =>
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m b
forall l (m :: * -> *) a b.
Applicative m =>
GenericLangM l m (a -> b)
-> GenericLangM l m a -> GenericLangM l m b
forall l (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m c
forall (f :: * -> *).
Functor f =>
(forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall l (m :: * -> *) a. Applicative m => a -> GenericLangM l m a
pure :: forall a. a -> GenericLangM l m a
$c<*> :: forall l (m :: * -> *) a b.
Applicative m =>
GenericLangM l m (a -> b)
-> GenericLangM l m a -> GenericLangM l m b
<*> :: forall a b.
GenericLangM l m (a -> b)
-> GenericLangM l m a -> GenericLangM l m b
$cliftA2 :: forall l (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m c
liftA2 :: forall a b c.
(a -> b -> c)
-> GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m c
$c*> :: forall l (m :: * -> *) a b.
Applicative m =>
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m b
*> :: forall a b.
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m b
$c<* :: forall l (m :: * -> *) a b.
Applicative m =>
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m a
<* :: forall a b.
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m a
Applicative, (forall a b. (a -> b) -> GenericLangM l m a -> GenericLangM l m b)
-> (forall a b. a -> GenericLangM l m b -> GenericLangM l m a)
-> Functor (GenericLangM l m)
forall a b. a -> GenericLangM l m b -> GenericLangM l m a
forall a b. (a -> b) -> GenericLangM l m a -> GenericLangM l m b
forall l (m :: * -> *) a b.
Functor m =>
a -> GenericLangM l m b -> GenericLangM l m a
forall l (m :: * -> *) a b.
Functor m =>
(a -> b) -> GenericLangM l m a -> GenericLangM l m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall l (m :: * -> *) a b.
Functor m =>
(a -> b) -> GenericLangM l m a -> GenericLangM l m b
fmap :: forall a b. (a -> b) -> GenericLangM l m a -> GenericLangM l m b
$c<$ :: forall l (m :: * -> *) a b.
Functor m =>
a -> GenericLangM l m b -> GenericLangM l m a
<$ :: forall a b. a -> GenericLangM l m b -> GenericLangM l m a
Functor)

instance FunctorTrans (GenericLangM l) where
  lift :: forall (f :: * -> *) a. Functor f => f a -> GenericLangM l f a
lift = f a -> GenericLangM l f a
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM

class (Applicative m, Ord l) => GenericOutputCapable l m where
  -- | for assertions, i.e. expected behaviour is explanation
  -- (and abortion on 'False')
  assertion  :: Bool -> GenericLangM l m () -> GenericLangM l m ()
  -- | for printing a single image from file
  image      :: FilePath -> GenericLangM l m ()
  -- | for printing multiple images using the given map
  images     :: (k -> String) -> (a -> FilePath) -> Map k a -> GenericLangM l m ()
  -- | for a complete paragraph
  paragraph  :: GenericLangM l m () -> GenericLangM l m ()
  -- | should abort at once
  refuse     :: GenericLangM l m () -> GenericLangM l m ()
  -- | for displaying text
  text       :: String -> GenericLangM l m ()
  text = (l -> String) -> GenericLangM l m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
(l -> String) -> GenericLangM l m ()
translated ((l -> String) -> GenericLangM l m ())
-> (String -> l -> String) -> String -> GenericLangM l m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> l -> String
forall a b. a -> b -> a
const
  -- | for an enumerated sequence of elements
  enumerateM
    :: (a -> GenericLangM l m ())
    -> [(a, GenericLangM l m ())]
    -> GenericLangM l m ()
  -- | for an unenumerated sequence of elements
  itemizeM   :: [GenericLangM l m ()] -> GenericLangM l m ()
  -- | for indentation
  indent     :: GenericLangM l m () -> GenericLangM l m ()
  -- | for LaTeX-Math code (i.e. without surrounding @$@)
  latex      :: String -> GenericLangM l m ()
  -- | for minimisable output with a default state (open/closed) and title
  folded :: Bool -> (l -> String) -> GenericLangM l m () -> GenericLangM l m ()
  -- | for fixed width fonts (i.e. typewriter style)
  code       :: String -> GenericLangM l m ()
  code = (l -> String) -> GenericLangM l m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
(l -> String) -> GenericLangM l m ()
translatedCode ((l -> String) -> GenericLangM l m ())
-> (String -> l -> String) -> String -> GenericLangM l m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> l -> String
forall a b. a -> b -> a
const
  -- | same as 'code', but with different translations
  translatedCode :: (l -> String) -> GenericLangM l m ()
  -- | for displaying text with translations
  translated :: (l -> String) -> GenericLangM l m ()

infixr 0 $=<<, $>>=, $>>

($=<<) :: Monad m => (a -> GenericLangM l m b) -> m a -> GenericLangM l m b
a -> GenericLangM l m b
f $=<< :: forall (m :: * -> *) a l b.
Monad m =>
(a -> GenericLangM l m b) -> m a -> GenericLangM l m b
$=<< m a
x = m b -> GenericLangM l m b
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (m b -> GenericLangM l m b) -> m b -> GenericLangM l m b
forall a b. (a -> b) -> a -> b
$ m a
x m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenericLangM l m b -> m b
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM (GenericLangM l m b -> m b)
-> (a -> GenericLangM l m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GenericLangM l m b
f

($>>=)
  :: Monad m
  => GenericLangM l m a
  -> (a -> GenericLangM l m b)
  -> GenericLangM l m b
GenericLangM l m a
x $>>= :: forall (m :: * -> *) l a b.
Monad m =>
GenericLangM l m a
-> (a -> GenericLangM l m b) -> GenericLangM l m b
$>>= a -> GenericLangM l m b
f = m b -> GenericLangM l m b
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (m b -> GenericLangM l m b) -> m b -> GenericLangM l m b
forall a b. (a -> b) -> a -> b
$ GenericLangM l m a -> m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l m a
x m a -> (a -> m b) -> m b
forall a b. m a -> (a -> m b) -> m b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenericLangM l m b -> m b
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM (GenericLangM l m b -> m b)
-> (a -> GenericLangM l m b) -> a -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> GenericLangM l m b
f

($>>)
  :: Monad m
  => GenericLangM l m a
  -> GenericLangM l m b
  -> GenericLangM l m b
GenericLangM l m a
x $>> :: forall (m :: * -> *) l a b.
Monad m =>
GenericLangM l m a -> GenericLangM l m b -> GenericLangM l m b
$>> GenericLangM l m b
y = m b -> GenericLangM l m b
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (m b -> GenericLangM l m b) -> m b -> GenericLangM l m b
forall a b. (a -> b) -> a -> b
$ GenericLangM l m a -> m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l m a
x m a -> m b -> m b
forall a b. m a -> m b -> m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> GenericLangM l m b -> m b
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l m b
y

class (GenericOutputCapable l m, Monad (RunMonad l m))
  => RunnableOutputCapable l m where
  -- | the monad handling multilingual output
  type RunMonad l m :: Type -> Type
  type Output l m
  runLangM
    :: GenericLangM l m a
    -> RunMonad l m (Maybe a, l -> Output l m)

execLangM
  :: RunnableOutputCapable l m
  => GenericLangM l m a
  -> RunMonad l m (l -> Output l m)
execLangM :: forall l (m :: * -> *) a.
RunnableOutputCapable l m =>
GenericLangM l m a -> RunMonad l m (l -> Output l m)
execLangM GenericLangM l m a
lm = do
  ~(Maybe a
_, l -> Output l m
output) <- GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
forall a.
GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
forall l (m :: * -> *) a.
RunnableOutputCapable l m =>
GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
runLangM GenericLangM l m a
lm
  return l -> Output l m
output

evalLangM
  :: RunnableOutputCapable l m
  => GenericLangM l m a
  -> RunMonad l m (Maybe a)
evalLangM :: forall l (m :: * -> *) a.
RunnableOutputCapable l m =>
GenericLangM l m a -> RunMonad l m (Maybe a)
evalLangM GenericLangM l m a
lm = do
  ~(Maybe a
result, l -> Output l m
_) <- GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
forall a.
GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
forall l (m :: * -> *) a.
RunnableOutputCapable l m =>
GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
runLangM GenericLangM l m a
lm
  return Maybe a
result

withLang
  :: (RunnableOutputCapable l m, Output l m ~ RunMonad l m b)
  => GenericLangM l m a
  -> l
  -> RunMonad l m (Maybe a)
withLang :: forall l (m :: * -> *) b a.
(RunnableOutputCapable l m, Output l m ~ RunMonad l m b) =>
GenericLangM l m a -> l -> RunMonad l m (Maybe a)
withLang GenericLangM l m a
xs l
l = do
  (Maybe a
r, l -> RunMonad l m b
o) <- GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
forall a.
GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
forall l (m :: * -> *) a.
RunnableOutputCapable l m =>
GenericLangM l m a -> RunMonad l m (Maybe a, l -> Output l m)
runLangM GenericLangM l m a
xs
  l -> RunMonad l m b
o l
l
  return Maybe a
r

recoverFrom
  :: Alternative m
  => GenericLangM l m ()
  -> GenericLangM l m ()
recoverFrom :: forall (m :: * -> *) l.
Alternative m =>
GenericLangM l m () -> GenericLangM l m ()
recoverFrom GenericLangM l m ()
x = m () -> GenericLangM l m ()
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (m () -> GenericLangM l m ()) -> m () -> GenericLangM l m ()
forall a b. (a -> b) -> a -> b
$ GenericLangM l m () -> m ()
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l m ()
x m () -> m () -> m ()
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

recoverWith
  :: Alternative m
  => a
  -> GenericLangM l m b
  -> GenericLangM l m (Either a b)
recoverWith :: forall (m :: * -> *) a l b.
Alternative m =>
a -> GenericLangM l m b -> GenericLangM l m (Either a b)
recoverWith a
x GenericLangM l m b
m = m (Either a b) -> GenericLangM l m (Either a b)
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (m (Either a b) -> GenericLangM l m (Either a b))
-> m (Either a b) -> GenericLangM l m (Either a b)
forall a b. (a -> b) -> a -> b
$ (b -> Either a b
forall a b. b -> Either a b
Right (b -> Either a b) -> m b -> m (Either a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericLangM l m b -> m b
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l m b
m) m (Either a b) -> m (Either a b) -> m (Either a b)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Either a b -> m (Either a b)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> Either a b
forall a b. a -> Either a b
Left a
x)

combineLangMs
  :: ([GenericReportT l o m a] -> GenericReportT l o m b)
  -> [GenericLangM l (GenericReportT l o m) a]
  -> GenericLangM l (GenericReportT l o m) b
combineLangMs :: forall l o (m :: * -> *) a b.
([GenericReportT l o m a] -> GenericReportT l o m b)
-> [GenericLangM l (GenericReportT l o m) a]
-> GenericLangM l (GenericReportT l o m) b
combineLangMs [GenericReportT l o m a] -> GenericReportT l o m b
f [GenericLangM l (GenericReportT l o m) a]
oms = GenericReportT l o m b -> GenericLangM l (GenericReportT l o m) b
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (GenericReportT l o m b -> GenericLangM l (GenericReportT l o m) b)
-> GenericReportT l o m b
-> GenericLangM l (GenericReportT l o m) b
forall a b. (a -> b) -> a -> b
$ [GenericReportT l o m a] -> GenericReportT l o m b
f ([GenericReportT l o m a] -> GenericReportT l o m b)
-> [GenericReportT l o m a] -> GenericReportT l o m b
forall a b. (a -> b) -> a -> b
$ (GenericLangM l (GenericReportT l o m) a -> GenericReportT l o m a)
-> [GenericLangM l (GenericReportT l o m) a]
-> [GenericReportT l o m a]
forall a b. (a -> b) -> [a] -> [b]
map GenericLangM l (GenericReportT l o m) a -> GenericReportT l o m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM [GenericLangM l (GenericReportT l o m) a]
oms

combineLangM
  :: (GenericReportT l o m a -> GenericReportT l o m b -> GenericReportT l o m c)
  -> GenericLangM l (GenericReportT l o m) a
  -> GenericLangM l (GenericReportT l o m) b
  -> GenericLangM l (GenericReportT l o m) c
combineLangM :: forall l o (m :: * -> *) a b c.
(GenericReportT l o m a
 -> GenericReportT l o m b -> GenericReportT l o m c)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
-> GenericLangM l (GenericReportT l o m) c
combineLangM GenericReportT l o m a
-> GenericReportT l o m b -> GenericReportT l o m c
f GenericLangM l (GenericReportT l o m) a
x GenericLangM l (GenericReportT l o m) b
y = GenericReportT l o m c -> GenericLangM l (GenericReportT l o m) c
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (GenericReportT l o m c -> GenericLangM l (GenericReportT l o m) c)
-> GenericReportT l o m c
-> GenericLangM l (GenericReportT l o m) c
forall a b. (a -> b) -> a -> b
$ GenericReportT l o m a
-> GenericReportT l o m b -> GenericReportT l o m c
f (GenericLangM l (GenericReportT l o m) a -> GenericReportT l o m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l (GenericReportT l o m) a
x) (GenericLangM l (GenericReportT l o m) b -> GenericReportT l o m b
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l (GenericReportT l o m) b
y)

{-|
Combines the output of the list of given reports using the provided function.
Output is provided for all reports up to including the first failing report.
-}
combineReports
  :: Monad m
  => ([[o]] -> o)
  -> [GenericLangM l (GenericReportT l o m) a]
  -> GenericLangM l (GenericReportT l o m) ()
combineReports :: forall (m :: * -> *) o l a.
Monad m =>
([[o]] -> o)
-> [GenericLangM l (GenericReportT l o m) a]
-> GenericLangM l (GenericReportT l o m) ()
combineReports [[o]] -> o
f = ([GenericReportT l o m a] -> GenericReportT l o m ())
-> [GenericLangM l (GenericReportT l o m) a]
-> GenericLangM l (GenericReportT l o m) ()
forall l o (m :: * -> *) a b.
([GenericReportT l o m a] -> GenericReportT l o m b)
-> [GenericLangM l (GenericReportT l o m) a]
-> GenericLangM l (GenericReportT l o m) b
combineLangMs (([[o]] -> o) -> [GenericReportT l o m a] -> GenericReportT l o m ()
forall (m :: * -> *) o l a.
Monad m =>
([[o]] -> o) -> [GenericReportT l o m a] -> GenericReportT l o m ()
Report.combineReports [[o]] -> o
f)

alignOutput
  :: Monad m
  => ([o] -> o)
  -> GenericLangM l (GenericReportT l o m) a
  -> GenericLangM l (GenericReportT l o m) ()
alignOutput :: forall (m :: * -> *) o l a.
Monad m =>
([o] -> o)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) ()
alignOutput [o] -> o
f = GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (GenericLangM l (GenericReportT l o m) a
 -> GenericLangM l (GenericReportT l o m) ())
-> (GenericLangM l (GenericReportT l o m) a
    -> GenericLangM l (GenericReportT l o m) a)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericReportT l o m a -> GenericReportT l o m a)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) a
forall (m :: * -> *) a b l.
(m a -> m b) -> GenericLangM l m a -> GenericLangM l m b
mapLangM (([o] -> o) -> GenericReportT l o m a -> GenericReportT l o m a
forall (m :: * -> *) o l a.
Monad m =>
([o] -> o) -> GenericReportT l o m a -> GenericReportT l o m a
Report.alignOutput [o] -> o
f)

{-|
Combines the output of the two given reports using the provided functions.

If the execution aborts on the first report the second report is treated
as if has not produced any output.
-}
combineTwoReports
  :: Monad m
  => ([o] -> [o] -> o)
  -> GenericLangM l (GenericReportT l o m) a
  -> GenericLangM l (GenericReportT l o m) b
  -> GenericLangM l (GenericReportT l o m) ()
combineTwoReports :: forall (m :: * -> *) o l a b.
Monad m =>
([o] -> [o] -> o)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
-> GenericLangM l (GenericReportT l o m) ()
combineTwoReports = (GenericReportT l o m a
 -> GenericReportT l o m b -> GenericReportT l o m ())
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
-> GenericLangM l (GenericReportT l o m) ()
forall l o (m :: * -> *) a b c.
(GenericReportT l o m a
 -> GenericReportT l o m b -> GenericReportT l o m c)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
-> GenericLangM l (GenericReportT l o m) c
combineLangM ((GenericReportT l o m a
  -> GenericReportT l o m b -> GenericReportT l o m ())
 -> GenericLangM l (GenericReportT l o m) a
 -> GenericLangM l (GenericReportT l o m) b
 -> GenericLangM l (GenericReportT l o m) ())
-> (([o] -> [o] -> o)
    -> GenericReportT l o m a
    -> GenericReportT l o m b
    -> GenericReportT l o m ())
-> ([o] -> [o] -> o)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
-> GenericLangM l (GenericReportT l o m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([o] -> [o] -> o)
-> GenericReportT l o m a
-> GenericReportT l o m b
-> GenericReportT l o m ()
forall (m :: * -> *) o l a b.
Monad m =>
([o] -> [o] -> o)
-> GenericReportT l o m a
-> GenericReportT l o m b
-> GenericReportT l o m ()
Report.combineTwoReports

out :: Monad m => GenericOut l o -> GenericLangM l (GenericReportT l o m) ()
out :: forall (m :: * -> *) l o.
Monad m =>
GenericOut l o -> GenericLangM l (GenericReportT l o m) ()
out = GenericReportT l o m () -> GenericLangM l (GenericReportT l o m) ()
forall (f :: * -> *) a. Functor f => f a -> GenericLangM l f a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
(FunctorTrans t, Functor f) =>
f a -> t f a
lift (GenericReportT l o m ()
 -> GenericLangM l (GenericReportT l o m) ())
-> (GenericOut l o -> GenericReportT l o m ())
-> GenericOut l o
-> GenericLangM l (GenericReportT l o m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MaybeT (WriterT [GenericOut l o] m) () -> GenericReportT l o m ()
forall l o (m :: * -> *) r.
MaybeT (WriterT [GenericOut l o] m) r -> GenericReportT l o m r
Report (MaybeT (WriterT [GenericOut l o] m) () -> GenericReportT l o m ())
-> (GenericOut l o -> MaybeT (WriterT [GenericOut l o] m) ())
-> GenericOut l o
-> GenericReportT l o m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenericOut l o] -> MaybeT (WriterT [GenericOut l o] m) ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell ([GenericOut l o] -> MaybeT (WriterT [GenericOut l o] m) ())
-> (GenericOut l o -> [GenericOut l o])
-> GenericOut l o
-> MaybeT (WriterT [GenericOut l o] m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericOut l o -> [GenericOut l o] -> [GenericOut l o]
forall a. a -> [a] -> [a]
:[])

format :: Monad m => o -> GenericLangM l (GenericReportT l o m) ()
format :: forall (m :: * -> *) o l.
Monad m =>
o -> GenericLangM l (GenericReportT l o m) ()
format = GenericOut l o -> GenericLangM l (GenericReportT l o m) ()
forall (m :: * -> *) l o.
Monad m =>
GenericOut l o -> GenericLangM l (GenericReportT l o m) ()
out (GenericOut l o -> GenericLangM l (GenericReportT l o m) ())
-> (o -> GenericOut l o)
-> o
-> GenericLangM l (GenericReportT l o m) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. o -> GenericOut l o
forall l o. o -> GenericOut l o
Format

abortWith :: Monad m => o -> GenericLangM l (GenericReportT l o m) ()
abortWith :: forall (m :: * -> *) o l.
Monad m =>
o -> GenericLangM l (GenericReportT l o m) ()
abortWith o
d = GenericLangM l (GenericReportT l o m) ()
-> GenericLangM l (GenericReportT l o m) ()
forall (m :: * -> *) l o a b.
Monad m =>
GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
toAbort (GenericLangM l (GenericReportT l o m) ()
 -> GenericLangM l (GenericReportT l o m) ())
-> GenericLangM l (GenericReportT l o m) ()
-> GenericLangM l (GenericReportT l o m) ()
forall a b. (a -> b) -> a -> b
$ o -> GenericLangM l (GenericReportT l o m) ()
forall (m :: * -> *) o l.
Monad m =>
o -> GenericLangM l (GenericReportT l o m) ()
format o
d

toAbort
  :: Monad m
  => GenericLangM l (GenericReportT l o m) a
  -> GenericLangM l (GenericReportT l o m) b
toAbort :: forall (m :: * -> *) l o a b.
Monad m =>
GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
toAbort = (GenericReportT l o m a -> GenericReportT l o m b)
-> GenericLangM l (GenericReportT l o m) a
-> GenericLangM l (GenericReportT l o m) b
forall (m :: * -> *) a b l.
(m a -> m b) -> GenericLangM l m a -> GenericLangM l m b
mapLangM GenericReportT l o m a -> GenericReportT l o m b
forall (m :: * -> *) l o a b.
Monad m =>
GenericReportT l o m a -> GenericReportT l o m b
Report.toAbort

mapLangM :: (m a -> m b) -> GenericLangM l m a -> GenericLangM l m b
mapLangM :: forall (m :: * -> *) a b l.
(m a -> m b) -> GenericLangM l m a -> GenericLangM l m b
mapLangM m a -> m b
f GenericLangM l m a
om = m b -> GenericLangM l m b
forall l (m :: * -> *) a. m a -> GenericLangM l m a
LangM (m b -> GenericLangM l m b) -> m b -> GenericLangM l m b
forall a b. (a -> b) -> a -> b
$ m a -> m b
f (m a -> m b) -> m a -> m b
forall a b. (a -> b) -> a -> b
$ GenericLangM l m a -> m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l m a
om

instance Ord l => GenericOutputCapable l Maybe where
  assertion :: Bool -> GenericLangM l Maybe () -> GenericLangM l Maybe ()
assertion Bool
b GenericLangM l Maybe ()
_   = Bool -> GenericLangM l Maybe () -> GenericLangM l Maybe ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
b (GenericLangM l Maybe () -> GenericLangM l Maybe ())
-> GenericLangM l Maybe () -> GenericLangM l Maybe ()
forall a b. (a -> b) -> a -> b
$ Maybe () -> GenericLangM l Maybe ()
forall (f :: * -> *) a. Functor f => f a -> GenericLangM l f a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
(FunctorTrans t, Functor f) =>
f a -> t f a
lift Maybe ()
forall a. Maybe a
Nothing
  image :: String -> GenericLangM l Maybe ()
image String
_         = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  images :: forall k a.
(k -> String)
-> (a -> String) -> Map k a -> GenericLangM l Maybe ()
images k -> String
_ a -> String
_ Map k a
_    = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  paragraph :: GenericLangM l Maybe () -> GenericLangM l Maybe ()
paragraph GenericLangM l Maybe ()
xs    = GenericLangM l Maybe ()
xs
  refuse :: GenericLangM l Maybe () -> GenericLangM l Maybe ()
refuse GenericLangM l Maybe ()
xs       = GenericLangM l Maybe ()
xs GenericLangM l Maybe ()
-> GenericLangM l Maybe () -> GenericLangM l Maybe ()
forall a b.
GenericLangM l Maybe a
-> GenericLangM l Maybe b -> GenericLangM l Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe () -> GenericLangM l Maybe ()
forall (f :: * -> *) a. Functor f => f a -> GenericLangM l f a
forall (t :: (* -> *) -> * -> *) (f :: * -> *) a.
(FunctorTrans t, Functor f) =>
f a -> t f a
lift Maybe ()
forall a. Maybe a
Nothing
  text :: String -> GenericLangM l Maybe ()
text String
_          = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  enumerateM :: forall a.
(a -> GenericLangM l Maybe ())
-> [(a, GenericLangM l Maybe ())] -> GenericLangM l Maybe ()
enumerateM a -> GenericLangM l Maybe ()
f [(a, GenericLangM l Maybe ())]
xs = (\(a
x, GenericLangM l Maybe ()
y) -> a -> GenericLangM l Maybe ()
f a
x GenericLangM l Maybe ()
-> GenericLangM l Maybe () -> GenericLangM l Maybe ()
forall a b.
GenericLangM l Maybe a
-> GenericLangM l Maybe b -> GenericLangM l Maybe b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> GenericLangM l Maybe ()
y) ((a, GenericLangM l Maybe ()) -> GenericLangM l Maybe ())
-> [(a, GenericLangM l Maybe ())] -> GenericLangM l Maybe ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
`traverse_` [(a, GenericLangM l Maybe ())]
xs
  itemizeM :: [GenericLangM l Maybe ()] -> GenericLangM l Maybe ()
itemizeM        = [GenericLangM l Maybe ()] -> GenericLangM l Maybe ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_
  indent :: GenericLangM l Maybe () -> GenericLangM l Maybe ()
indent GenericLangM l Maybe ()
xs       = GenericLangM l Maybe ()
xs
  latex :: String -> GenericLangM l Maybe ()
latex String
_         = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  folded :: Bool
-> (l -> String)
-> GenericLangM l Maybe ()
-> GenericLangM l Maybe ()
folded Bool
_ l -> String
_ GenericLangM l Maybe ()
_ = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  code :: String -> GenericLangM l Maybe ()
code String
_          = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  translatedCode :: (l -> String) -> GenericLangM l Maybe ()
translatedCode l -> String
_ = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  translated :: (l -> String) -> GenericLangM l Maybe ()
translated l -> String
_    = () -> GenericLangM l Maybe ()
forall a. a -> GenericLangM l Maybe a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

instance Ord l => RunnableOutputCapable l Maybe where
  type RunMonad l Maybe = Identity
  type Output l Maybe = ()
  runLangM :: forall a.
GenericLangM l Maybe a
-> RunMonad l Maybe (Maybe a, l -> Output l Maybe)
runLangM        = (Maybe a, l -> ()) -> Identity (Maybe a, l -> ())
forall a. a -> Identity a
Identity ((Maybe a, l -> ()) -> Identity (Maybe a, l -> ()))
-> (GenericLangM l Maybe a -> (Maybe a, l -> ()))
-> GenericLangM l Maybe a
-> Identity (Maybe a, l -> ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (, () -> l -> ()
forall a b. a -> b -> a
const ()) (Maybe a -> (Maybe a, l -> ()))
-> (GenericLangM l Maybe a -> Maybe a)
-> GenericLangM l Maybe a
-> (Maybe a, l -> ())
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericLangM l Maybe a -> Maybe a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM

translate
  :: GenericOutputCapable language m
  => State (Map language String) a
  -> GenericLangM language m ()
translate :: forall language (m :: * -> *) a.
GenericOutputCapable language m =>
State (Map language String) a -> GenericLangM language m ()
translate = (language -> String) -> GenericLangM language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
(l -> String) -> GenericLangM l m ()
translated ((language -> String) -> GenericLangM language m ())
-> (State (Map language String) a -> language -> String)
-> State (Map language String) a
-> GenericLangM language m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map language String -> language -> String
forall language.
Ord language =>
Map language String -> language -> String
mapToMatching (Map language String -> language -> String)
-> (State (Map language String) a -> Map language String)
-> State (Map language String) a
-> language
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (Map language String) a -> Map language String
forall language a1 a2.
State (Map language a1) a2 -> Map language a1
translations

translateCode
  :: GenericOutputCapable language m
  => State (Map language String) a
  -> GenericLangM language m ()
translateCode :: forall language (m :: * -> *) a.
GenericOutputCapable language m =>
State (Map language String) a -> GenericLangM language m ()
translateCode = (language -> String) -> GenericLangM language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
(l -> String) -> GenericLangM l m ()
translatedCode ((language -> String) -> GenericLangM language m ())
-> (State (Map language String) a -> language -> String)
-> State (Map language String) a
-> GenericLangM language m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map language String -> language -> String
forall language.
Ord language =>
Map language String -> language -> String
mapToMatching (Map language String -> language -> String)
-> (State (Map language String) a -> Map language String)
-> State (Map language String) a
-> language
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State (Map language String) a -> Map language String
forall language a1 a2.
State (Map language a1) a2 -> Map language a1
translations

translations :: State (Map language a1) a2 -> Map language a1
translations :: forall language a1 a2.
State (Map language a1) a2 -> Map language a1
translations = (State (Map language a1) a2 -> Map language a1 -> Map language a1)
-> Map language a1 -> State (Map language a1) a2 -> Map language a1
forall a b c. (a -> b -> c) -> b -> a -> c
flip State (Map language a1) a2 -> Map language a1 -> Map language a1
forall s a. State s a -> s -> s
execState Map language a1
forall k a. Map k a
M.empty

mapToMatching :: Ord language => Map language String -> language -> String
mapToMatching :: forall language.
Ord language =>
Map language String -> language -> String
mapToMatching Map language String
l = String -> Maybe String -> String
forall a. a -> Maybe a -> a
fromMaybe String
"" (Maybe String -> String)
-> (language -> Maybe String) -> language -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (language -> Map language String -> Maybe String)
-> Map language String -> language -> Maybe String
forall a b c. (a -> b -> c) -> b -> a -> c
flip language -> Map language String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Map language String
l

collapsed
  :: GenericOutputCapable language m
  => Bool
  -> State (Map language String) a1
  -> GenericLangM language m ()
  -> GenericLangM language m ()
collapsed :: forall language (m :: * -> *) a1.
GenericOutputCapable language m =>
Bool
-> State (Map language String) a1
-> GenericLangM language m ()
-> GenericLangM language m ()
collapsed Bool
b State (Map language String) a1
t = Bool
-> (language -> String)
-> GenericLangM language m ()
-> GenericLangM language m ()
forall l (m :: * -> *).
GenericOutputCapable l m =>
Bool -> (l -> String) -> GenericLangM l m () -> GenericLangM l m ()
folded Bool
b (Map language String -> language -> String
forall language.
Ord language =>
Map language String -> language -> String
mapToMatching (Map language String -> language -> String)
-> Map language String -> language -> String
forall a b. (a -> b) -> a -> b
$ State (Map language String) a1 -> Map language String
forall language a1 a2.
State (Map language a1) a2 -> Map language a1
translations State (Map language String) a1
t)

{-|
Provided a neutral element and a function to combine generated output
this function will evaluate 'GenericLangM' and combine the output.

A specific output can be rendered when a language is provided
to the returned function.
-}
runLangMReport
  :: Functor m
  => o
  -> (o -> o -> o)
  -> GenericLangM l (GenericReportT l o m) a
  -> m (Maybe a, l -> o)
runLangMReport :: forall (m :: * -> *) o l a.
Functor m =>
o
-> (o -> o -> o)
-> GenericLangM l (GenericReportT l o m) a
-> m (Maybe a, l -> o)
runLangMReport o
neutral o -> o -> o
f GenericLangM l (GenericReportT l o m) a
lm =
  ([GenericOut l o] -> l -> o)
-> (Maybe a, [GenericOut l o]) -> (Maybe a, l -> o)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [GenericOut l o] -> l -> o
foldOutput ((Maybe a, [GenericOut l o]) -> (Maybe a, l -> o))
-> m (Maybe a, [GenericOut l o]) -> m (Maybe a, l -> o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericReportT l o m a -> m (Maybe a, [GenericOut l o])
forall l o (m :: * -> *) a.
GenericReportT l o m a -> m (Maybe a, [GenericOut l o])
getOutsWithResult (GenericLangM l (GenericReportT l o m) a -> GenericReportT l o m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l (GenericReportT l o m) a
lm)
  where
    foldOutput :: [GenericOut l o] -> l -> o
foldOutput [GenericOut l o]
os l
l = (o -> GenericOut l o -> o) -> o -> [GenericOut l o] -> o
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (l -> o -> GenericOut l o -> o
toOutput' l
l) o
neutral [GenericOut l o]
os
    toOutput' :: l -> o -> GenericOut l o -> o
toOutput' l
l o
xs GenericOut l o
x =
      case GenericOut l o
x of
        Format o
o -> o -> o -> o
f o
xs o
o
        Localised l -> o
m -> o -> o -> o
f o
xs (l -> o
m l
l)

{-|
Provided a neutral element, a function to combine generated output,
and a function to remap translations into output
this function will evaluate 'GenericLangM' and combine the output.

The provided output unifies multilingual output as one.
This could for instance be with local definitions of translated parts.
-}
runLangMReportMultiLang
  :: Functor m
  => o
  -> (o -> o -> o)
  -> ((l -> o) -> o)
  -> GenericLangM l (GenericReportT l o m) a
  -> m (Maybe a, o)
runLangMReportMultiLang :: forall (m :: * -> *) o l a.
Functor m =>
o
-> (o -> o -> o)
-> ((l -> o) -> o)
-> GenericLangM l (GenericReportT l o m) a
-> m (Maybe a, o)
runLangMReportMultiLang o
neutral o -> o -> o
f (l -> o) -> o
toO GenericLangM l (GenericReportT l o m) a
lm =
  ([GenericOut l o] -> o)
-> (Maybe a, [GenericOut l o]) -> (Maybe a, o)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second [GenericOut l o] -> o
foldOutput ((Maybe a, [GenericOut l o]) -> (Maybe a, o))
-> m (Maybe a, [GenericOut l o]) -> m (Maybe a, o)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GenericReportT l o m a -> m (Maybe a, [GenericOut l o])
forall l o (m :: * -> *) a.
GenericReportT l o m a -> m (Maybe a, [GenericOut l o])
getOutsWithResult (GenericLangM l (GenericReportT l o m) a -> GenericReportT l o m a
forall l (m :: * -> *) a. GenericLangM l m a -> m a
unLangM GenericLangM l (GenericReportT l o m) a
lm)
  where
    foldOutput :: [GenericOut l o] -> o
foldOutput = (o -> GenericOut l o -> o) -> o -> [GenericOut l o] -> o
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' o -> GenericOut l o -> o
toOutput' o
neutral
    toOutput' :: o -> GenericOut l o -> o
toOutput' o
xs GenericOut l o
x =
      case GenericOut l o
x of
        Format o
o -> o -> o -> o
f o
xs o
o
        Localised l -> o
m -> o -> o -> o
f o
xs (o -> o) -> o -> o
forall a b. (a -> b) -> a -> b
$ (l -> o) -> o
toO l -> o
m