{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE OverloadedLabels #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE NoFieldSelectors #-}

module WikiMusic.SSR.Language
  ( DictTerm (..),
    Titles (..),
    Errors (..),
    Slogans (..),
    LanguageDict (..),
    More (..),
    Forms (..),
    Sortings (..),
    towerOfBabel,
    dictionary,
    (|##|),
  )
where

import Data.Text (unpack)
import Optics
import Relude
import WikiMusic.SSR.Model.Api

data DictTerm = DictTerm
  { DictTerm -> Text
en :: Text,
    DictTerm -> Text
nl :: Text
  }
  deriving (DictTerm -> DictTerm -> Bool
(DictTerm -> DictTerm -> Bool)
-> (DictTerm -> DictTerm -> Bool) -> Eq DictTerm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DictTerm -> DictTerm -> Bool
== :: DictTerm -> DictTerm -> Bool
$c/= :: DictTerm -> DictTerm -> Bool
/= :: DictTerm -> DictTerm -> Bool
Eq, (forall x. DictTerm -> Rep DictTerm x)
-> (forall x. Rep DictTerm x -> DictTerm) -> Generic DictTerm
forall x. Rep DictTerm x -> DictTerm
forall x. DictTerm -> Rep DictTerm x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. DictTerm -> Rep DictTerm x
from :: forall x. DictTerm -> Rep DictTerm x
$cto :: forall x. Rep DictTerm x -> DictTerm
to :: forall x. Rep DictTerm x -> DictTerm
Generic, Int -> DictTerm -> ShowS
[DictTerm] -> ShowS
DictTerm -> String
(Int -> DictTerm -> ShowS)
-> (DictTerm -> String) -> ([DictTerm] -> ShowS) -> Show DictTerm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DictTerm -> ShowS
showsPrec :: Int -> DictTerm -> ShowS
$cshow :: DictTerm -> String
show :: DictTerm -> String
$cshowList :: [DictTerm] -> ShowS
showList :: [DictTerm] -> ShowS
Show)

makeFieldLabelsNoPrefix ''DictTerm

data Titles = Titles
  { Titles -> DictTerm
wikimusicSSR :: DictTerm,
    Titles -> DictTerm
errorOccurred :: DictTerm,
    Titles -> DictTerm
artistsPage :: DictTerm,
    Titles -> DictTerm
genresPage :: DictTerm,
    Titles -> DictTerm
songsPage :: DictTerm,
    Titles -> DictTerm
login :: DictTerm
  }
  deriving (Titles -> Titles -> Bool
(Titles -> Titles -> Bool)
-> (Titles -> Titles -> Bool) -> Eq Titles
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Titles -> Titles -> Bool
== :: Titles -> Titles -> Bool
$c/= :: Titles -> Titles -> Bool
/= :: Titles -> Titles -> Bool
Eq, (forall x. Titles -> Rep Titles x)
-> (forall x. Rep Titles x -> Titles) -> Generic Titles
forall x. Rep Titles x -> Titles
forall x. Titles -> Rep Titles x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Titles -> Rep Titles x
from :: forall x. Titles -> Rep Titles x
$cto :: forall x. Rep Titles x -> Titles
to :: forall x. Rep Titles x -> Titles
Generic, Int -> Titles -> ShowS
[Titles] -> ShowS
Titles -> String
(Int -> Titles -> ShowS)
-> (Titles -> String) -> ([Titles] -> ShowS) -> Show Titles
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Titles -> ShowS
showsPrec :: Int -> Titles -> ShowS
$cshow :: Titles -> String
show :: Titles -> String
$cshowList :: [Titles] -> ShowS
showList :: [Titles] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Titles

data Errors = Errors
  { Errors -> DictTerm
clientError :: DictTerm
  }
  deriving (Errors -> Errors -> Bool
(Errors -> Errors -> Bool)
-> (Errors -> Errors -> Bool) -> Eq Errors
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Errors -> Errors -> Bool
== :: Errors -> Errors -> Bool
$c/= :: Errors -> Errors -> Bool
/= :: Errors -> Errors -> Bool
Eq, (forall x. Errors -> Rep Errors x)
-> (forall x. Rep Errors x -> Errors) -> Generic Errors
forall x. Rep Errors x -> Errors
forall x. Errors -> Rep Errors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Errors -> Rep Errors x
from :: forall x. Errors -> Rep Errors x
$cto :: forall x. Rep Errors x -> Errors
to :: forall x. Rep Errors x -> Errors
Generic, Int -> Errors -> ShowS
[Errors] -> ShowS
Errors -> String
(Int -> Errors -> ShowS)
-> (Errors -> String) -> ([Errors] -> ShowS) -> Show Errors
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Errors -> ShowS
showsPrec :: Int -> Errors -> ShowS
$cshow :: Errors -> String
show :: Errors -> String
$cshowList :: [Errors] -> ShowS
showList :: [Errors] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Errors

data More = More
  { More -> DictTerm
likes :: DictTerm,
    More -> DictTerm
dislikes :: DictTerm,
    More -> DictTerm
artistsNav :: DictTerm,
    More -> DictTerm
genresNav :: DictTerm,
    More -> DictTerm
songsNav :: DictTerm,
    More -> DictTerm
loginNav :: DictTerm,
    More -> DictTerm
views :: DictTerm,
    More -> DictTerm
warningHeavyDevelopment :: DictTerm,
    More -> DictTerm
createdBy :: DictTerm,
    More -> DictTerm
createdAt :: DictTerm,
    More -> DictTerm
lastEditedAt :: DictTerm,
    More -> DictTerm
musicTuning :: DictTerm,
    More -> DictTerm
musicKey :: DictTerm,
    More -> DictTerm
musicCreationDate :: DictTerm,
    More -> DictTerm
albumName :: DictTerm,
    More -> DictTerm
albumInfoLink :: DictTerm
  }
  deriving (More -> More -> Bool
(More -> More -> Bool) -> (More -> More -> Bool) -> Eq More
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: More -> More -> Bool
== :: More -> More -> Bool
$c/= :: More -> More -> Bool
/= :: More -> More -> Bool
Eq, (forall x. More -> Rep More x)
-> (forall x. Rep More x -> More) -> Generic More
forall x. Rep More x -> More
forall x. More -> Rep More x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. More -> Rep More x
from :: forall x. More -> Rep More x
$cto :: forall x. Rep More x -> More
to :: forall x. Rep More x -> More
Generic, Int -> More -> ShowS
[More] -> ShowS
More -> String
(Int -> More -> ShowS)
-> (More -> String) -> ([More] -> ShowS) -> Show More
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> More -> ShowS
showsPrec :: Int -> More -> ShowS
$cshow :: More -> String
show :: More -> String
$cshowList :: [More] -> ShowS
showList :: [More] -> ShowS
Show)

makeFieldLabelsNoPrefix ''More

data Slogans = Slogans
  { Slogans -> DictTerm
pageTop :: DictTerm
  }
  deriving (Slogans -> Slogans -> Bool
(Slogans -> Slogans -> Bool)
-> (Slogans -> Slogans -> Bool) -> Eq Slogans
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Slogans -> Slogans -> Bool
== :: Slogans -> Slogans -> Bool
$c/= :: Slogans -> Slogans -> Bool
/= :: Slogans -> Slogans -> Bool
Eq, (forall x. Slogans -> Rep Slogans x)
-> (forall x. Rep Slogans x -> Slogans) -> Generic Slogans
forall x. Rep Slogans x -> Slogans
forall x. Slogans -> Rep Slogans x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Slogans -> Rep Slogans x
from :: forall x. Slogans -> Rep Slogans x
$cto :: forall x. Rep Slogans x -> Slogans
to :: forall x. Rep Slogans x -> Slogans
Generic, Int -> Slogans -> ShowS
[Slogans] -> ShowS
Slogans -> String
(Int -> Slogans -> ShowS)
-> (Slogans -> String) -> ([Slogans] -> ShowS) -> Show Slogans
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Slogans -> ShowS
showsPrec :: Int -> Slogans -> ShowS
$cshow :: Slogans -> String
show :: Slogans -> String
$cshowList :: [Slogans] -> ShowS
showList :: [Slogans] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Slogans

data Forms = Forms
  { Forms -> DictTerm
email :: DictTerm,
    Forms -> DictTerm
password :: DictTerm,
    Forms -> DictTerm
submit :: DictTerm
  }
  deriving (Forms -> Forms -> Bool
(Forms -> Forms -> Bool) -> (Forms -> Forms -> Bool) -> Eq Forms
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Forms -> Forms -> Bool
== :: Forms -> Forms -> Bool
$c/= :: Forms -> Forms -> Bool
/= :: Forms -> Forms -> Bool
Eq, (forall x. Forms -> Rep Forms x)
-> (forall x. Rep Forms x -> Forms) -> Generic Forms
forall x. Rep Forms x -> Forms
forall x. Forms -> Rep Forms x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Forms -> Rep Forms x
from :: forall x. Forms -> Rep Forms x
$cto :: forall x. Rep Forms x -> Forms
to :: forall x. Rep Forms x -> Forms
Generic, Int -> Forms -> ShowS
[Forms] -> ShowS
Forms -> String
(Int -> Forms -> ShowS)
-> (Forms -> String) -> ([Forms] -> ShowS) -> Show Forms
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Forms -> ShowS
showsPrec :: Int -> Forms -> ShowS
$cshow :: Forms -> String
show :: Forms -> String
$cshowList :: [Forms] -> ShowS
showList :: [Forms] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Forms

data Sortings = Sortings
  { Sortings -> DictTerm
alphabeticalAsc :: DictTerm,
    Sortings -> DictTerm
alphabeticalDesc :: DictTerm,
    Sortings -> DictTerm
createdAtAsc :: DictTerm,
    Sortings -> DictTerm
createdAtDesc :: DictTerm
  }
  deriving (Sortings -> Sortings -> Bool
(Sortings -> Sortings -> Bool)
-> (Sortings -> Sortings -> Bool) -> Eq Sortings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Sortings -> Sortings -> Bool
== :: Sortings -> Sortings -> Bool
$c/= :: Sortings -> Sortings -> Bool
/= :: Sortings -> Sortings -> Bool
Eq, (forall x. Sortings -> Rep Sortings x)
-> (forall x. Rep Sortings x -> Sortings) -> Generic Sortings
forall x. Rep Sortings x -> Sortings
forall x. Sortings -> Rep Sortings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Sortings -> Rep Sortings x
from :: forall x. Sortings -> Rep Sortings x
$cto :: forall x. Rep Sortings x -> Sortings
to :: forall x. Rep Sortings x -> Sortings
Generic, Int -> Sortings -> ShowS
[Sortings] -> ShowS
Sortings -> String
(Int -> Sortings -> ShowS)
-> (Sortings -> String) -> ([Sortings] -> ShowS) -> Show Sortings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Sortings -> ShowS
showsPrec :: Int -> Sortings -> ShowS
$cshow :: Sortings -> String
show :: Sortings -> String
$cshowList :: [Sortings] -> ShowS
showList :: [Sortings] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Sortings

data Buttons = Buttons
  { Buttons -> DictTerm
edit :: DictTerm,
    Buttons -> DictTerm
delete :: DictTerm,
    Buttons -> DictTerm
like :: DictTerm,
    Buttons -> DictTerm
dislike :: DictTerm
  }
  deriving (Buttons -> Buttons -> Bool
(Buttons -> Buttons -> Bool)
-> (Buttons -> Buttons -> Bool) -> Eq Buttons
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Buttons -> Buttons -> Bool
== :: Buttons -> Buttons -> Bool
$c/= :: Buttons -> Buttons -> Bool
/= :: Buttons -> Buttons -> Bool
Eq, (forall x. Buttons -> Rep Buttons x)
-> (forall x. Rep Buttons x -> Buttons) -> Generic Buttons
forall x. Rep Buttons x -> Buttons
forall x. Buttons -> Rep Buttons x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. Buttons -> Rep Buttons x
from :: forall x. Buttons -> Rep Buttons x
$cto :: forall x. Rep Buttons x -> Buttons
to :: forall x. Rep Buttons x -> Buttons
Generic, Int -> Buttons -> ShowS
[Buttons] -> ShowS
Buttons -> String
(Int -> Buttons -> ShowS)
-> (Buttons -> String) -> ([Buttons] -> ShowS) -> Show Buttons
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Buttons -> ShowS
showsPrec :: Int -> Buttons -> ShowS
$cshow :: Buttons -> String
show :: Buttons -> String
$cshowList :: [Buttons] -> ShowS
showList :: [Buttons] -> ShowS
Show)

makeFieldLabelsNoPrefix ''Buttons

data LanguageDict = LanguageDict
  { LanguageDict -> Titles
titles :: Titles,
    LanguageDict -> Errors
errors :: Errors,
    LanguageDict -> Slogans
slogans :: Slogans,
    LanguageDict -> More
more :: More,
    LanguageDict -> Forms
forms :: Forms,
    LanguageDict -> Sortings
sortings :: Sortings,
    LanguageDict -> Buttons
buttons :: Buttons
  }
  deriving (LanguageDict -> LanguageDict -> Bool
(LanguageDict -> LanguageDict -> Bool)
-> (LanguageDict -> LanguageDict -> Bool) -> Eq LanguageDict
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LanguageDict -> LanguageDict -> Bool
== :: LanguageDict -> LanguageDict -> Bool
$c/= :: LanguageDict -> LanguageDict -> Bool
/= :: LanguageDict -> LanguageDict -> Bool
Eq, (forall x. LanguageDict -> Rep LanguageDict x)
-> (forall x. Rep LanguageDict x -> LanguageDict)
-> Generic LanguageDict
forall x. Rep LanguageDict x -> LanguageDict
forall x. LanguageDict -> Rep LanguageDict x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cfrom :: forall x. LanguageDict -> Rep LanguageDict x
from :: forall x. LanguageDict -> Rep LanguageDict x
$cto :: forall x. Rep LanguageDict x -> LanguageDict
to :: forall x. Rep LanguageDict x -> LanguageDict
Generic, Int -> LanguageDict -> ShowS
[LanguageDict] -> ShowS
LanguageDict -> String
(Int -> LanguageDict -> ShowS)
-> (LanguageDict -> String)
-> ([LanguageDict] -> ShowS)
-> Show LanguageDict
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LanguageDict -> ShowS
showsPrec :: Int -> LanguageDict -> ShowS
$cshow :: LanguageDict -> String
show :: LanguageDict -> String
$cshowList :: [LanguageDict] -> ShowS
showList :: [LanguageDict] -> ShowS
Show)

makeFieldLabelsNoPrefix ''LanguageDict

dictionary :: LanguageDict
dictionary :: LanguageDict
dictionary =
  LanguageDict
    { $sel:titles:LanguageDict :: Titles
titles =
        Titles
          { $sel:wikimusicSSR:Titles :: DictTerm
wikimusicSSR = DictTerm {$sel:en:DictTerm :: Text
en = Text
"WikiMusic", $sel:nl:DictTerm :: Text
nl = Text
"WikiMusic"},
            $sel:errorOccurred:Titles :: DictTerm
errorOccurred = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Error occurred!", $sel:nl:DictTerm :: Text
nl = Text
"Fout opgetreden"},
            $sel:artistsPage:Titles :: DictTerm
artistsPage = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Artists", $sel:nl:DictTerm :: Text
nl = Text
"Artiesten"},
            $sel:genresPage:Titles :: DictTerm
genresPage = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Genres", $sel:nl:DictTerm :: Text
nl = Text
"Genres"},
            $sel:songsPage:Titles :: DictTerm
songsPage = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Songs", $sel:nl:DictTerm :: Text
nl = Text
"Nummers"},
            $sel:login:Titles :: DictTerm
login = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Login", $sel:nl:DictTerm :: Text
nl = Text
"Inloggen"}
          },
      $sel:forms:LanguageDict :: Forms
forms =
        Forms
          { $sel:email:Forms :: DictTerm
email = DictTerm {$sel:en:DictTerm :: Text
en = Text
"email address:", $sel:nl:DictTerm :: Text
nl = Text
"emailadres:"},
            $sel:password:Forms :: DictTerm
password = DictTerm {$sel:en:DictTerm :: Text
en = Text
"password:", $sel:nl:DictTerm :: Text
nl = Text
"wachtwoord:"},
            $sel:submit:Forms :: DictTerm
submit = DictTerm {$sel:en:DictTerm :: Text
en = Text
"submit", $sel:nl:DictTerm :: Text
nl = Text
"indienen"}
          },
      $sel:errors:LanguageDict :: Errors
errors =
        Errors
          { $sel:clientError:Errors :: DictTerm
clientError = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Client error!", $sel:nl:DictTerm :: Text
nl = Text
"Client error!"}
          },
      $sel:buttons:LanguageDict :: Buttons
buttons =
        Buttons
          { $sel:edit:Buttons :: DictTerm
edit = DictTerm {$sel:en:DictTerm :: Text
en = Text
"edit", $sel:nl:DictTerm :: Text
nl = Text
"bewerken"},
            $sel:delete:Buttons :: DictTerm
delete = DictTerm {$sel:en:DictTerm :: Text
en = Text
"delete", $sel:nl:DictTerm :: Text
nl = Text
"verwijderen"},
            $sel:like:Buttons :: DictTerm
like = DictTerm {$sel:en:DictTerm :: Text
en = Text
"like", $sel:nl:DictTerm :: Text
nl = Text
"leuk"},
            $sel:dislike:Buttons :: DictTerm
dislike = DictTerm {$sel:en:DictTerm :: Text
en = Text
"dislike", $sel:nl:DictTerm :: Text
nl = Text
"niet leuk"}
          },
      $sel:slogans:LanguageDict :: Slogans
slogans =
        Slogans
          { $sel:pageTop:Slogans :: DictTerm
pageTop =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"Welcome to the music knowledge sharing community 🎼",
                  $sel:nl:DictTerm :: Text
nl = Text
"Welkom bij de gemeenschap waar je muziek kennis kan delen 🎼"
                }
          },
      $sel:sortings:LanguageDict :: Sortings
sortings =
        Sortings
          { $sel:alphabeticalAsc:Sortings :: DictTerm
alphabeticalAsc = DictTerm {$sel:en:DictTerm :: Text
en = Text
"alphabetical - asc", $sel:nl:DictTerm :: Text
nl = Text
"alfabetisch - opl"},
            $sel:alphabeticalDesc:Sortings :: DictTerm
alphabeticalDesc = DictTerm {$sel:en:DictTerm :: Text
en = Text
"alphabetical - desc", $sel:nl:DictTerm :: Text
nl = Text
"alfabetisch - afl"},
            $sel:createdAtAsc:Sortings :: DictTerm
createdAtAsc = DictTerm {$sel:en:DictTerm :: Text
en = Text
"created at - asc", $sel:nl:DictTerm :: Text
nl = Text
"datum gemaakt - opl"},
            $sel:createdAtDesc:Sortings :: DictTerm
createdAtDesc = DictTerm {$sel:en:DictTerm :: Text
en = Text
"created at - desc", $sel:nl:DictTerm :: Text
nl = Text
"datum gemaakt - afl"}
          },
      $sel:more:LanguageDict :: More
more =
        More
          { $sel:likes:More :: DictTerm
likes =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"likes",
                  $sel:nl:DictTerm :: Text
nl = Text
"leuks"
                },
            $sel:dislikes:More :: DictTerm
dislikes =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"dislikes",
                  $sel:nl:DictTerm :: Text
nl = Text
"niet leuks"
                },
            $sel:artistsNav:More :: DictTerm
