35 lines
1.1 KiB
Haskell
35 lines
1.1 KiB
Haskell
module Utils.Lang where
|
|
|
|
import ClassyPrelude.Yesod
|
|
|
|
import qualified Data.List.NonEmpty as NonEmpty
|
|
import Data.List.NonEmpty (NonEmpty(..))
|
|
|
|
import qualified Data.Text as Text
|
|
import qualified Data.List as List
|
|
|
|
|
|
selectLanguage :: MonadHandler m
|
|
=> NonEmpty Lang -- ^ Available translations, first is default
|
|
-> m Lang
|
|
selectLanguage avL = selectLanguage' avL <$> languages
|
|
|
|
selectLanguage' :: NonEmpty Lang -- ^ Available translations, first is default
|
|
-> [Lang] -- ^ Languages in preference order
|
|
-> Lang
|
|
selectLanguage' (defL :| _) [] = defL
|
|
selectLanguage' avL (l:ls)
|
|
| not $ null l
|
|
, Just lParts <- NonEmpty.nonEmpty $ Text.splitOn "-" l
|
|
, found <- [ l' | lParts' <- reverse . List.inits $ NonEmpty.toList lParts
|
|
, l' <- NonEmpty.toList avL
|
|
, langMatches (Text.intercalate "-" lParts') l'
|
|
]
|
|
= fromMaybe (selectLanguage' avL ls) $ listToMaybe found
|
|
| otherwise = selectLanguage' avL ls
|
|
|
|
langMatches :: Lang -- ^ Needle
|
|
-> Lang -- ^ Haystack
|
|
-> Bool
|
|
langMatches = isPrefixOf `on` Text.splitOn "-"
|