List.hs

{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeApplications       #-}
{-# LANGUAGE TypeFamilies           #-}
{-# LANGUAGE TypeInType             #-}
{-# LANGUAGE TypeOperators          #-}
{-# LANGUAGE UndecidableInstances   #-}
{-# OPTIONS_GHC -Wall                       #-}
{-# OPTIONS_GHC -Werror=incomplete-patterns #-}

{- 
In this module, we test mainly Fcf.Alg.List module. In couple of 
places, we use the "spec" and Reflect. 

Many of the tests are such that if the answer is not correct, the
whole test module refuses to compile.  Please do try to change some 
of the values to see. 

Note that in a way, the spec tests are not needed. If testing just 
the type level behaviour, the module would refuse to compile if 
test is not ok (and thus, guard the quality earlier than what the 
test framework can do).  

Anyhow, as these also work as examples, it is probably ok to have different 
ways of reaching the results. (E.g. to see, how to get the type level 
values to value level.)

-}
module Test.Alg.List where

import           Data.Proxy
import           Data.Type.Equality ((:~:)(Refl))
import           Test.Hspec (describe, it, shouldBe, Spec)

import           Fcf.Core (Eval)
import           Fcf.Combinators (type (=<<))
import           Fcf.Alg.List
import           Fcf.Alg.Morphism
import           Fcf.Data.Reflect (fromType)

--------------------------------------------------------------------------------

-- This module won't compile, if the Refl doesn't give the correct answer.
--
-- > :kind! Eval (ListToFix '[1,2,3])
-- Eval (ListToFix '[1,2,3]) :: Fix (ListF TL.Natural)
-- = 'Fix ('ConsF 1 ('Fix ('ConsF 2 ('Fix ('ConsF 3 ('Fix 'NilF))))))
_ = Refl :: Eval (ListToFix '[1,2,3])
  :~: 'Fix ('ConsF 1 ('Fix ('ConsF 2 ('Fix ('ConsF 3 ('Fix 'NilF))))))


-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (ListToParaFix '[1,2,3])
-- Eval (ListToParaFix '[1,2,3]) :: Fix
--                                    (ListF (TL.Natural, [TL.Natural]))
-- = 'Fix
--     ('ConsF
--        '(1, '[2, 3])
--        ('Fix ('ConsF '(2, '[3]) ('Fix ('ConsF '(3, '[]) ('Fix 'NilF))))))
_ = Refl :: Eval (ListToParaFix '[1,2,3])
  :~: 'Fix ('ConsF
       '(1, '[2, 3])
       ('Fix ('ConsF '(2, '[3]) ('Fix ('ConsF '(3, '[]) ('Fix 'NilF))))))


-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (Para DedupAlg =<< ListToParaFix '[1,1,3,2,5,1,3,2])
-- Eval (Para DedupAlg =<< ListToParaFix '[1,1,3,2,5,1,3,2]) :: [TL.Natural]
-- = '[5, 1, 3, 2]
_ = Refl :: Eval (Para DedupAlg =<< ListToParaFix '[1,1,3,2,5,1,3,2])
  :~: '[5, 1, 3, 2]


-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (Sliding 3 '[1,2,3,4,5,6])
-- Eval (Sliding 3 '[1,2,3,4,5,6]) :: [[TL.Natural]]
-- = '[ '[1, 2, 3], '[2, 3, 4], '[3, 4, 5], '[4, 5, 6], '[5, 6], '[6]]
_ = Refl :: Eval (Sliding 3 '[1,2,3,4,5,6])
  :~: '[ '[1, 2, 3], '[2, 3, 4], '[3, 4, 5], '[4, 5, 6], '[5, 6], '[6]]


-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (Evens =<< RunInc 8)
-- Eval (Evens =<< RunInc 8) :: [TL.Natural]
-- = '[2, 4, 6, 8]
_ = Refl :: Eval (Evens =<< RunInc 8)
  :~: '[2, 4, 6, 8]


-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (RunInc 8)
-- Eval (RunInc 8) :: [TL.Natural]
-- = '[1, 2, 3, 4, 5, 6, 7, 8]
_ = Refl :: Eval (RunInc 8)
  :~: '[1, 2, 3, 4, 5, 6, 7, 8]


-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (MToN 1 3)
-- Eval (MToN 1 3) :: [TL.Natural]
-- = '[1, 2, 3]
_ = Refl :: Eval (MToN 1 3)
  :~: '[1, 2, 3]

-- This module won't compile, if the Refl doesn't give the correct answer.
--  
-- > :kind! Eval (ToList 1)
-- Eval (ToList 1) :: [TL.Natural]
-- = '[1]
_ = Refl :: Eval (ToList 1)
  :~: '[1]

  
--------------------------------------------------------------------------------

-- > :kind! Eval (Cata LenAlg =<< ListToFix '[1,2,3])
-- Eval (Cata LenAlg =<< ListToFix '[1,2,3]) :: TL.Natural
-- = 3

-- > :kind! Eval (Cata SumAlg =<< ListToFix '[1,2,3,4])
-- Eval (Cata SumAlg =<< ListToFix '[1,2,3,4]) :: TL.Natural
-- = 10

-- > :kind! Eval (Cata ProdAlg =<< ListToFix '[1,2,3,4])
-- Eval (Cata ProdAlg =<< ListToFix '[1,2,3,4]) :: TL.Natural
-- = 24

-- > :kind! Eval (Sum '[1,2,3])
-- Eval (Sum '[1,2,3]) :: TL.Natural
-- = 6

-- > :kind! Eval (Equal '[1,2,3] '[1,2,3])
-- Eval (Equal '[1,2,3] '[1,2,3]) :: Bool
-- = 'True

-- > :kind! Eval (Equal '[1,2,3] '[1,3,2])
-- Eval (Equal '[1,2,3] '[1,3,2]) :: Bool
-- = 'False

spec :: Spec
spec = describe "List" $ do
  it "Cata LenAlg" $ do
    let test :: forall r. (r ~ Eval (Cata LenAlg =<< ListToFix '[1,2,3])) => Int
        test = fromType (Proxy @r)
    test `shouldBe` 3
  it "Cata SumAlg" $ do
    let test :: forall r. (r ~ Eval (Cata SumAlg =<< ListToFix '[1,2,3,4])) => Int
        test = fromType (Proxy @r)
    test `shouldBe` 10
  it "Cata ProdAlg" $ do
    let test :: forall r. (r ~ Eval (Cata ProdAlg =<< ListToFix '[1,2,3,4])) => Int
        test = fromType (Proxy @r)
    test `shouldBe` 24
  it "Sum" $ do
    let test :: forall r. (r ~ Eval (Sum '[1,2,3])) => Int
        test = fromType (Proxy @r)
    test `shouldBe` 6
  it "Equal, True" $ do
    let test :: forall r. (r ~ Eval (Equal '[1,2,3] '[1,2,3])) => Bool
        test = fromType (Proxy @r)
    test `shouldBe` True
  it "Equal, False" $ do
    let test :: forall r. (r ~ Eval (Equal '[1,2,3] '[1,3,2])) => Bool
        test = fromType (Proxy @r)
    test `shouldBe` False