Tests.hs

{-# LANGUAGE TemplateHaskell #-}

module Snap.Snaplet.Internal.LensT.Tests (tests) where

import           Control.Lens
import           Control.Applicative
import           Control.Category
import           Control.Monad.Identity
import           Control.Monad.State.Strict
import           Prelude hiding (catch, (.))
import           Test.Framework
import           Test.Framework.Providers.HUnit
import           Test.HUnit hiding (Test, path)


------------------------------------------------------------------------------
import           Snap.Snaplet.Internal.LensT


------------------------------------------------------------------------------
data TestType = TestType {
      _int0 :: Int
    , _sub  :: TestSubType
} deriving (Show)

data TestSubType = TestSubType {
      _sub0 :: Int
    , _sub1 :: Int
    , _bot  :: TestBotType
} deriving (Show)

data TestBotType = TestBotType {
      _bot0 :: Int
} deriving (Show)

makeLenses ''TestType
makeLenses ''TestSubType
makeLenses ''TestBotType


------------------------------------------------------------------------------
defaultState :: TestType
defaultState = TestType 1 $ TestSubType 2 999 $ TestBotType 3


------------------------------------------------------------------------------
tests :: Test
tests = testGroup "Snap.Snaplet.Internal.LensT"
                  [ testfmap
                  , testApplicative
                  , testMonadState
                  ]


------------------------------------------------------------------------------
testfmap :: Test
testfmap = testCase "lensed/fmap" $ do
--    x <- evalStateT (lensedAsState (fmap (*2) three) (bot . sub)) defaultState
    let x = fst $ runIdentity (runLensT (fmap (*2) three) (sub . bot) defaultState)
    assertEqual "fmap" 6 x

    let (y,s') = runIdentity (runLensT twiddle (sub . bot) defaultState)

    assertEqual "fmap2" (12 :: Int) y
    assertEqual "lens" (13 :: Int) $ _bot0 $ _bot $ _sub s'
    return ()

  where
--    three :: LensT TestType TestBotType IO Int
    three = return 3

    twiddle = do
        modify $ \(TestBotType x) -> TestBotType (x+10)
        fmap (+9) three


------------------------------------------------------------------------------
testApplicative :: Test
testApplicative = testCase "lensed/applicative" $ do
--    x <- evalStateT (lensedAsState (pure (*2) <*> three) (bot . sub)) defaultState
    let x = fst $ runIdentity (runLensT (pure (*2) <*> three) (sub . bot) defaultState)
    assertEqual "fmap" 6 x

    let (y,s') = runIdentity (runLensT twiddle (sub . bot) defaultState)

    assertEqual "fmap2" (12::Int) y
    assertEqual "lens" 13 $ _bot0 $ _bot $ _sub s'
    return ()

  where
--    three :: LensT TestType TestBotType IO Int
    three = pure 3

    twiddle = do
        modify $ \(TestBotType x) -> TestBotType (x+10)
        pure [] *> (pure (+9) <*> three) <* pure []


------------------------------------------------------------------------------
testMonadState :: Test
testMonadState = testCase "lens/MonadState" $ do
--    s <- execStateT (lensedAsState go (bot0 . bot . sub)) defaultState
    let s = snd $ runIdentity (runLensT go (sub . bot . bot0) defaultState)

    assertEqual "bot0" 9 $ _bot0 $ _bot $ _sub s
    assertEqual "sub0" 3 $ _sub0 $ _sub s
    assertEqual "sub1" 999 $ _sub1 $ _sub s

  where
--    go :: LensT TestType Int IO ()
    go = do
        modify (*2)
        modify (+3)
        withTop sub go'

--    go' :: LensT TestType TestSubType IO ()
    go' = do
        a <- with sub0 get
        with sub0 $ put $ a+1