arx-0.3.3: 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
import Data.ByteString (ByteString)
import Data.ByteString.Char8 ()
import Data.Either
import Data.Map (Map)
import qualified Data.Map as Map
import Data.Attoparsec.ByteString.Char8 ( char8, choice, decimal, endOfInput,
inClass, isDigit, parseOnly, Parser,
satisfy, string, takeWhile,
takeWhile1, try )
{-| 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