megaparsec/tests/Pos.hs

-- -*- Mode: Haskell; -*-
--
-- QuickCheck tests for Megaparsec's textual source positions.
--
-- Copyright © 2015 Megaparsec contributors
--
-- Redistribution and use in source and binary forms, with or without
-- modification, are permitted provided that the following conditions are
-- met:
--
-- * Redistributions of source code must retain the above copyright notice,
--   this list of conditions and the following disclaimer.
--
-- * Redistributions in binary form must reproduce the above copyright
--   notice, this list of conditions and the following disclaimer in the
--   documentation and/or other materials provided with the distribution.
--
-- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS “AS IS” AND ANY
-- EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-- WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-- DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS BE LIABLE FOR ANY
-- DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
-- DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
-- OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
-- HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT,
-- STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN
-- ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
-- POSSIBILITY OF SUCH DAMAGE.

{-# OPTIONS -fno-warn-orphans #-}

module Pos (tests) where

import Data.Char (isAlphaNum)
import Data.List (intercalate, isInfixOf, elemIndices)

import Test.Framework
import Test.Framework.Providers.QuickCheck2 (testProperty)
import Test.QuickCheck

import Text.Megaparsec.Pos

#if !MIN_VERSION_base(4,8,0)
import Control.Applicative ((<$>), (<*>), pure)
#endif

tests :: Test
tests = testGroup "Textual source positions"
        [ testProperty "components"                         prop_components
        , testProperty "positive coordinates"               prop_positive
        , testProperty "show file name in source positions" prop_showFileName
        , testProperty "show line in source positions"      prop_showLine
        , testProperty "show column in source positions"    prop_showColumn
        , testProperty "initial position"                   prop_initialPos
        , testProperty "increment source line"              prop_incSourceLine
        , testProperty "increment source column"            prop_incSourceColumn
        , testProperty "set source name"                    prop_setSourceName
        , testProperty "set source line"                    prop_setSourceLine
        , testProperty "set source column"                  prop_setSourceColumn
        , testProperty "position updating"                  prop_updating ]

instance Arbitrary SourcePos where
  arbitrary = newPos <$> fileName <*> choose (-10, 1000) <*> choose (-10, 100)

fileName :: Gen String
fileName = do
  delimiter <- pure <$> elements "/\\"
  dirs      <- listOf1 simpleName
  extension <- simpleName
  frequency [ (1, return [])
            , (7, return $ intercalate delimiter dirs ++ "." ++ extension)]
  where simpleName = listOf1 (arbitrary `suchThat` isAlphaNum)

prop_components :: SourcePos -> Bool
prop_components pos = pos == copy
  where copy = newPos (sourceName pos) (sourceLine pos) (sourceColumn pos)

prop_positive :: SourcePos -> Bool
prop_positive pos = sourceLine pos > 0 && sourceColumn pos > 0

prop_showFileName :: SourcePos -> Bool
prop_showFileName pos = sourceName pos `isInfixOf` show pos

prop_showLine :: SourcePos -> Bool
prop_showLine pos = show (sourceLine pos) `isInfixOf` show pos

prop_showColumn :: SourcePos -> Bool
prop_showColumn pos = show (sourceColumn pos) `isInfixOf` show pos

prop_initialPos :: String -> Bool
prop_initialPos n =
  sourceName   ipos == n &&
  sourceLine   ipos == 1 &&
  sourceColumn ipos == 1
  where ipos = initialPos n

prop_incSourceLine :: SourcePos -> Int -> Bool
prop_incSourceLine pos l =
  d sourceName   id pos incp &&
  d sourceLine   f  pos incp &&
  d sourceColumn id pos incp
  where f    = max 1 . (+ l)
        incp = incSourceLine pos l

prop_incSourceColumn :: SourcePos -> Int -> Bool
prop_incSourceColumn pos c =
  d sourceName   id pos incp &&
  d sourceLine   id pos incp &&
  d sourceColumn f  pos incp
  where f    = max 1 . (+ c)
        incp = incSourceColumn pos c

prop_setSourceName :: SourcePos -> String -> Bool
prop_setSourceName pos n =
  d sourceName   (const n) pos setp &&
  d sourceLine   id        pos setp &&
  d sourceColumn id        pos setp
  where setp = setSourceName pos n

prop_setSourceLine :: SourcePos -> Int -> Bool
prop_setSourceLine pos l =
  d sourceName   id         pos setp &&
  d sourceLine   (const l') pos setp &&
  d sourceColumn id         pos setp
  where l'   = max 1 l
        setp = setSourceLine pos l

prop_setSourceColumn :: SourcePos -> Int -> Bool
prop_setSourceColumn pos c =
  d sourceName   id         pos setp &&
  d sourceLine   id         pos setp &&
  d sourceColumn (const c') pos setp
  where c'   = max 1 c
        setp = setSourceColumn pos c

prop_updating :: Int -> SourcePos -> String -> Bool
prop_updating w pos "" = updatePosString w pos "" == pos
prop_updating w' pos s =
  d sourceName id           pos updated &&
  d sourceLine (+ inclines) pos updated &&
  cols >= mincols && ((last s /= '\t') || ((cols - 1) `rem` w == 0))
  where w        = if w' < 1 then defaultTabWidth else w'
        updated  = updatePosString w' pos s
        cols     = sourceColumn updated
        newlines = elemIndices '\n' s
        inclines = length newlines
        total    = length s
        mincols  = if null newlines
                   then total + sourceColumn pos
                   else total - maximum newlines

d :: Eq b => (a -> b) -> (b -> b) -> a -> a -> Bool
d f g x y = g (f x) == f y