{-# LANGUAGE ExplicitNamespaces #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE PatternSynonyms #-}
{-|
A version of the 'Control.OutputCapable.Blocks.Generic.Type' module
specialised to 'Language'.
It provides basically the same interface but specialised to 'Output'
and additionally a somewhat more general 'SpecialOutput' variant.
Both type synonyms are also provided.
-}
module Control.OutputCapable.Blocks.Type (
  -- * common constructors
  pattern YesNo,
  pattern Image,
  pattern Images,
  pattern Paragraph,
  pattern Enumerated,
  pattern Itemized,
  pattern Indented,
  pattern Latex,
  pattern Folded,
  pattern Code,
  pattern Translated,
  pattern Special,
  -- * the interface
  -- ** for 'Output'
  type Output,
  getOutputSequence,
  getOutputSequenceWithRating,
  getOutputSequenceWithResult,
  toOutputCapable,
  -- ** for 'SpecialOutput'
  type SpecialOutput,
  checkTranslations,
  foldMapOutputBy,
  getSpecialOutputSequence,
  getSpecialOutputSequenceWithRating,
  specialToOutputCapable,
  -- ** other
  checkTranslation,
  ) where

import qualified Control.OutputCapable.Blocks.Generic.Type as Generic (
  foldMapOutputBy,
  getOutputSequence,
  getOutputSequenceWithResult,
  getOutputSequenceWithRating,
  inspectTranslations,
  toOutputCapable,
  )

import qualified Data.Map                         as M (keys)

import Control.OutputCapable.Blocks.Generic.Type (GenericOutput (..))
import Control.OutputCapable.Blocks (
  LangM,
  LangM',
  Language (English),
  OutputCapable,
  Rated,
  ReportT,
  yesNo,
  )

import Data.List                        ((\\))
import Data.Map                         (Map)

-- | 'GenericOutput' but with translations fixed to 'Language'
type SpecialOutput = GenericOutput Language

-- | 'SpecialOutput' without 'Special' elements
type Output = SpecialOutput ()

{-|
Converts non graded 'OutputCapable' value using 'GenericOutput'
into a list of 'Output'
-}
getOutputSequence :: Functor m => LangM (ReportT Output m) -> m [Output]
getOutputSequence :: forall (m :: * -> *).
Functor m =>
LangM (ReportT Output m) -> m [Output]
getOutputSequence = Language
-> GenericLangM Language (GenericReportT Language Output m) ()
-> m [Output]
forall (m :: * -> *) language element.
Functor m =>
language
-> GenericLangM
     language
     (GenericReportT language (GenericOutput language element) m)
     ()
-> m [GenericOutput language element]
Generic.getOutputSequence Language
English

{-|
Converts graded 'OutputCapable' value using 'GenericOutput'
into a rating and a list of 'Output'
-}
getOutputSequenceWithRating
  :: Functor m
  => Rated (ReportT Output m)
  -> m (Maybe Rational, [Output])
getOutputSequenceWithRating :: forall (m :: * -> *).
Functor m =>
Rated (ReportT Output m) -> m (Maybe Rational, [Output])
getOutputSequenceWithRating = LangM' (ReportT Output m) Rational -> m (Maybe Rational, [Output])
forall (m :: * -> *) a.
Functor m =>
LangM' (ReportT Output m) a -> m (Maybe a, [Output])
getOutputSequenceWithResult

{-|
Converts 'OutputCapable' value using 'GenericOutput'
into a result and a list of 'Output'

Consider using 'getOutputSequenceWithRating'
in order to get better error messages on implementation errors.
-}
getOutputSequenceWithResult
  :: Functor m
  => LangM' (ReportT Output m) a
  -> m (Maybe a, [Output])
getOutputSequenceWithResult :: forall (m :: * -> *) a.
Functor m =>
LangM' (ReportT Output m) a -> m (Maybe a, [Output])
getOutputSequenceWithResult = Language
-> GenericLangM Language (GenericReportT Language Output m) a
-> m (Maybe a, [Output])
forall (m :: * -> *) language element a.
Functor m =>
language
-> GenericLangM
     language
     (GenericReportT language (GenericOutput language element) m)
     a
-> m (Maybe a, [GenericOutput language element])
Generic.getOutputSequenceWithResult Language
English

{- |
Convert a list of 'Output' into any instance of 'OutputCapable'
-}
toOutputCapable :: OutputCapable m => [Output] -> LangM m
toOutputCapable :: forall (m :: * -> *). OutputCapable m => [Output] -> LangM m
toOutputCapable = (() -> GenericLangM Language m ())
-> (Bool
    -> GenericLangM Language m () -> GenericLangM Language m ())
-> [Output]
-> GenericLangM Language m ()
forall language (m :: * -> *) element.
GenericOutputCapable language m =>
(element -> GenericLangM language m ())
-> (Bool
    -> GenericLangM language m () -> GenericLangM language m ())
-> [GenericOutput language element]
-> GenericLangM language m ()
Generic.toOutputCapable () -> GenericLangM Language m ()
forall a. a -> GenericLangM Language m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool -> GenericLangM Language m () -> GenericLangM Language m ()
forall (m :: * -> *). OutputCapable m => Bool -> LangM m -> LangM m
yesNo

{-|
Converts non graded 'OutputCapable' value using 'GenericOutput'
into a list of 'SpecialOutput'
-}
getSpecialOutputSequence
  :: Functor m
  => LangM (ReportT (SpecialOutput element) m)
  -> m [SpecialOutput element]
getSpecialOutputSequence :: forall (m :: * -> *) element.
Functor m =>
LangM (ReportT (SpecialOutput element) m)
-> m [SpecialOutput element]
getSpecialOutputSequence = Language
-> GenericLangM
     Language
     (GenericReportT Language (GenericOutput Language element) m)
     ()
-> m [GenericOutput Language element]
forall (m :: * -> *) language element.
Functor m =>
language
-> GenericLangM
     language
     (GenericReportT language (GenericOutput language element) m)
     ()
-> m [GenericOutput language element]
Generic.getOutputSequence Language
English

{-|
Converts graded 'OutputCapable' value using 'GenericOutput'
into a rating and a list of 'SpecialOutput'
-}
getSpecialOutputSequenceWithRating
  :: Functor m
  => Rated (ReportT (SpecialOutput element) m)
  -> m (Maybe Rational, [SpecialOutput element])
getSpecialOutputSequenceWithRating :: forall (m :: * -> *) element.
Functor m =>
Rated (ReportT (SpecialOutput element) m)
-> m (Maybe Rational, [SpecialOutput element])
getSpecialOutputSequenceWithRating = Language
-> GenericLangM
     Language
     (GenericReportT Language (GenericOutput Language element) m)
     Rational
-> m (Maybe Rational, [GenericOutput Language element])
forall (m :: * -> *) language element.
Functor m =>
language
-> GenericLangM
     language
     (GenericReportT language (GenericOutput language element) m)
     Rational
-> m (Maybe Rational, [GenericOutput language element])
Generic.getOutputSequenceWithRating Language
English

{- |
Convert a list of 'SpecialOutput' into any instance of 'OutputCapable'
-}
specialToOutputCapable
  :: OutputCapable m
  => (element -> LangM m)
  -> [SpecialOutput element]
  -> LangM m
specialToOutputCapable :: forall (m :: * -> *) element.
OutputCapable m =>
(element -> LangM m) -> [SpecialOutput element] -> LangM m
specialToOutputCapable = ((element -> LangM m)
 -> (Bool -> LangM m -> LangM m)
 -> [SpecialOutput element]
 -> LangM m)
-> (Bool -> LangM m -> LangM m)
-> (element -> LangM m)
-> [SpecialOutput element]
-> LangM m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (element -> LangM m)
-> (Bool -> LangM m -> LangM m)
-> [SpecialOutput element]
-> LangM m
forall language (m :: * -> *) element.
GenericOutputCapable language m =>
(element -> GenericLangM language m ())
-> (Bool
    -> GenericLangM language m () -> GenericLangM language m ())
-> [GenericOutput language element]
-> GenericLangM language m ()
Generic.toOutputCapable Bool -> LangM m -> LangM m
forall (m :: * -> *). OutputCapable m => Bool -> LangM m -> LangM m
yesNo

{-|
A right fold with the possibility to inspect every node.

@since: 0.4
-}
foldMapOutputBy
  :: (a -> a -> a)
  -> (SpecialOutput element -> a)
  -> SpecialOutput element
  -> a
foldMapOutputBy :: forall a element.
(a -> a -> a)
-> (SpecialOutput element -> a) -> SpecialOutput element -> a
foldMapOutputBy = (a -> a -> a)
-> (GenericOutput Language element -> a)
-> GenericOutput Language element
-> a
forall a language element.
(a -> a -> a)
-> (GenericOutput language element -> a)
-> GenericOutput language element
-> a
Generic.foldMapOutputBy

{-|
Checks a 'Map' for missing translations and reports those as list.

@since: 0.3.0.2
-}
checkTranslation :: Map Language String -> [String]
checkTranslation :: Map Language String -> [String]
checkTranslation Map Language String
xs =
  let ls :: [Language]
ls = [Language
forall a. Bounded a => a
minBound ..] [Language] -> [Language] -> [Language]
forall a. Eq a => [a] -> [a] -> [a]
\\ Map Language String -> [Language]
forall k a. Map k a -> [k]
M.keys Map Language String
xs
  in ((Language -> String) -> [Language] -> [String])
-> [Language] -> (Language -> String) -> [String]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Language -> String) -> [Language] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map [Language]
ls
  ((Language -> String) -> [String])
-> (Language -> String) -> [String]
forall a b. (a -> b) -> a -> b
$ \Language
l -> String
"Missing " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Language -> String
forall a. Show a => a -> String
show Language
l String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" translation for " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Map Language String -> String
forall a. Show a => a -> String
show Map Language String
xs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"."

{-|
Checks 'SpecialOutput' for missing translations.

@since: 0.3.0.1
-}
checkTranslations
  :: (element -> [String])
  -> SpecialOutput element
  -> [String]
checkTranslations :: forall element.
(element -> [String]) -> SpecialOutput element -> [String]
checkTranslations element -> [String]
inspectSpecial =
  (element -> [String])
-> (Map Language String -> [String])
-> ([String] -> [String] -> [String])
-> [String]
-> GenericOutput Language element
-> [String]
forall element a language.
(element -> a)
-> (Map language String -> a)
-> (a -> a -> a)
-> a
-> GenericOutput language element
-> a
Generic.inspectTranslations element -> [String]
inspectSpecial Map Language String -> [String]
checkTranslation [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
(++) []