module Network.HTTP.Media.Language.Internal
( Language (..)
, toList
, toByteString
) where
import qualified Data.ByteString as BS
import qualified Data.ByteString.UTF8 as BS hiding (length)
import Control.Monad (guard)
import Data.ByteString (ByteString)
import Data.Functor ((<$>))
import Data.List (isPrefixOf)
import Data.Maybe (fromMaybe)
import Data.String (IsString (..))
import Network.HTTP.Media.Accept (Accept (..))
import Network.HTTP.Media.Utils (hyphen, isAlpha)
newtype Language = Language [ByteString]
deriving (Eq)
instance Show Language where
show = BS.toString . toByteString
instance IsString Language where
fromString "*" = Language []
fromString str = flip fromMaybe (parseAccept $ BS.fromString str) $
error $ "Invalid language literal " ++ str
instance Accept Language where
parseAccept "*" = Just $ Language []
parseAccept bs = do
let pieces = BS.split hyphen bs
guard $ not (null pieces)
Language <$> mapM check pieces
where
check part = do
let len = BS.length part
guard $ len >= 1 && len <= 8 && BS.all isAlpha part
return part
matches (Language a) (Language b) = b `isPrefixOf` a
moreSpecificThan (Language a) (Language b) =
b `isPrefixOf` a && length a > length b
toList :: Language -> [ByteString]
toList (Language l) = l
toByteString :: Language -> ByteString
toByteString (Language []) = "*"
toByteString (Language l) = BS.intercalate "-" l