Skip to content
Browse files

Add Portage.Version

basically just the existing Version module ported to the
same Text framework as the other new Portage.* modules
  • Loading branch information...
1 parent 29815fc commit e9f8bb57d5434f3cc2a906dfb68220cd9b6c9d2c @dcoutts dcoutts committed Sep 2, 2008
Showing with 86 additions and 0 deletions.
  1. +86 −0 Portage/Version.hs
View
86 Portage/Version.hs
@@ -0,0 +1,86 @@
+{-|
+ Author : Andres Loeh <kosmikus@gentoo.org>
+ Stability : provisional
+ Portability : haskell98
+
+ Version parser, according to Portage spec.
+
+ Shamelessly borrowed from exi, ported from Parsec to ReadP
+
+-}
+
+module Portage.Version (
+ Version,
+ Suffix(..),
+ fromCabalVersion,
+ toCabalVersion,
+ ) where
+
+import qualified Distribution.Version as Cabal
+
+import Distribution.Text (Text(..))
+
+import qualified Distribution.Compat.ReadP as Parse
+import qualified Text.PrettyPrint as Disp
+import Text.PrettyPrint ((<>))
+import qualified Data.Char as Char (isAlpha, isDigit)
+
+data Version = Version [Int] -- [1,42,3] ~= 1.42.3
+ (Maybe Char) -- optional letter
+ [Suffix]
+ Int -- revision, 0 means none
+ deriving (Eq, Ord, Show, Read)
+
+data Suffix = Alpha Int | Beta Int | Pre Int | RC Int | P Int
+ deriving (Eq, Ord, Show, Read)
+
+fromCabalVersion :: Cabal.Version -> Version
+fromCabalVersion (Cabal.Version nums _tags) = Version nums Nothing [] 0
+
+toCabalVersion :: Version -> Maybe Cabal.Version
+toCabalVersion (Version nums Nothing [] _) = Just (Cabal.Version nums [])
+toCabalVersion _ = Nothing
+
+instance Text Version where
+ disp (Version ver c suf rev) =
+ dispVer ver <> dispC c <> dispSuf suf <> dispRev rev
+ where
+ dispVer = Disp.hcat . Disp.punctuate (Disp.char '.') . map Disp.int
+ dispC = maybe Disp.empty Disp.char
+ dispSuf = Disp.hcat . map disp
+ dispRev 0 = Disp.empty
+ dispRev n = Disp.text "-r" <> Disp.int n
+
+ parse = do
+ ver <- Parse.sepBy1 digits (Parse.char '.')
+ c <- Parse.option Nothing (fmap Just (Parse.satisfy Char.isAlpha))
+ suf <- Parse.many parse
+ rev <- Parse.option 0 (Parse.string "-r" >> digits)
+ return (Version ver c suf rev)
+
+instance Text Suffix where
+ disp suf = case suf of
+ Alpha n -> Disp.text "_alpha" <> dispPos n
+ Beta n -> Disp.text "_beta" <> dispPos n
+ Pre n -> Disp.text "_pre" <> dispPos n
+ RC n -> Disp.text "_rc" <> dispPos n
+ P n -> Disp.text "_p" <> dispPos n
+
+ where
+ dispPos :: Int -> Disp.Doc
+ dispPos 0 = Disp.empty
+ dispPos n = Disp.int n
+
+ parse = Parse.char '_'
+ >> Parse.choice
+ [ Parse.string "alpha" >> fmap Alpha maybeDigits
+ , Parse.string "beta" >> fmap Beta maybeDigits
+ , Parse.string "pre" >> fmap Pre maybeDigits
+ , Parse.string "rc" >> fmap RC maybeDigits
+ , Parse.string "p" >> fmap P maybeDigits
+ ]
+ where
+ maybeDigits = Parse.option 0 digits
+
+digits :: Parse.ReadP r Int
+digits = fmap read (Parse.munch1 Char.isDigit)

0 comments on commit e9f8bb5

Please sign in to comment.
Something went wrong with that request. Please try again.