{-# LANGUAGE FlexibleContexts #-}

-- | This package provides a simple range parser.
--
-- This range parser was designed to be a useful tool for CLI programs. For example, by
-- default, this example depicts how the parser works:
--
-- >>> parseRanges "-5,8-10,13-15,20-" :: Either ParseError [AnyRange Integer]
-- Right [UpperBoundRange 5,SpanRange 8 10,SpanRange 13 15,LowerBoundRange 20]
-- (0.01 secs, 681,792 bytes)
--
-- And the * character translates to an infinite range. This is very useful for accepting
-- ranges as input in CLI programs, but not as useful for parsing .cabal or package.json files.
--
-- To handle more complex parsing cases it is recommended that you use the ranges library
-- in conjunction with parsec or Alex/Happy and convert the versions that you find into
-- ranges.
module Data.Range.Typed.Parser
  ( parseRanges,
    customParseRanges,
    RangeParserArgs (..),
    defaultArgs,
    ranges,
    ParseError,
  )
where

import Data.Range.Typed
import Text.Parsec
import Text.Parsec.String

-- | These are the arguments that will be used when parsing a string as a range.
data RangeParserArgs = Args
  { -- | A separator that represents a union.
    RangeParserArgs -> String
unionSeparator :: String,
    -- | A separator that separates the two halves of a range.
    RangeParserArgs -> String
rangeSeparator :: String,
    -- | A separator that implies an unbounded range.
    RangeParserArgs -> String
wildcardSymbol :: String
  }
  deriving (Int -> RangeParserArgs -> ShowS
[RangeParserArgs] -> ShowS
RangeParserArgs -> String
(Int -> RangeParserArgs -> ShowS)
-> (RangeParserArgs -> String)
-> ([RangeParserArgs] -> ShowS)
-> Show RangeParserArgs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RangeParserArgs -> ShowS
showsPrec :: Int -> RangeParserArgs -> ShowS
$cshow :: RangeParserArgs -> String
show :: RangeParserArgs -> String
$cshowList :: [RangeParserArgs] -> ShowS
showList :: [RangeParserArgs] -> ShowS
Show)

-- | These are the default arguments that are used by the parser. Please feel free to use
-- the default arguments for you own parser and modify it from the defaults at will.
defaultArgs :: RangeParserArgs
defaultArgs :: RangeParserArgs
defaultArgs =
  Args
    { unionSeparator :: String
unionSeparator = String
",",
      rangeSeparator :: String
rangeSeparator = String
"-",
      wildcardSymbol :: String
wildcardSymbol = String
"*"
    }

-- | Given a string, this function will either return a parse error back to the user or the
-- list of ranges that are represented by the parsed string. Very useful for CLI programs
-- that need to load ranges from a single-line string.
parseRanges :: (Read a) => String -> Either ParseError [AnyRange a]
parseRanges :: forall a. Read a => String -> Either ParseError [AnyRange a]
parseRanges = Parsec String () [AnyRange a]
-> String -> String -> Either ParseError [AnyRange a]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (RangeParserArgs -> Parsec String () [AnyRange a]
forall a. Read a => RangeParserArgs -> Parser [AnyRange a]
ranges RangeParserArgs
defaultArgs) String
"(range parser)"

-- | If you disagree with the default characters for separating ranges then this function can
-- be used to customise them, up to a point.
customParseRanges :: (Read a) => RangeParserArgs -> String -> Either ParseError [AnyRange a]
customParseRanges :: forall a.
Read a =>
RangeParserArgs -> String -> Either ParseError [AnyRange a]
customParseRanges RangeParserArgs
args = Parsec String () [AnyRange a]
-> String -> String -> Either ParseError [AnyRange a]
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse (RangeParserArgs -> Parsec String () [AnyRange a]
forall a. Read a => RangeParserArgs -> Parser [AnyRange a]
ranges RangeParserArgs
args) String
"(range parser)"

string_ :: (Stream s m Char) => String -> ParsecT s u m ()
string_ :: forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
string_ String
x = String -> ParsecT s u m String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
x ParsecT s u m String -> ParsecT s u m () -> ParsecT s u m ()
forall a b. ParsecT s u m a -> ParsecT s u m b -> ParsecT s u m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> ParsecT s u m ()
forall a. a -> ParsecT s u m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Given the parser arguments this returns a parsec parser that is capable of parsing a list of
-- ranges.
ranges :: (Read a) => RangeParserArgs -> Parser [AnyRange a]
ranges :: forall a. Read a => RangeParserArgs -> Parser [AnyRange a]
ranges RangeParserArgs
args = Parser (AnyRange a)
forall a. Read a => Parser (AnyRange a)
range Parser (AnyRange a)
-> ParsecT String () Identity String
-> ParsecT String () Identity [AnyRange a]
forall s (m :: * -> *) t u a sep.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m sep -> ParsecT s u m [a]
`sepBy` (String -> ParsecT String () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string (String -> ParsecT String () Identity String)
-> String -> ParsecT String () Identity String
forall a b. (a -> b) -> a -> b
$ RangeParserArgs -> String
unionSeparator RangeParserArgs
args)
  where
    range :: (Read a) => Parser (AnyRange a)
    range :: forall a. Read a => Parser (AnyRange a)
range =
      [ParsecT String () Identity (AnyRange a)]
-> ParsecT String () Identity (AnyRange a)
forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
choice
        [ ParsecT String () Identity (AnyRange a)
forall a. Read a => Parser (AnyRange a)
infiniteRange,
          ParsecT String () Identity (AnyRange a)
forall a. Read a => Parser (AnyRange a)
spanRange,
          ParsecT String () Identity (AnyRange a)
forall a. Read a => Parser (AnyRange a)
singletonRange
        ]

    infiniteRange :: (Read a) => Parser (AnyRange a)
    infiniteRange :: forall a. Read a => Parser (AnyRange a)
infiniteRange = do
      String -> ParsecT String () Identity ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
string_ (String -> ParsecT String () Identity ())
-> String -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ RangeParserArgs -> String
wildcardSymbol RangeParserArgs
args
      AnyRange a -> Parser (AnyRange a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyRange a -> Parser (AnyRange a))
-> AnyRange a -> Parser (AnyRange a)
forall a b. (a -> b) -> a -> b
$ Range 'False 'False a -> AnyRange a
forall a (l :: Bool) (h :: Bool). Range l h a -> AnyRange a
anyRange Range 'False 'False a
forall a. Range 'False 'False a
InfiniteRange

    spanRange :: (Read a) => Parser (AnyRange a)
    spanRange :: forall a. Read a => Parser (AnyRange a)
spanRange = ParsecT String () Identity (AnyRange a)
-> ParsecT String () Identity (AnyRange a)
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT String () Identity (AnyRange a)
 -> ParsecT String () Identity (AnyRange a))
