ReprintSpec.hs

{-# OPTIONS -Wno-orphans #-}
{-# LANGUAGE FlexibleInstances #-}

module Camfort.ReprintSpec (spec) where

import           Camfort.Reprint
import qualified Data.ByteString.Char8 as B
import qualified Language.Fortran.Util.Position as FU
import           Test.Hspec
import           Test.QuickCheck

spec :: Spec
spec =
  describe "subtext function tests" $ do
    it "(unit test) first line of sample text" $
      subtext (1, 1) (1, 1) (2, 1) btext `shouldBe`
              (B.pack (text !! 0 ++ "\n"), B.pack (unlines . tail $ text))

    it "(unit test) second line of sample text" $
      subtext (1, 1) (2, 1) (3, 1) btext `shouldBe`
              (B.pack (text !! 1 ++ "\n"), B.pack (unlines . tail . tail $ text))

    it "(unit test) third line of sample text" $
      subtext (1, 1) (4, 1) (5, 1) btext `shouldBe`
              (B.pack (text !! 3 ++ "\n"), B.empty)

    it "(unit test) fourth line, middle, of sample text" $
      subtext (1, 1) (4, 2) (4, 5) btext `shouldBe`
              (B.pack "G H", B.pack " I J K L\n")

    it "(unit test) relative test (third line)" $
      subtext (3, 1) (5, 1) (6, 1) btext `shouldBe`
              (B.pack "  E F\n", B.pack " G H I J K L\n")

    it "(unit test) relative test (third line fragment)" $
      subtext (3, 1) (5, 1) (5, 4) btext `shouldBe`
              (B.pack "  E", B.pack " F\n G H I J K L\n")

    it "zero-length span at start yields empty string" $ property $
      \s -> subtext (0, 0) (0, 0) (0, 0) s == (B.empty, s)

    it "zero-length span yields empty substring" $ property $
      \(l,c) -> \s -> (fst $ subtext (l,c) (l,c) (l,c) s) == B.empty

{-
    it "takeBounds is the same as old one" $ property $
      \p   -> takeBoundsOld (FU.initPosition, p) btext
           == takeBounds    (FU.initPosition, p) btext

    it "takeBounds is the same as old one, with different start pos" $ property $
      \p   -> takeBoundsOld (FU.Position 0 2 2, unwrapPO p) btext
           == takeBounds    (FU.Position 0 2 2, unwrapPO p) btext
-}

    it "takeBounds test 1" $
      (fst $ takeBounds (FU.Position 0 2 2 "" Nothing, FU.Position 0 5 2 "" Nothing) btext)
        `shouldBe` (B.pack "A B")

    it "takeBounds test 2" $
      (fst $ takeBounds (FU.Position 0 2 2 "" Nothing, FU.Position 0 1 3 "" Nothing) btext)
        `shouldBe` (B.pack "A B C D\n")

    it "takeBound test 3" $
      (fst $ takeBounds (FU.Position 1 1 1 "" Nothing, FU.Position 1 5 3 "" Nothing) btext2)
        `shouldBe` (B.pack $ unlines $ take 3 text2)

    -- TODO: Fix this
    -- context "Integration test with synthesising a spec" $ do
    --    let simpleDir = "tests" </> "fixtures"
    --        simpleIn  = simpleDir </> "simple.f90"
    --        simpleExpected = simpleDir </> "simple.expected.f90"
    --        simpleOut = simpleDir </> "simple.f90.out"
    --    runIO $ unitsSynth simpleIn (Just simpleIn) []
    --      LitMixed False
    --      simpleOut ATDefault
    --    actual <- runIO $ readFile simpleOut
    --    expected <- runIO $ readFile simpleExpected
    --    it "Unit synth" $ actual `shouldBe` expected

----

data PlusOne a = PlusOne { _unwrapPO :: a } deriving Show

instance Arbitrary (PlusOne FU.Position) where
    arbitrary = do
      FU.Position offset col line f p <- arbitrary
      let col' = if line == 1 then col+1 else col
      return $ PlusOne $ FU.Position offset col' (line + 1) f p

instance Arbitrary FU.Position where
    arbitrary = do
      offset <- arbitrary `suchThat` (>0)
      line   <- arbitrary `suchThat` (\x -> x >= 1 && x <= (length text))
      col    <- choose (1, orOne $ length (text !! (line - 1)))
      return $ FU.Position offset col line "<generated>" Nothing

orOne :: (Eq p, Num p) => p -> p
orOne x | x == 0    = 1
        | otherwise = x

-- Arbtirary ByteString
instance Arbitrary B.ByteString where
    arbitrary = do
      numLines <- choose (0, 3)
      return . B.pack . concat $ take numLines text

btext :: B.ByteString
btext = B.pack . unlines $ text
text :: [[Char]]
text = ["A B C D"
       ,""
       ,"  E F"
       ," G H I J K L"]

btext2 :: B.ByteString
btext2 = B.pack . unlines $ text2
text2 :: [[Char]]
text2 = ["A B C D"
       ,"E F"
       ,"G H"
       ,"I J K L"]

{-
-- Given a lower-bound and upper-bound pair of FU.Positions, split the
-- incoming SourceText based on the distanceF between the FU.Position pairs
takeBoundsOld :: (FU.Position, FU.Position) -> SourceText -> (SourceText, SourceText)
takeBoundsOld (l, u) = takeBounds' ((ll, lc), (ul, uc)) B.empty
  where (FU.Position _ lc ll) = l
        (FU.Position _ uc ul) = u
        takeBounds' ((ll, lc), (ul, uc)) tk inp  =
          if (ll == ul && lc == uc) || (ll > ul) then (B.reverse tk, inp)
          else
            case B.uncons inp of
              Nothing         -> (B.reverse tk, inp)
              Just ('\n', ys) -> takeBounds' ((ll+1, 1), (ul, uc))  (B.cons '\n' tk) ys
              Just (x, xs)    -> takeBounds' ((ll, lc+1), (ul, uc)) (B.cons x tk) xs
-}