{-# OPTIONS -fno-warn-orphans #-}
module Debian.Version.Text
    ( ParseDebianVersion(..)
    ) where

import Text.ParserCombinators.Parsec

import qualified Data.Text as T

import Debian.Version.Common
import Debian.Version.Internal

instance ParseDebianVersion T.Text where
    parseDebianVersion :: Text -> Either ParseError DebianVersion
parseDebianVersion Text
text =
        let str :: String
str = Text -> String
T.unpack Text
text in
        case Parsec String () (Found Int, NonNumeric, Found NonNumeric)
-> String
-> String
-> Either ParseError (Found Int, NonNumeric, Found NonNumeric)
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec String () (Found Int, NonNumeric, Found NonNumeric)
parseDV String
str String
str of
          Left ParseError
e -> ParseError -> Either ParseError DebianVersion
forall a b. a -> Either a b
Left ParseError
e
          Right (Found Int, NonNumeric, Found NonNumeric)
dv -> DebianVersion -> Either ParseError DebianVersion
forall a b. b -> Either a b
Right (String
-> (Found Int, NonNumeric, Found NonNumeric) -> DebianVersion
DebianVersion String
str (Found Int, NonNumeric, Found NonNumeric)
dv)