{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}
{-# OPTIONS -fno-warn-orphans #-}
module Debian.Version.String
    ( ParseDebianVersion(..)
    ) where

import Text.ParserCombinators.Parsec

import Data.List (stripPrefix)
import Debian.Version.Common
import Debian.Version.Internal

instance ParseDebianVersion String where
    parseDebianVersion :: String -> Either ParseError DebianVersion
parseDebianVersion String
str =
        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)
 
instance Read DebianVersion where
    readsPrec :: Int -> ReadS DebianVersion
readsPrec Int
_ String
s =
        case String -> String -> Maybe String
forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix String
"Debian.Version.parseDebianVersion " String
s of
          Just String
s' -> case ReadS String
forall a. Read a => ReadS a
reads String
s' :: [(String, String)] of
                       []-> []
                       (String
v, String
s'') : [(String, String)]
_ -> [(String -> DebianVersion
forall string. ParseDebianVersion string => string -> DebianVersion
parseDebianVersion' String
v, String
s'')]
          Maybe String
Nothing -> []