{-# language DeriveGeneric #-}

module Autolib.Multilingual where

import Data.List ( nub )
import qualified Data.Map
import Data.Map ( Map )

import Data.Autolib.Transport

import Data.String
import GHC.Generics

data Language = DE | UK | NL
    deriving ( ReadPrec [Language]
ReadPrec Language
Int -> ReadS Language
ReadS [Language]
(Int -> ReadS Language)
-> ReadS [Language]
-> ReadPrec Language
-> ReadPrec [Language]
-> Read Language
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Language
readsPrec :: Int -> ReadS Language
$creadList :: ReadS [Language]
readList :: ReadS [Language]
$creadPrec :: ReadPrec Language
readPrec :: ReadPrec Language
$creadListPrec :: ReadPrec [Language]
readListPrec :: ReadPrec [Language]
Read, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Language -> ShowS
showsPrec :: Int -> Language -> ShowS
$cshow :: Language -> String
show :: Language -> String
$cshowList :: [Language] -> ShowS
showList :: [Language] -> ShowS
Show, Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
/= :: Language -> Language -> Bool
Eq, Eq Language
Eq Language =>
(Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: Language -> Language -> Ordering
compare :: Language -> Language -> Ordering
$c< :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
>= :: Language -> Language -> Bool
$cmax :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
min :: Language -> Language -> Language
Ord, Language
Language -> Language -> Bounded Language
forall a. a -> a -> Bounded a
$cminBound :: Language
minBound :: Language
$cmaxBound :: Language
maxBound :: Language
Bounded, Int -> Language
Language -> Int
Language -> [Language]
Language -> Language
Language -> Language -> [Language]
Language -> Language -> Language -> [Language]
(Language -> Language)
-> (Language -> Language)
-> (Int -> Language)
-> (Language -> Int)
-> (Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> [Language])
-> (Language -> Language -> Language -> [Language])
-> Enum Language
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: Language -> Language
succ :: Language -> Language
$cpred :: Language -> Language
pred :: Language -> Language
$ctoEnum :: Int -> Language
toEnum :: Int -> Language
$cfromEnum :: Language -> Int
fromEnum :: Language -> Int
$cenumFrom :: Language -> [Language]
enumFrom :: Language -> [Language]
$cenumFromThen :: Language -> Language -> [Language]
enumFromThen :: Language -> Language -> [Language]
$cenumFromTo :: Language -> Language -> [Language]
enumFromTo :: Language -> Language -> [Language]
$cenumFromThenTo :: Language -> Language -> Language -> [Language]
enumFromThenTo :: Language -> Language -> Language -> [Language]
Enum, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Language -> Rep Language x
from :: forall x. Language -> Rep Language x
$cto :: forall x. Rep Language x -> Language
to :: forall x. Rep Language x -> Language
Generic )

languages :: [Language]
languages :: [Language]
languages = [Language
forall a. Bounded a => a
minBound .. Language
forall a. Bounded a => a
maxBound]

instance ToTransport Language where
    toTransport :: forall atom. Atom atom => Language -> Trans atom
toTransport = Int -> Trans atom
forall atom. Atom atom => Int -> Trans atom
forall a atom. (ToTransport a, Atom atom) => a -> Trans atom
toTransport (Int -> Trans atom) -> (Language -> Int) -> Language -> Trans atom
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Int
forall a. Enum a => a -> Int
fromEnum
    fromTransport :: forall atom. Atom atom => Trans atom -> Error Language
fromTransport = (Int -> Language) -> Error Int -> Error Language
forall a b. (a -> b) -> Error a -> Error b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Int -> Language
forall a. Enum a => Int -> a
toEnum (Error Int -> Error Language)
-> (Trans atom -> Error Int) -> Trans atom -> Error Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Trans atom -> Error Int
forall atom. Atom atom => Trans atom -> Error Int
forall a atom. (ToTransport a, Atom atom) => Trans atom -> Error a
fromTransport

-- | implementation note:
-- all languages must be present as keys in the map.
-- otherwise this adds too much strictness.
-- we need that ($$) is lazy in the second argument
-- (for lazily outputting kommentar of a reporter
-- that is still running)

data Type a = Make 
         { forall a. Type a -> Map Language a
contents :: Map Language a
         }

instance Functor Type where 
    fmap :: forall a b. (a -> b) -> Type a -> Type b
fmap = (a -> b) -> Type a -> Type b
forall a b. (a -> b) -> Type a -> Type b
fold_unary

instance IsString a => IsString (Type a) where
  fromString :: String -> Type a
fromString = a -> Type a
forall {a}. a -> Type a
uniform (a -> Type a) -> (String -> a) -> String -> Type a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. IsString a => String -> a
fromString 

-- | use several languages
make :: [(Language, a)] -> Type a
make :: forall a. [(Language, a)] -> Type a
make [(Language, a)]
arg = Make { contents :: Map Language a
contents = [(Language, a)] -> Map Language a
forall k a. Ord k => [(k, a)] -> Map k a
Data.Map.fromList [(Language, a)]
arg }

-- | pick the version for this language.
-- if not available, then pick version for any language.
specialize :: Language -> Type a -> a
specialize :: forall a. Language -> Type a -> a
specialize Language
lang Type a
doc = 
    case Language -> Map Language a -> Maybe a
forall k a. Ord k => k -> Map k a -> Maybe a
Data.Map.lookup Language
lang ( Type a -> Map Language a
forall a. Type a -> Map Language a
contents Type a
doc )  of
        Just a
this -> a
this
        Maybe a
Nothing   -> 
             case Map Language a -> [a]
forall k a. Map k a -> [a]
Data.Map.elems ( Type a -> Map Language a
forall a. Type a -> Map Language a
contents Type a
doc ) of
                a
this : [a]
_ -> a
this
                []    -> String -> a
forall a. HasCallStack => String -> a
error (String -> a) -> String -> a
forall a b. (a -> b) -> a -> b
$ String
"no output (for any language)"

-- * Combinators

-- see remarks on laziness above. 

fold_nullary :: a -> Type a
fold_nullary = a -> Type a
forall {a}. a -> Type a
uniform

fold_unary :: ( a -> b )
           -> Type a
           -> Type b
fold_unary :: forall a b. (a -> b) -> Type a -> Type b
fold_unary a -> b
op Type a
x = [(Language, b)] -> Type b
forall a. [(Language, a)] -> Type a
make
   ([(Language, b)] -> Type b) -> [(Language, b)] -> Type b
forall a b. (a -> b) -> a -> b
$ (Language -> (Language, b)) -> [Language] -> [(Language, b)]
forall a b. (a -> b) -> [a] -> [b]
map ( \ Language
l -> (Language
l, a -> b
op (a -> b) -> a -> b
forall a b. (a -> b) -> a -> b
$ Language -> Type a -> a
forall a. Language -> Type a -> a
specialize Language
l Type a
x))
   ([Language] -> [(Language, b)]) -> [Language] -> [(Language, b)]
forall a b. (a -> b) -> a -> b
$ [Language]
languages

fold_binary :: ( a -> a -> a ) 
      -> Type a -> Type a
      -> Type a
fold_binary :: forall a. (a -> a -> a) -> Type a -> Type a -> Type a
fold_binary a -> a -> a
op Type a
x Type a
y = [(Language, a)] -> Type a
forall a. [(Language, a)] -> Type a
make
   ([(Language, a)] -> Type a) -> [(Language, a)] -> Type a
forall a b. (a -> b) -> a -> b
$ (Language -> (Language, a)) -> [Language] -> [(Language, a)]
forall a b. (a -> b) -> [a] -> [b]
map ( \ Language
l -> (Language
l, a -> a -> a
op (Language -> Type a -> a
forall a. Language -> Type a -> a
specialize Language
l Type a
x)(Language -> Type a -> a
forall a. Language -> Type a -> a
specialize Language
l Type a
y)))
   ([Language] -> [(Language, a)]) -> [Language] -> [(Language, a)]
forall a b. (a -> b) -> a -> b
$ [Language]
languages

fold_list :: ( [ a ] -> b ) 
      -> [ Type a ]
      -> Type b
fold_list :: forall a b. ([a] -> b) -> [Type a] -> Type b
fold_list [a] -> b
op [Type a]
xs = [(Language, b)] -> Type b
forall a. [(Language, a)] -> Type a
make
    ([(Language, b)] -> Type b) -> [(Language, b)] -> Type b
forall a b. (a -> b) -> a -> b
$ (Language -> (Language, b)) -> [Language] -> [(Language, b)]
forall a b. (a -> b) -> [a] -> [b]
map ( \ Language
l -> (Language
l, [a] -> b
op ((Type a -> a) -> [Type a] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (Language -> Type a -> a
forall a. Language -> Type a -> a
specialize Language
l) [Type a]
xs)))
    ([Language] -> [(Language, b)]) -> [Language] -> [(Language, b)]
forall a b. (a -> b) -> a -> b
$ [Language]
languages

uniform :: a -> Type a
uniform a
d = [(Language, a)] -> Type a
forall a. [(Language, a)] -> Type a
make
      ([(Language, a)] -> Type a) -> [(Language, a)] -> Type a
forall a b. (a -> b) -> a -> b
$ do l <- [ Language
forall a. Bounded a => a
minBound .. Language
forall a. Bounded a => a
maxBound ] ; return ( l, d )