content: {-# LANGUAGE CPP, OverloadedStrings, PackageImports, ScopedTypeVariables #-}
  -- | In which Hawk's command-line arguments are structured into a `HawkSpec`.
  module System.Console.Hawk.Args.Parse (parseArgs) where
  
  import Prelude hiding (fail)
  
  #if MIN_VERSION_base(4,12,0)
  import Control.Monad.Fail (fail)
  #else
  import Prelude (fail)
  #endif
  import Data.Char                                 (isSpace)
  import Data.Maybe
  import "mtl" Control.Monad.Trans
  
  import Control.Monad.Trans.OptionParser
  import Control.Monad.Trans.Uncertain
  import qualified System.Console.Hawk.Args.Option as Option
  import           System.Console.Hawk.Args.Option (HawkOption, options)
  import           System.Console.Hawk.Args.Spec
  import           System.Console.Hawk.Context.Dir
  
  -- $setup
  -- >>> let testP parser = runUncertainIO . runOptionParserT options parser
  
  
  -- | (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 commonProcessors
  -- 
  -- >>> test []
  -- (SeparateOn (Delimiter "\n"),SeparateOn Whitespace)
  -- 
  -- >>> test ["-D\\n", "-d\\t"]
  -- (SeparateOn (Delimiter "\n"),SeparateOn (Delimiter "\t"))
  -- 
  -- >>> test ["-D|", "-d,"]
  -- (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
      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 <- commonProcessors
  --                       ; _ <- consumeExtra stringConsumer  -- skip expr
  --                       ; i <- inputSpec c
  --                       ; lift $ print $ inputSource i
  --                       ; lift $ print $ inputFormat i
  --                       }
  -- :}
  -- 
  -- >>> test []
  -- UseStdin
  -- Records (Delimiter "\n") (Fields Whitespace)
  -- 
  -- >>> test ["-d", "-a", "L.reverse"]
  -- UseStdin
  -- Records (Delimiter "\n") RawRecord
  -- 
  -- >>> 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)
            => 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 = 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 <- commonProcessors
  --                       ; o <- outputSpec c
  --                       ; let OutputFormat r f = outputFormat o
  --                       ; lift $ print $ outputSink o
  --                       ; lift $ print (r, f)
  --                       }
  -- :}
  -- 
  -- >>> test []
  -- UseStdout
  -- ("\n"," ")
  -- 
  -- >>> test ["-D;", "-d", "-a", "L.reverse"]
  -- UseStdout
  -- (";"," ")
  -- 
  -- >>> test ["-o\t", "-d,", "-O|"]
  -- UseStdout
  -- ("|","\t")
  outputSpec :: forall m. (Functor m, Monad m)
             => CommonProcessors -> OptionParserT HawkOption m OutputSpec
  outputSpec (r, f) = OutputSpec <$> sink <*> format
    where
      sink :: OptionParserT HawkOption m OutputSink
      sink = return UseStdout
  
      format :: OptionParserT HawkOption m OutputFormat
      format = OutputFormat <$> record <*> field
  
      record, field :: OptionParserT HawkOption m Delimiter
      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' = fromProcessor defaultRecordDelimiter r
      f' = fromProcessor defaultFieldDelimiter  f
  
  
  -- | The information we need in order to evaluate a user expression:
  --   the expression itself, and the context in which it should be evaluated.
  --   In Hawk, that context is the user prelude.
  -- 
  -- >>> :{
  -- let test = testP $ do { e <- exprSpec
  --                       ; lift $ print $ untypedExpr e
  --                       ; lift $ print $ userContextDirectory (contextSpec e)
  --                       }
  -- :}
  -- 
  -- >>> test []
  -- error: missing user expression
  -- *** Exception: ExitFailure 1
  -- 
  -- >>> test [""]
  -- error: user expression cannot be empty
  -- *** Exception: ExitFailure 1
  --
  -- >>> test ["-D;", "-d", "-a", "L.reverse","-c","somedir"]
  -- "L.reverse"
  -- "somedir"
  exprSpec :: (Functor m, MonadIO m)
           => OptionParserT HawkOption m ExprSpec
  exprSpec = ExprSpec <$> (ContextSpec <$> contextDir)
                      <*> expr
    where
      contextDir = do
        maybeDir <- consumeLast Option.ContextDirectory stringConsumer
        case maybeDir of
          Nothing -> liftIO findContextFromCurrDirOrDefault
          Just dir -> return dir
      expr = do
          r <- consumeExtra stringConsumer
          case r of
            Just e  -> if all isSpace e
                        then fail "user expression cannot be empty"
                        else return e
            Nothing -> fail "missing user expression"
  
  
  -- | Parse command-line arguments to construct a `HawkSpec`.
  -- 
  -- TODO: complain if some arguments are unused (except perhaps "-d" and "-D").
  -- 
  -- >>> :{
  -- let test args = do { spec <- runUncertainIO $ parseArgs args
  --                    ; case spec of
  --                        Help        -> putStrLn "Help"
  --                        Version     -> putStrLn "Version"
  --                        Eval  e   o -> putStrLn "Eval"  >> print (untypedExpr e)                                         >> print (recordDelimiter (outputFormat o), fieldDelimiter (outputFormat o))
  --                        Apply e i o -> putStrLn "Apply" >> print (untypedExpr e, inputSource i) >> print (inputFormat i) >> print (recordDelimiter (outputFormat o), fieldDelimiter (outputFormat o))
  --                        Map   e i o -> putStrLn "Map"   >> print (untypedExpr e, inputSource i) >> print (inputFormat i) >> print (recordDelimiter (outputFormat o), fieldDelimiter (outputFormat o))
  --                    }
  -- :}
  -- 
  -- >>> test []
  -- Help
  -- 
  -- >>> test ["--help"]
  -- Help
  -- 
  -- >>> test ["--version"]
  -- Version
  -- 
  -- >>> test ["-d\\t", "L.head"]
  -- Eval
  -- "L.head"
  -- ("\n","\t")
  -- 
  -- >>> test ["-D\r\n", "-d\\t", "-m", "L.head"]
  -- Map
  -- ("L.head",UseStdin)
  -- Records (Delimiter "\r\n") (Fields (Delimiter "\t"))
  -- ("\r\n","\t")
  -- 
  -- >>> 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 <- 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) => CommonProcessors
                                       -> OptionParserT HawkOption m HawkSpec
      help    _ = return Help
      version _ = return Version
      eval    c = Eval  <$> exprSpec <*>                 outputSpec c
      apply   c = Apply <$> exprSpec <*> inputSpec c <*> outputSpec c
      map'    c = Map   <$> exprSpec <*> inputSpec c <*> outputSpec c
  