module Distribution.Text (
Text(..),
defaultStyle,
display,
flatStyle,
simpleParse,
stdParse,
) where
import Prelude ()
import Distribution.Compat.Prelude
import Data.Functor.Identity (Identity (..))
import Distribution.Pretty
import Distribution.Parsec.Class
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Data.Version (Version(Version))
class Text a where
disp :: a -> Disp.Doc
default disp :: Pretty a => a -> Disp.Doc
disp = pretty
parse :: Parse.ReadP r a
default parse :: Parsec a => Parse.ReadP r a
parse = parsec
display :: Text a => a -> String
display = Disp.renderStyle defaultStyle . disp
simpleParse :: Text a => String -> Maybe a
simpleParse str = case [ p | (p, s) <- Parse.readP_to_S parse str
, all isSpace s ] of
[] -> Nothing
(p:_) -> Just p
stdParse :: Text ver => (ver -> String -> res) -> Parse.ReadP r res
stdParse f = do
cs <- Parse.sepBy1 component (Parse.char '-')
_ <- Parse.char '-'
ver <- parse
let name = intercalate "-" cs
return $! f ver (lowercase name)
where
component = do
cs <- Parse.munch1 isAlphaNum
if all isDigit cs then Parse.pfail else return cs
lowercase :: String -> String
lowercase = map toLower
instance Text Bool where
parse = Parse.choice [ (Parse.string "True" Parse.+++
Parse.string "true") >> return True
, (Parse.string "False" Parse.+++
Parse.string "false") >> return False ]
instance Text Int where
parse = fmap negate (Parse.char '-' >> parseNat) Parse.+++ parseNat
instance Text a => Text (Identity a) where
disp = disp . runIdentity
parse = fmap Identity parse
parseNat :: Parse.ReadP r Int
parseNat = read `fmap` Parse.munch1 isDigit
instance Text Version where
disp (Version branch _tags)
= Disp.hcat (Disp.punctuate (Disp.char '.') (map Disp.int branch))
parse = do
branch <- Parse.sepBy1 parseNat (Parse.char '.')
_tags <- Parse.many (Parse.char '-' >> Parse.munch1 isAlphaNum)
return (Version branch [])