automaton-1.4: test/Automaton.hs

{-# 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 Data.Automaton
import Data.Automaton.Final
import Data.Automaton.Trans.Maybe

tests =
  testGroup
    "Automaton"
    [ testGroup
        "Alternative"
        [ testGroup
            "<|>"
            [ testProperty "has same semantics as final" $
                \(input :: [(Maybe Int, Maybe Int)]) ->
                  embed ((arr fst >>> inMaybe) <|> (arr snd >>> inMaybe)) input
                    === embed (fromFinal $ (arr fst >>> toFinal inMaybe) <|> (arr snd >>> toFinal 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
    ]

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