Text.hs 1.55 KB
Newer Older
1
2
3
4
5
6
7
8
9
module Distribution.Text (
  Text(..),
  display,
  simpleParse,
  ) where

import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint          as Disp

10
11
import Data.Version (Version(Version))
import qualified Data.Char as Char (isDigit, isAlphaNum, isSpace)
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30

class Text a where
  disp  :: a -> Disp.Doc
  parse :: Parse.ReadP r a

display :: Text a => a -> String
display = Disp.render . disp

simpleParse :: Text a => String -> Maybe a
simpleParse str = case [ p | (p, s) <- Parse.readP_to_S parse str
                       , all Char.isSpace s ] of
  []    -> Nothing
  (p:_) -> Just p

-- -----------------------------------------------------------------------------
-- Instances for types from the base package

instance Text Bool where
  disp  = Disp.text . show
31
32
33
34
  parse = Parse.choice [ (Parse.string "True" Parse.+++
                          Parse.string "true") >> return True
                       , (Parse.string "False" Parse.+++
                          Parse.string "false") >> return False ]
35
36

instance Text Version where
Duncan Coutts's avatar
Duncan Coutts committed
37
  disp (Version branch _tags) -- Do not display the tags
38
39
40
41
42
43
44
45
46
47
48
49
50
    = Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int branch))

  parse = do
      branch <- Parse.sepBy1 digits (Parse.char '.')
      tags   <- Parse.many (Parse.char '-' >> Parse.munch1 Char.isAlphaNum)
      return (Version branch tags)
    where
      digits = do
        first <- Parse.satisfy Char.isDigit
        if first == '0'
          then return 0
          else do rest <- Parse.munch Char.isDigit
                  return (read (first : rest))