40 lines
1.2 KiB
Haskell
40 lines
1.2 KiB
Haskell
{-# LANGUAGE NoImplicitPrelude #-}
|
|
{-# LANGUAGE ViewPatterns #-}
|
|
{-# LANGUAGE OverloadedStrings #-}
|
|
|
|
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
|
|
= case found of
|
|
Just l' -> l'
|
|
Nothing -> selectLanguage' avL $ Text.intercalate "-" (NonEmpty.tail lParts) : ls
|
|
| otherwise = selectLanguage' avL ls
|
|
|
|
langMatches :: Lang -- ^ Needle
|
|
-> Lang -- ^ Haystack
|
|
-> Bool
|
|
langMatches = isPrefixOf `on` Text.splitOn "-"
|