-> ParsecT String () Identity (AnyRange a)
-> ParsecT String () Identity (AnyRange a)
forall a b. (a -> b) -> a -> b
$ do
      Maybe a
first <- Parser (Maybe a)
forall a. Read a => Parser (Maybe a)
readSection
      String -> ParsecT String () Identity ()
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m ()
string_ (String -> ParsecT String () Identity ())
-> String -> ParsecT String () Identity ()
forall a b. (a -> b) -> a -> b
$ RangeParserArgs -> String
rangeSeparator RangeParserArgs
args
      Maybe a
second <- Parser (Maybe a)
forall a. Read a => Parser (Maybe a)
readSection
      case (Maybe a
first, Maybe a
second) of
        (Just a
x, Just a
y) -> AnyRange a -> ParsecT String () Identity (AnyRange a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyRange a -> ParsecT String () Identity (AnyRange a))
-> AnyRange a -> ParsecT String () Identity (AnyRange a)
forall a b. (a -> b) -> a -> b
$ Range 'True 'True a -> AnyRange a
forall a (l :: Bool) (h :: Bool). Range l h a -> AnyRange a
anyRange (Range 'True 'True a -> AnyRange a)
-> Range 'True 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Bound a -> Range 'True 'True a
forall a. Bound a -> Bound a -> Range 'True 'True a
SpanRange (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
x) (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
y)
        (Just a
x, Maybe a
_) -> AnyRange a -> ParsecT String () Identity (AnyRange a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyRange a -> ParsecT String () Identity (AnyRange a))
-> AnyRange a -> ParsecT String () Identity (AnyRange a)
forall a b. (a -> b) -> a -> b
$ Range 'True 'False a -> AnyRange a
forall a (l :: Bool) (h :: Bool). Range l h a -> AnyRange a
anyRange (Range 'True 'False a -> AnyRange a)
-> Range 'True 'False a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Range 'True 'False a
forall a. Bound a -> Range 'True 'False a
LowerBoundRange (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
x)
        (Maybe a
_, Just a
y) -> AnyRange a -> ParsecT String () Identity (AnyRange a)
forall a. a -> ParsecT String () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (AnyRange a -> ParsecT String () Identity (AnyRange a))
-> AnyRange a -> ParsecT String () Identity (AnyRange a)
forall a b. (a -> b) -> a -> b
$ Range 'False 'True a -> AnyRange a
forall a (l :: Bool) (h :: Bool). Range l h a -> AnyRange a
anyRange (Range 'False 'True a -> AnyRange a)
-> Range 'False 'True a -> AnyRange a
forall a b. (a -> b) -> a -> b
$ Bound a -> Range 'False 'True a
forall a. Bound a -> Range 'False 'True a
UpperBoundRange (a -> Bound a
forall a. a -> Bound a
InclusiveBound a
y)
        (Maybe a, Maybe a)