artistsNav =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"Artists",
                  $sel:nl:DictTerm :: Text
nl = Text
"Artiesten"
                },
            $sel:genresNav:More :: DictTerm
genresNav =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"Genres",
                  $sel:nl:DictTerm :: Text
nl = Text
"Genres"
                },
            $sel:songsNav:More :: DictTerm
songsNav =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"Songs",
                  $sel:nl:DictTerm :: Text
nl = Text
"Nummers"
                },
            $sel:loginNav:More :: DictTerm
loginNav =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"Login",
                  $sel:nl:DictTerm :: Text
nl = Text
"Inloggen"
                },
            $sel:views:More :: DictTerm
views =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"views",
                  $sel:nl:DictTerm :: Text
nl = Text
"weergaven"
                },
            $sel:createdBy:More :: DictTerm
createdBy =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"added by:",
                  $sel:nl:DictTerm :: Text
nl = Text
"toegevoeg door:"
                },
            $sel:createdAt:More :: DictTerm
createdAt =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"date created:",
                  $sel:nl:DictTerm :: Text
nl = Text
"datum gemaakt:"
                },
            $sel:lastEditedAt:More :: DictTerm
lastEditedAt =
              DictTerm
                { $sel:en:DictTerm :: Text
en = Text
"last edited at:",
                  $sel:nl:DictTerm :: Text
nl = Text
"laatst bijgewerkt:"
                },
            $sel:warningHeavyDevelopment:More :: DictTerm
