content: {-# LANGUAGE GeneralizedNewtypeDeriving #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module Automaton where
  
  -- base
  import Control.Applicative (Alternative (..))
  import Control.Arrow
  import Control.Monad (guard)
  import Data.Functor.Identity (runIdentity)
  import Data.List (uncons)
  import Data.Maybe (maybeToList)
  
  -- transformers
  import Control.Monad.State.Strict (StateT (..))
  
  -- selective
  import Control.Selective ((<*?))
  
  -- tasty
  import Test.Tasty (testGroup)
  
  -- tasty-quickcheck
  import Test.Tasty.QuickCheck
  
  -- tasty-hunit
  import Test.Tasty.HUnit (testCase, (@?=))
  
  -- automaton
  import Automaton.Except
  import Automaton.Trans.Accum
  import Automaton.Trans.Changeset
  import Data.Automaton
  import Data.Automaton.Recursive
  import Data.Automaton.Trans.Maybe
  
  tests =
    testGroup
      "Automaton"
      [ testGroup
          "Alternative"
          [ testGroup
              "<|>"
              [ testProperty "has same semantics as recursive" $
                  \(input :: [(Maybe Int, Maybe Int)]) ->
                    embed ((arr fst >>> inMaybe) <|> (arr snd >>> inMaybe)) input
                      === embed (fromRecursive $ (arr fst >>> toRecursive inMaybe) <|> (arr snd >>> toRecursive inMaybe)) input
              ]
          , testGroup
              "some"
              [ testCase "Maybe" $ embed (some $ arrM id) [Nothing] @?= (Nothing :: Maybe [[()]])
              , testCase "Parser" $ runParser (embed (some $ constM aChar) [(), ()]) "hi" @?= [(["h", "i"], "")]
              ]
          , testGroup
              "many"
              [ testCase "Maybe" $ embed (many $ arrM id) [Nothing] @?= (Just [[]] :: Maybe [[()]])
              , testCase "Parser" $ runParser (many (char 'h')) "hi" @?= [("h", "i"), ("", "hi")]
              ]
          ]
      , testGroup
          "parallely"
          [ testCase "Outputs separate sums" $ runIdentity (embed (parallely sumN) [[], [], [1, 2], [10, 20], [100], [], [1000, 200]]) @?= [[], [], [1, 2], [11, 22], [111], [], [1111, 222]]
          ]
      , testGroup
          "Selective"
          [ testCase "selects second Automaton conditionally" $
              runIdentity (embed (right sumN <*? arr (const (* 2))) [Right 1, Right 2, Left 10, Right 3, Left 20]) @?= [1, 3, 20, 6, 40]
          ]
      , testCase "count" $ runIdentity (embed count [(), (), ()]) @?= [1, 2, 3]
      , testCase "delay" $ runIdentity (embed (count >>> delay 0) [(), (), ()]) @?= [0, 1, 2]
      , testCase "sumS" $ runIdentity (embed (arr (const (1 :: Float)) >>> sumS) [(), (), ()]) @?= [1, 2, 3]
      , testCase "sumN" $ runIdentity (embed (arr (const (1 :: Integer)) >>> sumN) [(), (), ()]) @?= [1, 2, 3]
      , testCase "lastS" $ runIdentity (embed (lastS 0) [Nothing, Just 10]) @?= [0, 10]
      , Automaton.Except.tests
      , Automaton.Trans.Accum.tests
      , Automaton.Trans.Changeset.tests
      ]
  
  inMaybe :: Automaton Maybe (Maybe a) a
  inMaybe = hoistS (runIdentity . runMaybeT) inMaybeT
  
  -- * Parser helper type to test many & some
  
  newtype Parser a = Parser {getParser :: StateT String [] a}
    deriving (Functor, Applicative, Monad, Alternative)
  
  runParser :: Parser a -> String -> [(a, String)]
  runParser = runStateT . getParser
  
  aChar :: Parser Char
  aChar = Parser $ StateT $ maybeToList . uncons
  
  char :: Char -> Parser Char
  char c = do
    c' <- aChar
    guard $ c == c'
    return c
  