module Main where



#include "prelude.inc"

import Test.Hspec

-- import NeatInterpolation

import UI.Butcher.Monadic
import UI.Butcher.Monadic.Types
import UI.Butcher.Monadic.Interactive



main :: IO ()
main = hspec $ tests

tests :: Spec
tests = do
  describe "checkTests" checkTests
  describe "simpleParseTest" simpleParseTest
  describe "simpleRunTest" simpleRunTest


checkTests :: Spec
checkTests = do
  before_ pending $ it "check001" $ True `shouldBe` True


simpleParseTest :: Spec
simpleParseTest = do
  it "failed parse 001" $ runCmdParser Nothing (InputString "foo") testCmd1
         `shouldSatisfy` Data.Either.isLeft . snd
  it "toplevel" $ (testParse testCmd1 "" >>= _cmd_out)
                  `shouldSatisfy` Maybe.isNothing
  it "hasImpl 001" $ (testParse testCmd1 "abc" >>= _cmd_out)
                  `shouldSatisfy` Maybe.isJust
  it "hasImpl 002" $ (testParse testCmd1 "def" >>= _cmd_out)
                  `shouldSatisfy` Maybe.isJust


simpleRunTest :: Spec
simpleRunTest = do
  it "failed run" $ testRun testCmd1 "" `shouldBe` Right Nothing
  describe "no reordering" $ do
    it "cmd 1" $ testRun testCmd1 "abc" `shouldBe` Right (Just 100)
    it "cmd 2" $ testRun testCmd1 "def" `shouldBe` Right (Just 200)
    it "flag 1" $ testRun testCmd1 "abc -f" `shouldBe` Right (Just 101)
    it "flag 2" $ testRun testCmd1 "abc --flong" `shouldBe` Right (Just 101)
    it "flag 3" $ testRun testCmd1 "abc -f -f" `shouldBe` Right (Just 101)
    it "flag 4" $ testRun testCmd1 "abc -f -g" `shouldBe` Right (Just 103)
    it "flag 5" $ testRun testCmd1 "abc -f -g -f" `shouldSatisfy` Data.Either.isLeft -- no reordering
    it "flag 6" $ testRun testCmd1 "abc -g -f" `shouldSatisfy` Data.Either.isLeft -- no reordering
    it "flag 7" $ testRun testCmd1 "abc -g -g" `shouldBe` Right (Just 102)
  describe "with reordering" $ do
    it "cmd 1" $ testRun testCmd2 "abc" `shouldBe` Right (Just 100)
    it "cmd 2" $ testRun testCmd2 "def" `shouldBe` Right (Just 200)
    it "flag 1" $ testRun testCmd2 "abc -f" `shouldBe` Right (Just 101)
    it "flag 2" $ testRun testCmd2 "abc --flong" `shouldBe` Right (Just 101)
    it "flag 3" $ testRun testCmd2 "abc -f -f" `shouldBe` Right (Just 101)
    it "flag 4" $ testRun testCmd2 "abc -f -g" `shouldBe` Right (Just 103)
    it "flag 5" $ testRun testCmd2 "abc -f -g -f" `shouldBe` Right (Just 103)
    it "flag 6" $ testRun testCmd2 "abc -g -f" `shouldBe` Right (Just 103)
    it "flag 7" $ testRun testCmd2 "abc -g -g" `shouldBe` Right (Just 102)
  describe "with action" $ do
    it "flag 1" $ testRunA testCmd3 "abc" `shouldBe` Right 0
    it "flag 2" $ testRunA testCmd3 "abc -f" `shouldBe` Right 1
    it "flag 3" $ testRunA testCmd3 "abc -g" `shouldBe` Right 2
    it "flag 4" $ testRunA testCmd3 "abc -f -g" `shouldBe` Right 3
    it "flag 5" $ testRunA testCmd3 "abc -g -f" `shouldBe` Right 3
  describe "separated children" $ do
    it "case 1" $ testRun testCmd4 "a aa" `shouldBe` Right (Just 1)
    it "case 2" $ testRun testCmd4 "a ab" `shouldBe` Right (Just 2)
    it "case 3" $ testRun testCmd4 "b ba" `shouldBe` Right (Just 3)
    it "case 4" $ testRun testCmd4 "b bb" `shouldBe` Right (Just 4)
    it "doc" $ show (ppHelpShallow (getDoc "" testCmd4)) `shouldBe`
      List.unlines
        [ "NAME"
        , ""
        , "  test"
        , ""
        , "USAGE"
        , ""
        , "  test a | b"
        ]
    it "doc" $ show (ppHelpShallow (getDoc "a" testCmd4)) `shouldBe`
      List.unlines
        [ "NAME"
        , ""
        , "  test a"
        , ""
        , "USAGE"
        , ""
        , "  test a aa | ab"
        ]
  describe "read flags" $ do
    it "flag 1" $ testRun testCmd5 "abc" `shouldBe` Right (Just 10)
    it "flag 2" $ testRun testCmd5 "abc -f 2" `shouldBe` Right (Just 2)
    it "flag 3" $ testRun testCmd5 "abc --flag 3" `shouldBe` Right (Just 3)
    it "flag 4" $ testRun testCmd5 "abc -f=4" `shouldBe` Right (Just 4)
    it "flag 5" $ testRun testCmd5 "abc --flag=5" `shouldBe` Right (Just 5)
    it "flag 6" $ testRun testCmd5 "abc -f" `shouldSatisfy` Data.Either.isLeft
    it "flag 6" $ testRun testCmd5 "abc -flag 0" `shouldSatisfy` Data.Either.isLeft
    it "flag 6" $ testRun testCmd5 "abc --f 0" `shouldSatisfy` Data.Either.isLeft
  describe "addParamStrings" $ do
    it "case 1" $ testRun' testCmd6 "" `shouldBe` Right (Just ([], 0))
    it "case 2" $ testRun' testCmd6 "-f" `shouldBe` Right (Just ([], 1))
    it "case 3" $ testRun' testCmd6 "abc" `shouldBe` Right (Just (["abc"], 0))
    it "case 4" $ testRun' testCmd6 "abc def" `shouldBe` Right (Just (["abc", "def"], 0))
    it "case 5" $ testRun' testCmd6 "-g abc def" `shouldBe` Right (Just (["abc", "def"], 2))
    it "case 6" $ testRun' testCmd6 "-f -g def" `shouldBe` Right (Just (["def"], 3))
  describe "addParamNoFlagStrings" $ do
    it "case 1" $ testRun' testCmd7 "" `shouldBe` Right (Just ([], 0))
    it "case 2" $ testRun' testCmd7 "-f" `shouldBe` Right (Just ([], 1))
    it "case 3" $ testRun' testCmd7 "abc" `shouldBe` Right (Just (["abc"], 0))
    it "case 4" $ testRun' testCmd7 "abc -f" `shouldBe` Right (Just (["abc"], 1))
    it "case 5" $ testRun' testCmd7 "-g abc -f" `shouldBe` Right (Just (["abc"], 3))
    it "case 6" $ testRun' testCmd7 "abc -g def" `shouldBe` Right (Just (["abc", "def"], 2))
  describe "defaultParam" $ do
    it "case  1" $ testRun testCmdParam "" `shouldSatisfy` Data.Either.isLeft
    it "case  2" $ testRun testCmdParam "n" `shouldSatisfy` Data.Either.isLeft
    it "case  3" $ testRun testCmdParam "y" `shouldSatisfy` Data.Either.isLeft
    it "case  4" $ testRun testCmdParam "False n" `shouldBe` Right (Just 110)
    it "case  5" $ testRun testCmdParam "False y" `shouldBe` Right (Just 310)
    it "case  6" $ testRun testCmdParam "True n" `shouldBe` Right (Just 1110)
    it "case  7" $ testRun testCmdParam "True y" `shouldBe` Right (Just 1310)
    it "case  8" $ testRun testCmdParam "1 False y" `shouldBe` Right (Just 301)
    it "case  9" $ testRun testCmdParam "1 False y def" `shouldBe` Right (Just 201)
    it "case 10" $ testRun testCmdParam "1 False 2 y def" `shouldBe` Right (Just 203)
    it "case 11" $ testRun testCmdParam "1 True 2 y def" `shouldBe` Right (Just 1203)
  describe "completions" $ do
    it "case  1" $ testCompletion completionTestCmd "" `shouldBe` ""
    it "case  2" $ testCompletion completionTestCmd "a" `shouldBe` "bc"
    it "case  3" $ testCompletion completionTestCmd "abc" `shouldBe` ""
    it "case  4" $ testCompletion completionTestCmd "abc " `shouldBe` "-"
    it "case  5" $ testCompletion completionTestCmd "abc -" `shouldBe` ""
    it "case  6" $ testCompletion completionTestCmd "abc --" `shouldBe` "flag"
    it "case  7" $ testCompletion completionTestCmd "abc -f" `shouldBe` ""
    it "case  8" $ testCompletion completionTestCmd "abcd" `shouldBe` "ef"
    it "case  9" $ testCompletion completionTestCmd "gh" `shouldBe` "i"
    it "case 10" $ testCompletion completionTestCmd "ghi" `shouldBe` ""
    it "case 11" $ testCompletion completionTestCmd "ghi " `shouldBe` "jkl"



