{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE NoImplicitPrelude #-}

module Biz.Cli
  ( Plan (..),
    main,
    Docopt.Docopt (..),
    Docopt.Arguments,
    Docopt.argument,
    Docopt.docopt,
    Docopt.getAllArgs,
    Docopt.getArg,
    getArgWithDefault,
    Docopt.longOption,
    Docopt.shortOption,
    Docopt.command,
    has,
  )
where

import Alpha
import qualified Biz.Test as Test
import qualified System.Console.Docopt as Docopt
import qualified System.Environment as Environment

data Plan cfg = Plan
  { help :: Docopt.Docopt,
    move :: Docopt.Arguments -> IO (),
    test :: Test.Tree,
    tidy :: cfg -> IO ()
  }

main :: Plan cfg -> IO ()
main Plan {..} =
  Environment.getArgs
    +> Docopt.parseArgsOrExit help
    +> \args ->
      if args `has` Docopt.command "test"
        then Test.run test
        else
          if args `has` Docopt.longOption "help" || args `has` Docopt.shortOption 'h'
            then Docopt.exitWithUsage help
            else move args

has :: Docopt.Arguments -> Docopt.Option -> Bool
has = Docopt.isPresent

-- | This ignores the second argument because the default should come from the
-- USAGE text with [default: x].
getArgWithDefault :: Docopt.Arguments -> Docopt.Option -> String
getArgWithDefault args = Docopt.getArgWithDefault args ""