warningHeavyDevelopment = DictTerm {$sel:en:DictTerm :: Text
en = Text
"Warning! WikiMusic is ongoing an experimental stage! Certain features will not work and are being fixed.", $sel:nl:DictTerm :: Text
nl = Text
"Let op! WikiMusic is momenteel in een experimentele periode. Hou rekening met de feit dat sommige functies niet zullen werken, er wordt aan gewerkt. "},
            $sel:musicTuning:More :: DictTerm
musicTuning = DictTerm {$sel:en:DictTerm :: Text
en = Text
"tuning:", $sel:nl:DictTerm :: Text
nl = Text
"stemming:"},
            $sel:musicKey:More :: DictTerm
musicKey = DictTerm {$sel:en:DictTerm :: Text
en = Text
"music key:", $sel:nl:DictTerm :: Text
nl = Text
"muziek key:"},
            $sel:musicCreationDate:More :: DictTerm
musicCreationDate = DictTerm {$sel:en:DictTerm :: Text
en = Text
"music creation:", $sel:nl:DictTerm :: Text
nl = Text
"muziek geschreven:"},
            $sel:albumName:More :: DictTerm
albumName = DictTerm {$sel:en:DictTerm :: Text
en = Text
"album name:", $sel:nl:DictTerm :: Text
nl = Text
"album naam:"},
            $sel:albumInfoLink:More :: DictTerm
albumInfoLink = DictTerm {$sel:en:DictTerm :: Text
en = Text
"album info:", $sel:nl:DictTerm :: Text
nl = Text
"info over album:"}
          }
    }

translateTerm :: Text -> DictTerm -> Text
translateTerm :: Text -> DictTerm -> Text
translateTerm Text
"nl" DictTerm
x = DictTerm
x DictTerm -> Optic' A_Lens NoIx DictTerm Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DictTerm Text
#nl
translateTerm Text
_ DictTerm
x = DictTerm
x DictTerm -> Optic' A_Lens NoIx DictTerm Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' A_Lens NoIx DictTerm Text
#en

towerOfBabel :: Language -> DictTerm -> Text
towerOfBabel :: Language -> DictTerm -> Text
towerOfBabel Language
language DictTerm
x = String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
unpack (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> DictTerm -> Text
translateTerm (Language
language Language -> Optic' An_Iso NoIx Language Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Optic' An_Iso NoIx Language Text
#value) DictTerm
x

-- towerOfBabel alias
infixl 8 |##|

(|##|) :: DictTerm -> Language -> Text
|##| :: DictTerm -> Language -> Text
(|##|) DictTerm
x Language
language = Language -> DictTerm -> Text
towerOfBabel Language
language DictTerm
x