testCmd1 :: CmdParser Identity (WriterS.Writer (Sum Int) ()) ()
testCmd1 = do
  addCmd "abc" $ do
    f <- addSimpleBoolFlag "f" ["flong"] mempty
    g <- addSimpleBoolFlag "g" ["glong"] mempty
    addCmdImpl $ do
      when f $ WriterS.tell 1
      when g $ WriterS.tell 2
      WriterS.tell 100
  addCmd "def" $ do
    addCmdImpl $ do
      WriterS.tell 200

testCmd2 :: CmdParser Identity (WriterS.Writer (Sum Int) ()) ()
testCmd2 = do
  addCmd "abc" $ do
    reorderStart
    f <- addSimpleBoolFlag "f" ["flong"] mempty
    g <- addSimpleBoolFlag "g" ["glong"] mempty
    reorderStop
    addCmdImpl $ do
      when f $ WriterS.tell 1
      when g $ WriterS.tell 2
      WriterS.tell 100
  addCmd "def" $ do
    addCmdImpl $ do
      WriterS.tell 200

testCmd3 :: CmdParser (StateS.State Int) () ()
testCmd3 = do
  addCmd "abc" $ do
    reorderStart
    addSimpleFlagA "f" ["flong"] mempty (StateS.modify (+1))
    addSimpleFlagA "g" ["glong"] mempty (StateS.modify (+2))
    reorderStop
    addCmdImpl ()
  addCmd "def" $ do
    addCmdImpl ()

