34 lines
1.1 KiB
Haskell
34 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
|
|
|
|
|
|
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 l' <- find (== l) (NonEmpty.toList avL)
|
|
= l'
|
|
| not $ null l
|
|
, Just lParts <- NonEmpty.nonEmpty $ Text.splitOn "-" l
|
|
, found <- find ((NonEmpty.toList lParts `isPrefixOf`) . Text.splitOn "-") avL
|
|
= flip fromMaybe found $ selectLanguage' avL $ Text.intercalate "-" (NonEmpty.tail lParts) : ls
|
|
| otherwise = selectLanguage' avL ls
|
|
|
|
langMatches :: Lang -- ^ Needle
|
|
-> Lang -- ^ Haystack
|
|
-> Bool
|
|
langMatches = isPrefixOf `on` Text.splitOn "-"
|