_ -> String -> ParsecT String () Identity (AnyRange a)
forall s u (m :: * -> *) a. String -> ParsecT s u m a
parserFail (String
"Range should have a number on one end: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ RangeParserArgs -> String
rangeSeparator RangeParserArgs
args)

    singletonRange :: (Read a) => Parser (AnyRange a)
    singletonRange :: forall a. Read a => Parser (AnyRange a)
singletonRange = (String -> AnyRange a)
-> ParsecT String () Identity String
-> ParsecT String () Identity (AnyRange a)
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Range 'True 'True a -> AnyRange a
forall a (l :: Bool) (h :: Bool). Range l h a -> AnyRange a
anyRange (Range 'True 'True a -> AnyRange a)
-> (String -> Range 'True 'True a) -> String -> AnyRange a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Range 'True 'True a
forall a. a -> Range 'True 'True a
SingletonRange (a -> Range 'True 'True a)
-> (String -> a) -> String -> Range 'True 'True a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a
forall a. Read a => String -> a
read) (ParsecT String () Identity String
 -> ParsecT String () Identity (AnyRange a))
-> ParsecT String () Identity String
-> ParsecT String () Identity (AnyRange a)
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit

readSection :: (Read a) => Parser (Maybe a)
readSection :: forall a. Read a => Parser (Maybe a)
readSection = (Maybe String -> Maybe a)
-> ParsecT String () Identity (Maybe String)
-> ParsecT String () Identity (Maybe a)
forall a b.
(a -> b)
-> ParsecT String () Identity a -> ParsecT String () Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((String -> a) -> Maybe String -> Maybe a
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap String -> a
forall a. Read a => String -> a
read) (ParsecT String () Identity (Maybe String)
 -> ParsecT String () Identity (Maybe a))
-> ParsecT String () Identity (Maybe String)
-> ParsecT String () Identity (Maybe a)
forall a b. (a -> b) -> a -> b
$ ParsecT String () Identity String
-> ParsecT String () Identity (Maybe String)
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m (Maybe a)
optionMaybe (ParsecT String () Identity Char
-> ParsecT String () Identity String
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m [a]
many1 ParsecT String () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
digit)