-----------------------------------------------------------------------------
-- |
-- Module      :  Distribution.Text
-- Copyright   :  Duncan Coutts 2007
--
-- Maintainer  :  cabal-devel@haskell.org
-- Portability :  portable
--
-- This defines a 'Text' class which is a bit like the 'Read' and 'Show'
-- classes. The difference is that is uses a modern pretty printer and parser
-- system and the format is not expected to be Haskell concrete syntax but
-- rather the external human readable representation used by Cabal.
--
module Distribution.Text (
  Text(..),
  display,
  simpleParse,
  ) where

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

import Data.Version (Version(Version))
import qualified Data.Char as Char (isDigit, isAlphaNum, isSpace)

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

display :: Text a => a -> String
display = renderStyle :: Style -> Doc -> StringDisp.renderStyle style :: Stylestyle (.) :: (b -> c) -> (a -> b) -> a -> c. disp :: Text a => a -> Docdisp
  where style = Disp.Style {
          Disp.mode            = PageMode :: ModeDisp.PageMode,
          Disp.lineLength      = 79,
          Disp.ribbonsPerLine  = 1.0
        }

simpleParse :: Text a => String -> Maybe a
simpleParse str = case [ p :: ap | (p, s) <- readP_to_S :: ReadP a a -> ReadS aParse.readP_to_S parse :: Text a => forall r. ReadP r aparse str :: Stringstr
                       , all :: (a -> Bool) -> [a] -> Boolall isSpace :: Char -> BoolChar.isSpace s :: Strings ] of
  []    -> Nothing :: Maybe aNothing
  (p:_) -> Just :: a -> Maybe aJust p :: ap

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

instance D:Text :: (a -> Doc) -> (forall r. ReadP r a) -> T:Text aText Bool where
  disp  = text :: String -> DocDisp.text (.) :: (b -> c) -> (a -> b) -> a -> c. show :: Show a => a -> Stringshow
  parse = choice :: [ReadP r a] -> ReadP r aParse.choice [ (string :: String -> ReadP r StringParse.string "True" (+++) :: ReadP r a -> ReadP r a -> ReadP r aParse.+++
                          string :: String -> ReadP r StringParse.string "true") (>>) :: Monad m => forall a b. m a -> m b -> m b>> return :: Monad m => forall a. a -> m areturn True :: BoolTrue
                       , (string :: String -> ReadP r StringParse.string "False" (+++) :: ReadP r a -> ReadP r a -> ReadP r aParse.+++
                          string :: String -> ReadP r StringParse.string "false") (>>) :: Monad m => forall a b. m a -> m b -> m b>> return :: Monad m => forall a. a -> m areturn False :: BoolFalse ]

instance D:Text :: (a -> Doc) -> (forall r. ReadP r a) -> T:Text aText Version where
  disp (Version branch _tags)     -- Death to version tags!!
    = hcat :: [Doc] -> DocDisp.hcat (punctuate :: Doc -> [Doc] -> [Doc]Disp.punctuate (char :: Char -> DocDisp.char '.') (map :: (a -> b) -> [a] -> [b]map int :: Int -> DocDisp.int branch :: [Int]branch))

  parse = do
      branch <- sepBy1 :: ReadP r a -> ReadP r sep -> ReadP r [a]Parse.sepBy1 digits :: Parser r Char Intdigits (char :: Char -> ReadP r CharParse.char '.')
      tags   <- many :: ReadP r a -> ReadP r [a]Parse.many (char :: Char -> ReadP r CharParse.char '-' (>>) :: Monad m => forall a b. m a -> m b -> m b>> munch1 :: (Char -> Bool) -> ReadP r StringParse.munch1 isAlphaNum :: Char -> BoolChar.isAlphaNum)
      return :: Monad m => forall a. a -> m areturn (Version :: [Int] -> [String] -> VersionVersion branch :: [Int]branch tags :: [String]tags)  --TODO: should we ignore the tags?
    where
      digits = do
        first <- satisfy :: (Char -> Bool) -> ReadP r CharParse.satisfy isDigit :: Char -> BoolChar.isDigit
        if first :: Charfirst (==) :: Eq a => a -> a -> Bool== '0'
          then return :: Monad m => forall a. a -> m areturn 0
          else do rest <- munch :: (Char -> Bool) -> ReadP r StringParse.munch isDigit :: Char -> BoolChar.isDigit
                  return :: Monad m => forall a. a -> m areturn (read :: Read a => String -> aread (first :: Charfirst (:) :: a -> [a] -> [a]: rest :: Stringrest))