rework separator parsing, fixes #229

runtime/System/Console/Hawk/Args/Spec.hs

@@ -1,4 +1,4 @@
-{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE LambdaCase, OverloadedStrings #-}
 -- | The precisely-typed version of Hawk's command-line arguments.
 module System.Console.Hawk.Args.Spec where
 
@@ -58,17 +58,25 @@ data OutputFormat = OutputFormat
   deriving (Show, Eq)
 
 
--- A separator is a strategy for separating a string into substrings.
--- One such strategy is to split the string on every occurrence of a
--- particular delimiter.
+-- A 'Processor' describes how to process a string; either by separating it
+-- into chunks or by leaving it as-is. When separating it into chunks, we can
+-- use whitespace as a delimiter (meaning one or more consecutive whitespace
+-- characters), or we can use a specific delimiter.
 type Delimiter = ByteString
 data Separator = Whitespace | Delimiter Delimiter
   deriving (Show, Eq)
+data Processor = DoNotSeparate | SeparateOn Separator
+  deriving (Show, Eq)
+
+fromSeparator :: Delimiter -> Separator -> Delimiter
+fromSeparator def = \case
+  Whitespace  -> def
+  Delimiter d -> d
 
-fromSeparator :: Separator -> Delimiter
-fromSeparator Whitespace     = " "
-fromSeparator (Delimiter "") = " "
-fromSeparator (Delimiter d)  = d
+fromProcessor :: Delimiter -> Processor -> Delimiter
+fromProcessor def = \case
+  DoNotSeparate -> def
+  SeparateOn s  -> fromSeparator def s
 
 
 newtype ContextSpec = ContextSpec

src/Control/Monad/Trans/OptionParser.hs

@@ -118,22 +118,19 @@ optionsHelp = optionsHelpWith shortName longName helpMsg optionType
 
 -- | A version of `optionsHelp` which doesn't use the Option typeclass.
 --
--- TODO: why is this test failing?
--- -->>> :{
--- --let { tp "cowbell"   = flag
--- --    ; tp "guitar"    = string
--- --    ; tp "saxophone" = optional int
--- --    }
--- --:}
---
--- TODO: why is this test failing?
--- -->>> testH tp
--- --Usage: more [option]... <song.mp3>
--- --Options:
--- --  -c       --cowbell          adds more cowbell.
--- --  -g str   --guitar=str       adds more guitar.
--- --  -s[int]  --saxophone[=int]  adds more saxophone.
+-- >>> :{
+-- let { tp "cowbell"   = flag
+--     ; tp "guitar"    = string
+--     ; tp "saxophone" = optional int
+--     }
+-- :}
 --
+-- >>> testH tp
+-- Usage: more [option]... <song.mp3>
+-- Options:
+--   -c       --cowbell          adds more cowbell.
+--   -g str   --guitar=str       adds more guitar.
+--   -s[int]  --saxophone[=int]  adds more saxophone.
 optionsHelpWith :: (o -> Char)
                 -> (o -> String)
                 -> (o -> [String])
@@ -266,14 +263,13 @@ stringConsumer = OptionConsumerT $ \case
 
 -- | Specifies that the value of the option may be omitted.
 --
--- TODO: why is this test failing?
--- -->>> let tp = const (optional string)
--- -->>> testH tp
--- --Usage: more [option]... <song.mp3>
--- --Options:
--- --  -c[str]  --cowbell[=str]    adds more cowbell.
--- --  -g[str]  --guitar[=str]     adds more guitar.
--- --  -s[str]  --saxophone[=str]  adds more saxophone.
+-- >>> let tp = const (optional string)
+-- >>> testH tp
+-- Usage: more [option]... <song.mp3>
+-- Options:
+--   -c[str]  --cowbell[=str]    adds more cowbell.
+--   -g[str]  --guitar[=str]     adds more guitar.
+--   -s[str]  --saxophone[=str]  adds more saxophone.
 optional :: OptionType -> OptionType
 optional (Setting tp) = OptionalSetting tp
 optional (OptionalSetting _) = error "double optional"
@@ -282,25 +278,21 @@ optional Flag = error "optional flag doesn't make sense"
 -- | The value assigned to an option, or Nothing if no value was assigned.
 --   Must be used to consume `optional` options.
 --
--- TODO: why is this test failing?
--- -->>> let tp = const (optional string)
--- -->>> let consumeCowbell = fmap (fromMaybe "<none>") $ consumeLast "cowbell" $ fromMaybe "<default>" <$> optionalConsumer stringConsumer :: OptionParser String String
+-- >>> let tp = const (optional string)
+-- >>> let consumeCowbell = fmap (fromMaybe "<none>") $ consumeLast "cowbell" $ fromMaybe "<default>" <$> optionalConsumer stringConsumer :: OptionParser String String
 --
--- TODO: why is this test failing?
--- -->>> testP ["-cs"] tp consumeCowbell
--- --"s"
+-- >>> testP ["-cs"] tp consumeCowbell
+-- "s"
 --
--- TODO: why is this test failing?
--- -->>> testP ["-c", "-s"] tp consumeCowbell
--- --"<default>"
+-- >>> testP ["-c", "-s"] tp consumeCowbell
+-- "<default>"
 --
--- TODO: why is this test failing?
--- -->>> testP ["-s"] tp consumeCowbell
--- --"<none>"
+-- >>> testP ["-s"] tp consumeCowbell
+-- "<none>"
 --
--- TODO: why is this test failing?
--- -->>> testP ["-c"] tp $ fromMaybe "<none>" <$> consumeLast "cowbell" stringConsumer
--- --*** Exception: please use optionalConsumer to consume optional options
+-- >>> testP ["-c"] tp $ fromMaybe "<none>" <$> consumeLast "cowbell" stringConsumer
+-- *** Exception: please use optionalConsumer to consume optional options
+-- ...
 optionalConsumer :: Monad m => OptionConsumerT m a -> OptionConsumerT m (Maybe a)
 optionalConsumer optionConsumer = OptionConsumerT $ \case
   Nothing -> return Nothing

src/System/Console/Hawk/Args/Option.hs

@@ -4,9 +4,11 @@ module System.Console.Hawk.Args.Option where
 
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 (pack)
+import Data.Maybe (maybe)
 import Text.Printf
 
 import Control.Monad.Trans.OptionParser
+import System.Console.Hawk.Args.Spec (Processor(DoNotSeparate, SeparateOn), Separator(Delimiter), Delimiter)
 
 
 data HawkOption
@@ -48,8 +50,18 @@ parseDelimiter s = pack $ case reads (printf "\"%s\"" s) of
     _          -> s
 
 -- | Almost like a string, except escape sequences are interpreted.
-delimiterConsumer :: (Functor m, Monad m) => OptionConsumerT m (Maybe ByteString)
-delimiterConsumer = fmap parseDelimiter <$> optionalConsumer stringConsumer
+delimiterConsumer :: Monad m
+                  => OptionConsumerT m Delimiter
+delimiterConsumer = parseDelimiter <$> stringConsumer
+
+separatorConsumer :: Monad m
+                  => OptionConsumerT m Separator
+separatorConsumer = Delimiter <$> delimiterConsumer
+
+processorConsumer :: Monad m
+                  => OptionConsumerT m Processor
+processorConsumer = maybe DoNotSeparate SeparateOn
+                <$> optionalConsumer separatorConsumer
 
 instance Option HawkOption where
   shortName Apply                 = 'a'

src/System/Console/Hawk/Args/Parse.hs

@@ -17,41 +17,42 @@ import           System.Console.Hawk.Context.Dir
 -- >>> let testP parser = runUncertainIO . runOptionParserT options parser
 
 
--- | (record separator, field separator)
-type CommonSeparators = (Separator, Separator)
+-- | (record processor, field processor)
+type CommonProcessors = (Processor, Processor)
 
 -- | Extract '-D' and '-d'. We perform this step separately because those two
 --   delimiters are used by both the input and output specs.
 -- 
--- >>> let test = testP commonSeparators
+-- >>> let test = testP commonProcessors
 -- 
 -- >>> test []
--- (Delimiter "\n",Whitespace)
+-- (SeparateOn (Delimiter "\n"),SeparateOn Whitespace)
 -- 
 -- >>> test ["-D\\n", "-d\\t"]
--- (Delimiter "\n",Delimiter "\t")
+-- (SeparateOn (Delimiter "\n"),SeparateOn (Delimiter "\t"))
 -- 
 -- >>> test ["-D|", "-d,"]
--- (Delimiter "|",Delimiter ",")
-commonSeparators :: forall m. (Functor m, Monad m)
-                 => OptionParserT HawkOption m CommonSeparators
-commonSeparators = do
-    r <- consumeLastSeparator Option.RecordDelimiter defaultRecordSeparator
-    f <- consumeLastSeparator Option.FieldDelimiter  defaultFieldSeparator
+-- (SeparateOn (Delimiter "|"),SeparateOn (Delimiter ","))
+--
+-- >>> test ["-D", "-d"]
+-- (DoNotSeparate,DoNotSeparate)
+commonProcessors :: forall m. (Functor m, Monad m)
+                 => OptionParserT HawkOption m CommonProcessors
+commonProcessors = do
+    r <- consumeProcessor Option.RecordDelimiter defaultRecordSeparator
+    f <- consumeProcessor Option.FieldDelimiter  defaultFieldSeparator
     return (r, f)
   where
-    consumeLastSeparator :: HawkOption -> Separator -> OptionParserT HawkOption m Separator
-    consumeLastSeparator opt def = fromMaybe def <$> consumeLast opt separatorConsumer
-
-    separatorConsumer :: OptionConsumerT m Separator
-    separatorConsumer = maybe Whitespace Delimiter <$> Option.delimiterConsumer
+    consumeProcessor :: HawkOption -> Separator -> OptionParserT HawkOption m Processor
+    consumeProcessor opt def = fromMaybe (SeparateOn def)
+                           <$> consumeLast opt (Option.processorConsumer)
 
 
 -- | The input delimiters have already been parsed, but we still need to
 --   interpret them and to determine the input source.
 -- 
 -- >>> :{
--- let test = testP $ do { c <- commonSeparators
+-- let test = testP $ do { c <- commonProcessors
 --                       ; _ <- consumeExtra stringConsumer  -- skip expr
 --                       ; i <- inputSpec c
 --                       ; lift $ print $ inputSource i
@@ -63,39 +64,39 @@ commonSeparators = do
 -- UseStdin
 -- Records (Delimiter "\n") (Fields Whitespace)
 -- 
--- TODO: why is this test failing?
--- -->>> test ["-d", "-a", "L.reverse"]
--- --UseStdin
--- --Records (Delimiter "\n") RawRecord
+-- >>> test ["-d", "-a", "L.reverse"]
+-- UseStdin
+-- Records (Delimiter "\n") RawRecord
 -- 
--- TODO: why is this test failing?
--- -->>> test ["-D", "-a", "B.reverse"]
--- --UseStdin
--- --RawStream
+-- >>> test ["-D", "-a", "B.reverse"]
+-- UseStdin
+-- RawStream
 -- 
 -- >>> test ["-d:", "-m", "L.head", "/etc/passwd"]
 -- InputFile "/etc/passwd"
 -- Records (Delimiter "\n") (Fields (Delimiter ":"))
 inputSpec :: (Functor m, Monad m)
-          => CommonSeparators -> OptionParserT HawkOption m InputSpec
-inputSpec (rSep, fSep) = InputSpec <$> source <*> format
+          => CommonProcessors -> OptionParserT HawkOption m InputSpec
+inputSpec (rProc, fProc) = InputSpec <$> source <*> format
   where
     source = do
         r <- consumeExtra stringConsumer
         return $ case r of
           Nothing -> UseStdin
           Just f  -> InputFile f
     format = return streamFormat
-    streamFormat | rSep == Delimiter "" = RawStream
-                 | otherwise            = Records rSep recordFormat
-    recordFormat | fSep == Delimiter "" = RawRecord
-                 | otherwise            = Fields fSep
+    streamFormat = case rProc of
+      DoNotSeparate   -> RawStream
+      SeparateOn rSep -> Records rSep recordFormat
+    recordFormat = case fProc of
+      DoNotSeparate   -> RawRecord
+      SeparateOn fSep -> Fields fSep
 
 -- | The output delimiters take priority over the input delimiters, regardless
 --   of the order in which they appear.
 -- 
 -- >>> :{
--- let test = testP $ do { c <- commonSeparators
+-- let test = testP $ do { c <- commonProcessors
 --                       ; o <- outputSpec c
 --                       ; let OutputFormat r f = outputFormat o
 --                       ; lift $ print $ outputSink o
@@ -115,7 +116,7 @@ inputSpec (rSep, fSep) = InputSpec <$> source <*> format
 -- UseStdout
 -- ("|","\t")
 outputSpec :: forall m. (Functor m, Monad m)
-           => CommonSeparators -> OptionParserT HawkOption m OutputSpec
+           => CommonProcessors -> OptionParserT HawkOption m OutputSpec
 outputSpec (r, f) = OutputSpec <$> sink <*> format
   where
     sink :: OptionParserT HawkOption m OutputSink
@@ -125,12 +126,12 @@ outputSpec (r, f) = OutputSpec <$> sink <*> format
     format = OutputFormat <$> record <*> field
 
     record, field :: OptionParserT HawkOption m Delimiter
-    record = fmap (fromMaybe r') $ consumeLast Option.OutputRecordDelimiter $ fromMaybe "" <$> Option.delimiterConsumer
-    field  = fmap (fromMaybe f') $ consumeLast Option.OutputFieldDelimiter  $ fromMaybe "" <$> Option.delimiterConsumer
+    record = fmap (fromMaybe r') $ consumeLast Option.OutputRecordDelimiter $ fromMaybe "" <$> optionalConsumer Option.delimiterConsumer
+    field  = fmap (fromMaybe f') $ consumeLast Option.OutputFieldDelimiter  $ fromMaybe "" <$> optionalConsumer Option.delimiterConsumer
 
     r', f' :: Delimiter
-    r' = fromSeparator r
-    f' = fromSeparator f
+    r' = fromProcessor defaultRecordDelimiter r
+    f' = fromProcessor defaultFieldDelimiter  f
 
 
 -- | The information we need in order to evaluate a user expression:
@@ -209,28 +210,27 @@ exprSpec = ExprSpec <$> (ContextSpec <$> contextDir)
 -- Records (Delimiter "\r\n") (Fields (Delimiter "\t"))
 -- ("\r\n","\t")
 -- 
--- TODO: why is this test failing?
--- -->>> test ["-D", "-O\n", "-m", "L.head", "file.in"]
--- --Map
--- --("L.head",InputFile "file.in")
--- --RawStream
--- --("\n"," ")
+-- >>> test ["-D", "-O\n", "-m", "L.head", "file.in"]
+-- Map
+-- ("L.head",InputFile "file.in")
+-- RawStream
+-- ("\n"," ")
 parseArgs :: (Functor m,MonadIO m) => [String] -> UncertainT m HawkSpec
 parseArgs [] = return Help
 parseArgs args = runOptionParserT options parser args
   where
     parser = do
         lift $ return ()  -- silence a warning
         cmd <- fromMaybe eval <$> consumeExclusive assoc
-        c <- commonSeparators
+        c <- commonProcessors
         cmd c
     assoc = [ (Option.Help,    help)
             , (Option.Version, version)
             , (Option.Apply,   apply)
             , (Option.Map,     map')
             ]
 
-    help, version, eval, apply, map' :: (Functor m,MonadIO m) => CommonSeparators
+    help, version, eval, apply, map' :: (Functor m,MonadIO m) => CommonProcessors
                                      -> OptionParserT HawkOption m HawkSpec
     help    _ = return Help
     version _ = return Version