content: {-# LANGUAGE OverloadedStrings   #-}
  {-# LANGUAGE QuasiQuotes         #-}
  {-# LANGUAGE RankNTypes          #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  
  module Test.Prelude.List (tests) where
  
  
  
  import qualified Data.List   as L
  import           Data.Text   (Text)
  
  import           Stg.Language
  import           Stg.Machine.Types
  import           Stg.Marshal
  import           Stg.Parser.QuasiQuoter
  import qualified Stg.Prelude            as Stg
  
  import Test.Machine.Evaluate.TestTemplates.MarshalledValue
  import Test.Orphans                                        ()
  import Test.QuickCheck.Modifiers
  import Test.Tasty
  
  
  
  tests :: TestTree
  tests = testGroup "List"
      [ testConcat2
      , testReverse
      , testLength
      , testCycle
      , testIterate
      , testRepeat
      , testReplicate
      , testGroup "Sort"
          [ testSort
          , testNaiveSort ]
      , testFilter
      , testPartition
      , testMap
      , testZip
      , testZipWith
      , testGroup "Folds"
          [ testFoldr
          , testFoldl
          , testFoldl' ]
      ]
  
  testFilter :: TestTree
  testFilter = marshalledValueTest defSpec
      { testName = "filter"
      , sourceSpec = \(xs, threshold :: Integer) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = filter (> threshold) xs
          , source = mconcat
              [ toStg "inputList" xs
              , toStg "threshold" threshold
              , Stg.gt_Int
              , Stg.force
              , Stg.filter
              , [stg|
              main = \ =>
                  letrec
                      positive = \x -> gt_Int x threshold;
                      filtered = \(positive) => filter positive inputList
                  in force filtered
              |] ]}}
  
  testPartition :: TestTree
  testPartition = marshalledValueTest defSpec
      { testName = "partition"
      , failWithInfo = True
      , sourceSpec = \(xs, threshold :: Integer) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = L.partition (> threshold) xs
          , source = mconcat
              [ toStg "inputList" xs
              , toStg "threshold" threshold
              , Stg.gt_Int
              , Stg.force
              , Stg.partition
              , [stg|
              main = \ =>
                  letrec
                      positive = \x -> gt_Int x threshold;
                      partitioned = \(positive) => partition positive inputList
                  in force partitioned
              |] ]}}
  
  testSort :: TestTree
  testSort = marshalledValueTest defSpec
      { testName = "sort (Haskell/base version)"
      , sourceSpec = \(xs :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = L.sort xs
          , source = mconcat
              [ toStg "inputList" xs
              , Stg.sort
              , Stg.force
              , [stg|
              main = \ =>
                  let sorted = \ => sort inputList
                  in force sorted
              |] ]}}
  
  testNaiveSort :: TestTree
  testNaiveSort = marshalledValueTest defSpec
      { testName = "sort (naive version)"
      , sourceSpec = \(xs :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = L.sort xs
          , source = mconcat
              [ toStg "inputList" xs
              , Stg.naiveSort
              , Stg.force
              , [stg|
              main = \ =>
                  let sorted = \ => naiveSort inputList
                  in force sorted
              |] ]}}
  
  testMap :: TestTree
  testMap = marshalledValueTest defSpec
      { testName = "map"
      , sourceSpec = \(xs, offset :: Integer) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = map (+offset) xs
          , source = mconcat
              [ Stg.add
              , Stg.map
              , Stg.force
              , toStg "offset" offset
              , toStg "inputList" xs
              , [stg|
              main = \ =>
                  letrec
                      plusOffset = \n -> add n offset;
                      result = \(plusOffset) => map plusOffset inputList
                  in force result
              |] ]}}
  
  testZip :: TestTree
  testZip = marshalledValueTest defSpec
      { testName = "zip, map"
      , sourceSpec = \(list1, list2 :: [Integer]) ->  MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = zipWith (+) list1 list2
          , source = mconcat
              [ toStg "list1" list1
              , toStg "list2" list2
              , Stg.add
              , Stg.map
              , Stg.uncurry
              , Stg.zip
              , Stg.force
              , [stg|
              main = \ =>
                  letrec
                      zipped   = \ -> zip list1 list2;
                      addTuple = \ -> uncurry add;
                      summed   = \(addTuple zipped) => map addTuple zipped
                  in force summed
              |] ]}}
  
  testZipWith :: TestTree
  testZipWith = marshalledValueTest defSpec
      { testName = "zipWith (+)"
      , sourceSpec = \(list1, list2 :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = zipWith (+) list1 list2
          , source = mconcat
              [ toStg "list1" list1
              , toStg "list2" list2
              , Stg.add
              , Stg.zipWith
              , Stg.force
              , [stg|
              main = \ =>
                  let zipped = \ => zipWith add list1 list2
                  in force zipped
              |] ]}}
  
  
  testFoldr, testFoldl, testFoldl' :: TestTree
  testFoldr  = foldSumTemplate
      "foldr"
      foldr
      (Stg.foldr <> [stg| fold = \ -> foldr |])
      (const False)
  testFoldl  = foldSumTemplate
      "foldl"
      foldl
      (Stg.foldl <> [stg| fold = \ -> foldl |])
      (const False)
  testFoldl' = foldSumTemplate
      "foldl'"
      L.foldl'
      (Stg.foldl' <> [stg| fold = \ -> foldl' |])
      (\stgState -> length (stgStack stgState) >= 8) -- Stack should stay small!
  
  foldSumTemplate
      :: Text
          -- ^ Fold function name
  
      -> (forall a. (a -> a -> a) -> a -> [a] -> a)
          -- ^ Haskell reference fold function
  
      -> Program
          -- ^ STG Program with binding associating "fold" with the desired fold
          -- function, e.g. foldr
  
      -> (StgState -> Bool)
          -- ^ Failure predicate; useful in foldl' to check bounded stack size
  
      -> TestTree
  foldSumTemplate foldName foldF foldStg failP
    = marshalledValueTest defSpec
      { testName = foldName
      , maxSteps = 1024
      , failPredicate = failP
      , sourceSpec = \(z :: Integer, xs) ->  MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = foldF (+) z xs
          , source = mconcat
              [ foldStg
              , Stg.add
              , Stg.force
              , toStg "z" z
              , toStg "input" xs
              , [stg|
              main = \ =>
                  let result = \ => fold add z input
                  in force result
              |] ]}}
  
  testConcat2 :: TestTree
  testConcat2 = marshalledValueTest defSpec
      { testName = "(++)"
      , sourceSpec = \(list1, list2 :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = list1 ++ list2
          , source = mconcat
              [ toStg "list1" list1
              , toStg "list2" list2
              , Stg.concat2
              , Stg.force
              , [stg|
              main = \ =>
                  let concatenated = \ => concat2 list1 list2
                  in force concatenated
              |] ]}}
  
  testReverse :: TestTree
  testReverse = marshalledValueTest defSpec
      { testName = "reverse"
      , maxSteps = 1024
      , sourceSpec = \(xs :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = reverse xs
          , source = mconcat
              [ toStg "input" xs
              , Stg.reverse
              , Stg.force
              , [stg|
              main = \ =>
                  let reversed = \ => reverse input
                  in force reversed
              |] ]}}
  
  testCycle :: TestTree
  testCycle = marshalledValueTest defSpec
      { testName = "cycle (+take)"
      , sourceSpec = \(NonEmpty (list :: [Integer]), NonNegative n) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = take n (cycle list)
          , source = mconcat
              [ toStg "n" n
              , toStg "list" list
              , Stg.take
              , Stg.cycle
              , Stg.force
              , [stg|
              main = \ =>
                  letrec
                      cycled = \ -> cycle list;
                      takeCycled = \(cycled) => take n cycled
                  in force takeCycled
              |] ]}}
  
  testRepeat :: TestTree
  testRepeat = marshalledValueTest defSpec
      { testName = "repeat (+take)"
      , sourceSpec = \(item :: Integer, NonNegative n) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue =replicate n item
          , source = mconcat
              [ toStg "n" n
              , toStg "item" item
              , Stg.take
              , Stg.repeat
              , Stg.force
              , [stg|
              main = \ =>
                  letrec
                      repeated = \ -> repeat item;
                      takeRepeated = \(repeated) => take n repeated
                  in force takeRepeated
              |] ]}}
  
  testReplicate :: TestTree
  testReplicate = marshalledValueTest defSpec
      { testName = "replicate"
      , maxSteps = 1024
      , failPredicate = \stgState -> case stgCode stgState of
          Eval AppP {} _ -> True
          _ -> False
      , sourceSpec = \(item :: Integer, n) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = replicate n item
          , source = mconcat
              [ toStg "n" n
              , toStg "item" item
              , Stg.replicate
              , Stg.force
              , [stg|
              main = \ =>
                  let replicated = \ => replicate n item
                  in force replicated
              |] ]}}
  
  testIterate :: TestTree
  testIterate = marshalledValueTest defSpec
      { testName = "iterate (+take)"
      , sourceSpec = \(seed, offset :: Integer, NonNegative n) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = take n (iterate (+offset) seed)
          , source = mconcat
              [ toStg "n" n
              , toStg "offset" offset
              , toStg "seed" seed
              , Stg.add
              , Stg.take
              , Stg.iterate
              , Stg.force
              , [stg|
              main = \ =>
                  letrec
                      addOffset = \ -> add offset;
                      iterated = \(addOffset) -> iterate addOffset seed;
                      takeIterated = \(iterated) => take n iterated
                  in force takeIterated
              |] ]}}
  
  testLength :: TestTree
  testLength = marshalledValueTest defSpec
      { testName = "length"
      , sourceSpec = \(xs :: [Integer]) -> MarshalSourceSpec
          { resultVar = "main"
          , expectedValue = fromIntegral (length xs) :: Integer
          , source = mconcat
              [ toStg "input" xs
              , Stg.length
              , Stg.force
              , [stg|
              main = \ =>
                  let len = \ => length input
                  in force len
              |] ]}}
  