testCmd4 :: CmdParser Identity (WriterS.Writer (Sum Int) ()) ()
testCmd4 = do
  addCmd "a" $ do
    addCmd "aa" $ do
      addCmdImpl $ WriterS.tell 1
  addCmd "b" $ do
    addCmd "bb" $ do
      addCmdImpl $ WriterS.tell 4
  addCmd "a" $ do
    addCmd "ab" $ do
      addCmdImpl $ WriterS.tell 2
  addCmd "b" $ do
    addCmd "ba" $ do
      addCmdImpl $ WriterS.tell 3

testCmd5 :: CmdParser Identity (WriterS.Writer (Sum Int) ()) ()
testCmd5 = do
  addCmd "abc" $ do
    x <- addFlagReadParam "f" ["flag"] "flag" (flagDefault (10::Int))
    addCmdImpl $ WriterS.tell (Sum x)

testCmd6 :: CmdParser Identity (WriterS.Writer (Sum Int) [String]) ()
testCmd6 = do
  f <- addSimpleBoolFlag "f" ["flong"] mempty
  g <- addSimpleBoolFlag "g" ["glong"] mempty
  args <- addParamStrings "ARGS" mempty
  addCmdImpl $ do
    when f $ WriterS.tell 1
    when g $ WriterS.tell 2
    pure args

testCmd7 :: CmdParser Identity (WriterS.Writer (Sum Int) [String]) ()
testCmd7 = do
  reorderStart
  f <- addSimpleBoolFlag "f" ["flong"] mempty
  g <- addSimpleBoolFlag "g" ["glong"] mempty
  args <- addParamNoFlagStrings "ARGS" mempty
  reorderStop
  addCmdImpl $ do
    when f $ WriterS.tell 1
    when g $ WriterS.tell 2
    pure args

testCmdParam :: CmdParser Identity (WriterS.Writer (Sum Int) ()) ()
testCmdParam = do
  p :: Int <- addParamRead "INT" (paramDefault 10)
  b <- addParamRead "MANDR" mempty
  r <- addParamReadOpt "MAY1" (paramDefault 20)
  s <- addParamString "MAND" mempty
  q <- addParamString "STR" (paramDefault "abc")
  addCmdImpl $ do
    WriterS.tell (Sum p)
    when (q=="abc") $ WriterS.tell 100
    r `forM_` (WriterS.tell . Sum)
    when b $ WriterS.tell $ Sum 1000
    when (s=="y") $ WriterS.tell 200
    pure ()

completionTestCmd :: CmdParser Identity () ()
completionTestCmd = do
  addCmd "abc" $ do
    _ <- addSimpleBoolFlag "f" ["flag"] mempty
    addCmdImpl ()
  addCmd "abcdef" $ do
    _ <- addSimpleBoolFlag "f" ["flag"] mempty
    addCmdImpl ()
  addCmd "ghi" $ do
    addCmd "jkl" $ do
      addCmdImpl ()

testCompletion :: CmdParser Identity a () -> String -> String
testCompletion p inp = case runCmdParserExt Nothing (InputString inp) p of
  (cDesc, InputString cRest, _) -> simpleCompletion inp cDesc cRest
  _ -> error "wut"


testParse :: CmdParser Identity out () -> String -> Maybe (CommandDesc out)
testParse cmd s = either (const Nothing) Just
                $ snd
                $ runCmdParser Nothing (InputString s) cmd

testRun :: CmdParser Identity (WriterS.Writer (Sum Int) ()) () -> String -> Either ParsingError (Maybe Int)
testRun cmd s = fmap (fmap (getSum . WriterS.execWriter) . _cmd_out)
              $ snd
              $ runCmdParser Nothing (InputString s) cmd

testRun' :: CmdParser Identity (WriterS.Writer (Sum Int) a) () -> String -> Either ParsingError (Maybe (a, Int))
testRun' cmd s =
  fmap (fmap (fmap getSum . WriterS.runWriter) . _cmd_out) $ snd $ runCmdParser
    Nothing
    (InputString s)
    cmd

testRunA :: CmdParser (StateS.State Int) () () -> String -> Either ParsingError Int
testRunA cmd str = (\((_, e), s) -> e $> s)
                 $ flip StateS.runState (0::Int)
                 $ runCmdParserA Nothing (InputString str) cmd

getDoc :: String -> CmdParser Identity out () -> CommandDesc ()
getDoc s = fst . runCmdParser (Just "test") (InputString s)
