arx-0.0.0: System/Posix/ARX/CLI/CLTokens.hs
{-# LANGUAGE OverloadedStrings
, ScopedTypeVariables
, StandaloneDeriving #-}
{-| The CLTokens module describes non-overlapping classes of strings that are
useful for disambiguating arguments to command line programs. Many common
string formats -- environment variable assignments, URLs, option strings --
are recognized by this module's utilities.
-}
module System.Posix.ARX.CLI.CLTokens where
import Prelude hiding (takeWhile)
import Control.Applicative hiding (many)
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import Data.Either
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Attoparsec.Char8
import Data.Attoparsec.FastSet
{-| Non-overlapping classes of command line argument strings.
-}
data Class = EnvBinding -- ^ An 'EnvBinding' has the form
-- @<shell var name>=<string>@. For example,
-- @SENDIN=the_clowns@.
| QualifiedPath -- ^ A 'QualifiedPath' is a file path starting with
-- @/@, @./@, or @../@.
| DashDash -- ^ A 'DashDash' is a string of two dashes, @--@,
-- commonly used to indicate the end of options
-- processing.
| LongOption -- ^ A 'LongOption' is a string beginning with two
-- dashes and then at least one non-dash.
| Dash -- ^ A 'Dash' is a single dash, @-@, commonly used
-- to indicate input from @stdin@ or output to
-- @stdout@.
| ShortOption -- ^ A 'ShortOption' is a beginning with a dash and
-- then at least one non-dash.
| URL -- ^ A 'URL' is a scheme, separated from the
-- resource, represented as an arbitrary string,
-- by @://@. The scheme consists of ASCII,
-- lower-case letters and digits, and may be
-- multi-part, with each part separated by a @+@
-- or @/@ (for example, @git+ssh@). An example
-- URL: @http://example.com/?q=special@.
| HexNum -- ^ A 'HexNum' is a sequence of hexadecimal
-- digits, upper or lower case, beginning with
-- @0x@; for example: @0x01a3@.
| DecimalNum -- ^ A 'DecimalNum' is a string of decimal digits:
-- @123123@.
| Size -- ^ A 'Size' is a decimal number followed by a
-- multiplicative suffix, in the manner of @dd@
-- or @head@. Note that counts in terms of bytes
-- require @B@ (unlike @dd@ or @head@). For a
-- full list of suffixes, see 'sizes' below.
deriving instance Eq Class
deriving instance Ord Class
deriving instance Show Class
{-| Determine if a particular 'ByteString' matches the given 'Class' of token.
-}
match :: Class -> ByteString -> Bool
match = (e2b .) . parseOnly . recognizer
where
e2b (Left _) = False
e2b (Right _) = True
{-| Determine if a particular 'ByteString' matches any 'Class' of token.
-}
recognize :: ByteString -> Maybe Class
recognize = e2m . parseOnly (choice recognizers)
where
e2m (Left _) = Nothing
e2m (Right x) = Just x
recognizeIt x = x <$ recognizer x
recognizers = recognizeIt <$> [ EnvBinding,
QualifiedPath,
DashDash,
LongOption,
Dash,
ShortOption,
URL,
HexNum,
DecimalNum ]
{-| A ByteString stand-in that demoes each token class.
-}
exemplar :: Class -> ByteString
exemplar cls = case cls of
EnvBinding -> "VAR=value"
QualifiedPath -> "./qualified/path"
DashDash -> "--"
LongOption -> "--long-option"
Dash -> "-"
ShortOption -> "-shortopt"
URL -> "scheme://url-to-resource"
HexNum -> "0xA12FE"
DecimalNum -> "0123456789"
Size -> "4MiB"
{-| The recognizer appropriate to each token class. Parses successfully if a
the token class is recognized, returning '()'. Most token types are
defined in terms of a prefix of the input -- for example, 'QualifiedPath'
-- and the parsers for these tokens naturally return as soon as the prefix
is recognized.
-}
recognizer :: Class -> Parser ()
recognizer cls = case cls of
EnvBinding -> () <$ do satisfy varFirst
takeWhile varBody
char8 '='
QualifiedPath -> () <$ do string "/" <|> string "./"
<|> string "../"
DashDash -> string "--" *> endOfInput
LongOption -> () <$ (string "--" >> satisfy (/= '-'))
Dash -> char8 '-' *> endOfInput
ShortOption -> () <$ (char8 '-' >> satisfy (/= '-'))
URL -> () <$ do takeWhile1 isURLSchemeChar
many $ do char8 '+' <|> char8 '/'
takeWhile1 isURLSchemeChar
string "://"
HexNum -> string "0x" >> takeWhile1 isHexDigit
*> endOfInput
DecimalNum -> takeWhile1 isDigit *> endOfInput
Size -> () <$ size
schemeSeparator = char8 '+' <|> char8 '/'
varFirst = inClass "a-zA-Z_"
varBody = inClass "a-zA-Z_0-9"
isLongOptionChar = inClass "a-zA-Z0-9-"
isShortOptionChar = inClass "a-zA-Z0-9!?"
isSchemeChar = inClass "a-z0-9"
isHexDigit = inClass "0-9a-fA-F"
isURLSchemeChar = inClass "a-z0-9"
{-| A map from suffixes to sizes, following the conventions of command line
tools (GNU @dd@ or @head@ and many others) as well as the standard for
binary sizes established by the IEC.
@
B = 1
K = KiB = 1024B kB = 1000B
M = MiB = 1024K MB = 1000kB
G = GiB = 1024M GB = 1000MB
T = TiB = 1024G TB = 1000GB
P = PiB = 1024T PB = 1000TB
E = EiB = 1024P EB = 1000PB
Z = ZiB = 1024E ZB = 1000EB
Y = YiB = 1024Z YB = 1000ZB
@
-}
sizes :: Map ByteString Integer
sizes = Map.fromList
[ ("B", 1),
("K", 2^10), ("KiB", 2^10), ("kB", 10^03),
("M", 2^20), ("MiB", 2^20), ("MB", 10^06),
("G", 2^30), ("GiB", 2^30), ("GB", 10^09),
("T", 2^40), ("TiB", 2^40), ("TB", 10^12),
("P", 2^50), ("PiB", 2^50), ("PB", 10^15),
("E", 2^60), ("EiB", 2^60), ("EB", 10^18),
("Z", 2^70), ("ZiB", 2^70), ("ZB", 10^21),
("Y", 2^80), ("YiB", 2^80), ("YB", 10^24) ]
{-| Parse a size, consuming the entire input string.
-}
size :: Parser Integer
size = (*) <$> decimal <*> suffix
where
asSuffix (k, v) = v <$ try (string k <* endOfInput)
suffix = choice (asSuffix <$> Map.toList sizes)
{-| Parse a size, consuming the entire input string, with the final result
bounded by the maximum of a 'Bounded' type.
-}
sizeBounded :: forall b . (Bounded b, Integral b) => Parser b
sizeBounded = fromInteger . min (toInteger (maxBound :: b)) <$> size