packages feed

diff-loc (empty) → 0.1.0.0

raw patch · 13 files changed

+1401/−0 lines, 13 filesdep +QuickCheckdep +basedep +fingertree

Dependencies added: QuickCheck, base, fingertree, quickcheck-higherorder, show-combinators

Files

+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for diff-loc++## 0.1.0.0 -- 2022-12-10++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2022 Li-yao Xia++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ README.md view
@@ -0,0 +1,81 @@+# *diff-loc*: Map file locations across diffs [![Hackage](https://img.shields.io/hackage/v/diff-loc.svg)](https://hackage.haskell.org/package/diff-loc)++## Example++You have a diff between two versions of a file. Given a source span+in one version, find the corresponding span in the other version.++For example, here is a diff `d` between a source string `"abcdefgh"` and a target+string `"appcfgzzh"`, with deletions and insertions in the middle:++```+  ab cdefg  h+-  b  de++  pp     zz+  appc  fgzzh+```++Diffs are represented by the type `Diff`.+Only locations and lengths are recorded, not the actual characters.++```+import DiffLoc+import DiffLoc.Unsafe (offset)++d :: Diff N+d = addDiff (Replace 1 (offset 1) (offset 2))  -- at location 1, replace "b" (length 1) with "pp" (length 2)+  $ addDiff (Replace 3 (offset 2) (offset 0))  -- at location 3, replace "de" with ""+  $ addDiff (Replace 7 (offset 0) (offset 2))  -- at location 7, replace "" with "zz"+  $ emptyDiff+-- N.B.: replacements should be inserted right to left, starting from 'emptyDiff'.+```++The span `s` of `"fg"` in the first string is an interval that starts at+location 5 and has length 2.++```+s :: Interval N+s = 5 :.. offset 2+```++Illustration of the span:++```+ a b c d e f g h+0 1 2 3 4 5 6 7 8+          ^f+g+ length 2+          ^+          start 5+```++After applying the diff, the span has been shifted to location 4.++```+>>> mapDiff d (5 :.. offset 2)+Just (4 :.. offset 2)+```++```+ a p p c f g q q h+0 1 2 3 4 5 6 7 8 9+        ^f+g+ length 2+        ^+        start 4+```++Conversely, we can map spans from the target string to the source string of the diff:++```+>>> comapDiff d (4 :.. offset 2)+Just (5 :.. offset 2)+```++If part of the input span is modified by the diff, there is no+corresponding output span.++```+>>> mapDiff d (1 :.. offset 2)  -- "bc" contains "b" which is edited by the diff+Nothing+```++See the API documentation in [`DiffLoc`](https://hackage.haskell.org/package/diff-loc/docs/DiffLoc.html).
+ diff-loc.cabal view
@@ -0,0 +1,46 @@+cabal-version:      3.0+name:               diff-loc+version:            0.1.0.0+synopsis:           Map file locations across diffs+description:        See "DiffLoc".+homepage:           https://gitlab.com/lysxia/diff-loc+license:            MIT+license-file:       LICENSE+author:             Li-yao Xia+maintainer:         lysxia@gmail.com+copyright:          2022 Li-yao Xia+category:           Data+build-type:         Simple+extra-doc-files:    CHANGELOG.md README.md++common warnings+    ghc-options: -Wall++flag test+  description: Enable test module.+  default: False+  manual: True++library+    import:           warnings+    exposed-modules:+      DiffLoc+      DiffLoc.Colline+      DiffLoc.Diff+      DiffLoc.Index+      DiffLoc.Interval+      DiffLoc.Shift+      DiffLoc.Starter+      DiffLoc.Unsafe+    build-depends:+      fingertree,+      show-combinators,+      base >=4.14 && < 4.18+    hs-source-dirs:   src+    default-language: Haskell2010+    if flag(test)+      exposed-modules:+        DiffLoc.Test+      build-depends:+        QuickCheck,+        quickcheck-higherorder
+ src/DiffLoc.hs view
@@ -0,0 +1,159 @@+-- |+-- = Example+--+-- You have a diff between two versions of a file. Given a source location+-- in one version, find the corresponding location in the other version.+--+-- For example, here is a diff @d@ between a source string "abcdefgh" and a target+-- string "appcfgzzh", with deletions and insertions in the middle:+--+-- >  ab cdefg  h+-- > - b  de+-- > + pp     zz+-- >  appc  fgzzh+--+-- Diffs are represented by the type 'Diff'.+-- Only locations and lengths are recorded, not the actual characters.+--+-- >>> :{+--   let d :: Diff N+--       d = addDiff (Replace 1 (offset 1) (offset 2))  -- at location 1, replace "b" (length 1) with "pp" (length 2)+--         $ addDiff (Replace 3 (offset 2) (offset 0))  -- at location 3, replace "de" with ""+--         $ addDiff (Replace 7 (offset 0) (offset 2))  -- at location 7, replace "" with "zz"+--         $ emptyDiff+--   -- N.B.: replacements should be inserted right to left, starting from 'emptyDiff'.+-- :}+--+-- The span @s@ of "fg" in the first string starts at location 5 and has length 2.+--+-- >>> let s = 5 :.. offset 2 :: Interval N+--+-- >  a b c d e f g h+-- > 0 1 2 3 4 5 6 7 8+-- >           ^f+g+ length 2+-- >           ^+-- >           start 5+--+-- After applying the diff, the resulting span has been shifted to location 4.+--+-- >>> mapDiff d (5 :.. offset 2)+-- Just (4 :.. offset 2)+--+-- >  a p p c f g q q h+-- > 0 1 2 3 4 5 6 7 8 9+-- >         ^f+g+ length 2+-- >         ^+-- >         start 4+--+-- Conversely, we can map spans from the target string to the source string of the diff:+--+-- >>> comapDiff d (4 :.. offset 2)+-- Just (5 :.. offset 2)+--+-- If part of the input span is modified by the diff, there is no+-- corresponding output span.+--+-- >>> mapDiff d (1 :.. offset 2)  -- "bc" contains "b" which is edited by the diff+-- Nothing+module DiffLoc+  ( -- * API++    -- ** Overview++    -- |+    -- @+    --                                       "DiffLoc.Diff"+    -- +------------------------------------------------++    -- |  data 'Diff' r                                   |+    -- |       'addDiff' :: r -> Diff r -> Diff r         |+    -- |       'mapDiff' :: Diff r -> Block r -> Block r  |+    -- +------------------------------------------------++    --         | requires+    --         v                                                "DiffLoc.Shift"+    -- **********************************************************************+    -- *  class 'Shift' r                                                     *+    -- *  type  'Block' r                                                     *+    -- *        'src', 'tgt' :: r -> Block r                                    *+    -- *        'shiftBlock', 'coshiftBlock' :: r -> Block r -> Maybe (Block r) *+    -- *        'shiftR', 'coshiftR' :: r -> r -> Maybe r                       *+    -- **********************************************************************+    --         ^+    --         | implements with+    --         |          r = 'Replace' p+    --         |    'Block' r = 'Interval' p+    --         |+    --         |+    --         |  "DiffLoc.Interval"+    -- +-------------------++    -- |  data 'Interval' p  |+    -- |  data 'Replace' p   |+    -- +-------------------++    --         | requires+    --         v                           "DiffLoc.Shift"+    -- *************************************************+    -- *  class 'Amor' p                                 *+    -- *  type  'Trans' p                                *+    -- *  class Ord p                                  *+    -- *  class Ord ('Trans' p)                          *+    -- *  class Monoid ('Trans' p)                       *<---++    -- *        ('.+') :: p -> Trans p -> p              *    |+    -- *        ('.-.?') :: p -> p -> Maybe (Trans p)    *    |+    -- *************************************************    |+    --         ^                               ^            |+    --         | implements with               |            | requires from+    --         |          p = 'Plain' a          |            |        l as p+    --         |    or    p = 'IndexFrom' n a    |            |    and c as p+    --         |    'Trans' p = 'Offset' a         |            |+    --         |                               |            |+    --         |                               |            |  "DiffLoc.Colline"+    --         |      "DiffLoc.Index"            |       +---------------------++    -- +--------------------------+            |       |  data 'Colline' l c   |+    -- |  newtype 'Plain' a         |            |_______|  data 'Vallee' l' c'  |+    -- |  newtype 'IndexFrom' n a   |                    +---------------------++    -- |  newtype 'Offset' a        |     implements with+    -- +--------------------------+                p = 'Colline' l c+    --         | requires                    'Trans' p = 'Vallee' ('Trans' l) ('Trans' c)+    --         v+    -- *****************+    -- *  class Num a  *+    -- *  class Ord a  *+    -- *****************+    -- @++    -- ** Diffs+    module DiffLoc.Diff++    -- ** Interfaces+    --+    -- - 'Shift', 'BlockOrder'+    -- - 'Amor', 'Origin'+  , module DiffLoc.Shift++    -- ** Intervals and replacements+  , module DiffLoc.Interval++    -- ** Plain indices+  , module DiffLoc.Index++    -- ** Lines and columns+  , module DiffLoc.Colline++    -- ** Basic configurations to get started+  , module DiffLoc.Starter++    -- $unsafe+  ) where++import DiffLoc.Colline+import DiffLoc.Diff+import DiffLoc.Index+import DiffLoc.Interval+import DiffLoc.Shift+import DiffLoc.Starter++-- $unsafe+-- The module "DiffLoc.Unsafe" is not reexported here.+-- You can import it separately.++-- $setup+-- >>> import DiffLoc.Unsafe
+ src/DiffLoc/Colline.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE+  GeneralizedNewtypeDeriving,+  TypeFamilies #-}++-- | Line-column locations and its offset monoid.+module DiffLoc.Colline+  ( Colline(..)+  , Vallee(..)+  , Vallée+  ) where++import Data.Functor ((<&>))+import DiffLoc.Shift++-- $setup+-- >>> import Test.QuickCheck+-- >>> import DiffLoc+-- >>> import DiffLoc.Test+-- >>> import DiffLoc.Unsafe ((.-.))++-- | Line and column coordinates.+--+-- The generalization over types of line and column numbers+-- frees us from any specific indexing scheme, notably whether+-- columns are zero- or one-indexed.+--+-- === Example+--+-- > abc+-- > de+-- > fgh+--+-- Assuming the lines and columns are both 1-indexed, @"b"@ is at location+-- @(Colline 1 2)@ and @"h"@ is at location @(Colline 3 3)@.+data Colline l c = Colline !l !c+  deriving (Eq, Ord, Show)++-- | The space between two 'Colline's.+--+-- This type represents offsets between text locations @x <= y@+-- as the number of newlines inbetween and the number of characters+-- from the last new line to @y@, if there is at least one newline,+-- or the number of characters from @x@ to @y@.+--+-- === Example+--+-- > abc+-- > de+-- > fgh+--+-- - The offset from @"b"@ to @"h"@ is @Vallee 2 2@ (two newlines to reach line 3,+--   and from the beginning of that line, advance two characters to reach h).+-- - The offset from @"b"@ to @"c"@ is @Vallee 0 1@ (advance one character).+--+-- The offset from @"b"@ to @"h"@ is actually the same as from @"a"@ to @"h"@+-- and from @"c"@ to @"h"@. Line-column offsets are thus not invertible.+-- This was one of the main constraints in the design of the 'Amor' class.+data Vallee dl dc = Vallee !dl !dc+  deriving (Eq, Ord, Show)++-- | Sans commentaire.+type Vallée = Vallee++-- $hidden+-- prop> (x <> y) <> z === x <> (y <> z :: Vallee (Offset Int) (Offset Int))++traversee ::+  Eq dl =>+  dl ->+  (l -> dl -> l) ->+  (c -> dc -> c) ->+  (dc -> c) ->+  Colline l c -> Vallee dl dc -> Colline l c+traversee zero actL actC fromO (Colline l c) (Vallee l' c')+  | l' == zero = Colline l (c `actC` c')+  | otherwise = Colline (l `actL` l') (fromO c')++instance (Monoid l, Eq l, Semigroup c) => Semigroup (Vallee l c) where+  x <> y = descente (traversee mempty (<>) (<>) id (montee x) y)+    where+      montee :: Vallee l c -> Colline l c+      montee (Vallee l c) = Colline l c++      descente :: Colline l c -> Vallee l c+      descente (Colline l c) = Vallee l c++instance (Monoid l, Eq l, Monoid c) => Monoid (Vallee l c) where+  mempty = Vallee mempty mempty++-- $hidden+-- prop> (i .+ r) .+ s === (i .+ (r <> s) :: Colline N N')+-- prop> i <= j ==> (i .+ (j .-. i)) === (j :: Colline N N')+-- prop> (i .+ r) .-. (i :: Colline N N') === r++instance (Amor l, Origin c) => Amor (Colline l c) where+  type Trans (Colline l c) = Vallee (Trans l) (Trans c)++  (.+) = traversee mempty (.+) (.+) ofOrigin++  Colline l c .-.? Colline l' c' = case compare l l' of+    LT -> Nothing+    EQ | c' <= c -> Vallee mempty <$> (c .-.? c')+       | otherwise -> Nothing+    GT -> (l .-.? l') <&> \dl -> Vallee dl (fromOrigin c)++instance (Origin l, Origin c) => Origin (Colline l c) where+  origin = Colline origin origin
+ src/DiffLoc/Diff.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE+  AllowAmbiguousTypes,+  DerivingStrategies,+  FlexibleContexts,+  FlexibleInstances,+  GeneralizedNewtypeDeriving,+  MultiParamTypeClasses,+  ScopedTypeVariables,+  StandaloneDeriving,+  TypeApplications,+  TypeFamilies,+  UndecidableInstances #-}++-- | Mapping intervals across diffs+module DiffLoc.Diff+  ( -- * Types+    ADiff()++    -- * Operations+  , emptyDiff+  , addDiff+  , mapDiff+  , comapDiff+  , listToDiff+  ) where++import Data.Coerce+import Data.Foldable (toList)+import Data.Maybe (fromMaybe)+import Data.FingerTree (FingerTree)+import Text.Show.Combinators (showCon, (@|))+import qualified Data.FingerTree as FT++import DiffLoc.Shift++-- $setup+-- >>> import Control.Monad ((<=<))+-- >>> import Test.QuickCheck+-- >>> import Test.QuickCheck.HigherOrder+-- >>> import DiffLoc+-- >>> import DiffLoc.Unsafe+-- >>> import DiffLoc.Test+-- >>> type NN' = Colline N N'+-- >>> quickCheck = quickCheckWith' stdArgs{maxSuccess=3000}++-- | A diff represents a transformation from one file to another.+--+-- Example diff between "abcdefgh" and "appcfgzzh":+--+-- > source ab cdefg  h+-- >      -  b  de+-- >      +  pp     zz+-- > target appc  fgzzh+--+-- It consists of three replacements:+--+-- 1. replace "b" with "pp" at location 1, @mkReplace 1 1 2@;+-- 2. replace "de" with "" at location 3, @mkReplace 3 2 0@;+-- 3. replace "" with "zz" at location 7, @mkReplace 7 0 2@.+--+-- >>> :{+--   let d :: Diff N+--       d = addDiff (Replace 1 (offset 1) (offset 2))  -- at location 1, replace "b" (length 1) with "pp" (length 2)+--         $ addDiff (Replace 3 (offset 2) (offset 0))  -- at location 3, replace "de" with ""+--         $ addDiff (Replace 7 (offset 0) (offset 2))  -- at location 7, replace "" with "zz"+--         $ emptyDiff+--   -- N.B.: replacements should be inserted right to left.+-- :}+--+-- 'ADiff' is an abstract representation to be instantiated with+-- a concrete representation of atomic replacements.+--+-- == __Internal details__+--+-- Internally, a diff is a sequence of /disjoint/ and /nonempty/ replacements,+-- /ordered/ by their source locations.+-- The monoid annotation in the fingertree gives the endpoints of the replacements.+newtype ADiff r = ADiff (FingerTree (Maybe r) (R r))+  deriving Eq++instance Show r => Show (ADiff r) where+  showsPrec = flip $ \d -> showCon "listToDiff" @| diffToList d++-- | The empty diff.+emptyDiff :: Semigroup r => ADiff r+emptyDiff = ADiff FT.empty++-- | A newtype to carry a 'FT.Measured' instance.+newtype R r = R r+  deriving newtype (Eq, Show)++instance Semigroup r => FT.Measured (Maybe r) (R r) where+  measure (R r) = Just r++coshiftR' :: Shift r => Maybe r -> r -> r+coshiftR' Nothing = id+coshiftR' (Just r) = fromMaybe (error "failed to shift disjoint intervals") . coshiftR r++addDiffL :: forall r. Shift r => r -> ADiff r -> ADiff r+addDiffL r (ADiff d0) = case FT.viewl d0 of+  FT.EmptyL -> ADiff (FT.singleton (R r))+  R s FT.:< d | src r `distantlyPrecedes` src s -> ADiff (R r FT.<| d0)+              | otherwise -> addDiffL (r <> s) (ADiff d)++-- | Add a replacement to a diff. The replacement is performed /after/ the diff.+--+-- === Properties+--+-- prop> not (isZeroLength x) ==> mapDiff (addDiff r d) x == (shiftBlock r <=< mapDiff (d :: Diff N)) x+-- prop> not (isZeroLength x) ==> comapDiff (addDiff r d) x == (comapDiff d <=< coshiftBlock (r :: Replace N)) x+addDiff :: forall r. Shift r => r -> ADiff r -> ADiff r+addDiff r (ADiff d) = case FT.search (\r1 _-> r1 `notPrecedes_` r) d of+  FT.Position d1 s d2 -> coerce (d1 <>) (addDiffL (coshiftR' (FT.measure d1) r) (ADiff (s FT.<| d2)))+  FT.OnLeft -> addDiffL r (ADiff d)+  FT.OnRight -> ADiff (d FT.|> R (coshiftR' (FT.measure d) r))+  FT.Nowhere -> error "Broken invariant"+  where+    notPrecedes_ Nothing _ = False+    notPrecedes_ (Just r1) i = not (tgt r1 `distantlyPrecedes` tgt i)+    -- Using distantlyPrecedes here and in addDiffL lets us merge adjacent intervals.++-- $hidden+-- prop> not (isZeroLength x) ==> mapDiff (addDiff r d) x == (shiftBlock r <=< mapDiff (d :: Diff NN')) x+-- prop> not (isZeroLength x) ==> comapDiff (addDiff r d) x == (comapDiff d <=< coshiftBlock (r :: Replace NN')) x++-- | Translate a span in the source of a diff to a span in its target.+-- @Nothing@ if the span overlaps with a replacement.+--+-- For exaple, given the following 'ADiff' (or 'DiffLoc.Interval.Replace') from "aAacCc" to "aAabbbcCc":+--+-- > source aAa   cCc+-- >      - +-- >      +    bbb+-- > target aAabbbcCc+--+-- >>> r0 = Replace 3 (offset 0) (offset 3) :: Replace N+-- >>> d0 = addDiff r0 emptyDiff+--+-- The span of \"A\" remains unchanged.+--+-- >>> mapDiff d0 (1 :.. offset 1)+-- Just (1 :.. offset 1)+-- >>> shiftBlock r0 (1 :.. offset 1)+-- Just (1 :.. offset 1)+-- >>> comapDiff d0 (1 :.. offset 1)+-- Just (1 :.. offset 1)+-- >>> coshiftBlock r0 (1 :.. offset 1)+-- Just (1 :.. offset 1)+--+-- The span of \"C\" is shifted by 3 characters.+--+-- >>> mapDiff d0 (4 :.. offset 1)+-- Just (7 :.. offset 1)+-- >>> shiftBlock r0 (4 :.. offset 1)+-- Just (7 :.. offset 1)+-- >>> comapDiff d0 (7 :.. offset 1)+-- Just (4 :.. offset 1)+-- >>> coshiftBlock r0 (7 :.. offset 1)+-- Just (4 :.. offset 1)+--+-- The span of "ac" overlaps with the replacement, so the mapping is undefined.+--+-- >>> mapDiff d0 (2 :.. offset 2)+-- Nothing+-- >>> shiftBlock r0 (2 :.. offset 2)+-- Nothing+-- >>> comapDiff d0 (2 :.. offset 5)+-- Nothing+-- >>> coshiftBlock r0 (2 :.. offset 5)+-- Nothing+--+-- === Properties+--+-- prop> \(FSN d s) -> not (isZeroLength s) ==> partialSemiInverse (mapDiff d) (comapDiff d) s+-- prop> \(FSN d s) -> not (isZeroLength s) ==> partialSemiInverse (comapDiff d) (mapDiff d) s+--+-- where @partialSemiInverse f g x@ is the property+--+-- > if   f x == Just y   -- for some y+-- > then g y == Just x+mapDiff :: Shift r => ADiff r -> Block r -> Maybe (Block r)+mapDiff = mapDiff_ Cov++-- $hidden+--+-- prop> \(FSV d s) -> not (isZeroLength s) ==> partialSemiInverse (mapDiff d) (comapDiff d) s+-- prop> \(FSV d s) -> not (isZeroLength s) ==> partialSemiInverse (comapDiff d) (mapDiff d) s++-- | Translate a span in the target of a diff to a span in its source.+-- @Nothing@ if the span overlaps with a replacement.+--+-- See also 'mapDiff'.+comapDiff :: Shift r => ADiff r -> Block r -> Maybe (Block r)+comapDiff = mapDiff_ Contrav++data Variance = Cov | Contrav++srcV :: Shift r => Variance -> r -> Block r+srcV Cov = src+srcV Contrav = tgt++shiftBlockV' :: Shift r => Variance -> Maybe r -> Block r -> Block r+shiftBlockV' _ Nothing = id+shiftBlockV' Cov (Just r) = fromMaybe (error "failed to shift disjoint intervals") . shiftBlock r+shiftBlockV' Contrav (Just r) = fromMaybe (error "failed to shift disjoint intervals") . coshiftBlock r++mapDiff_ :: forall r. Shift r => Variance -> ADiff r -> Block r -> Maybe (Block r)+mapDiff_ v (ADiff d) i = case FT.search (\r1 _ -> r1 `notPrecedes_` i) d of+  FT.Position d1 (R s) _+    | j `precedes` (srcV v s) -> Just i'+    | otherwise -> Nothing+    where i' = shiftBlockV' v (FT.measure d1) i+          j = case v of Cov -> i ; Contrav -> i'+  FT.OnLeft -> Just i+  FT.OnRight -> Just (shiftBlockV' v (FT.measure d) i)+  FT.Nowhere -> error "Broken invariant"+  where+    notPrecedes_ Nothing _ = False+    notPrecedes_ (Just r1) i1 = not (srcV v r1 `precedes` i1)++-- |+--+-- @+-- 'listToDiff' = foldr 'addDiff' 'emptyDiff'+-- @+listToDiff :: Shift r => [r] -> ADiff r+listToDiff = foldr addDiff emptyDiff++diffToList :: ADiff r -> [r]+diffToList (ADiff d) = coerce (toList d)
+ src/DiffLoc/Index.hs view
@@ -0,0 +1,133 @@+{-# LANGUAGE+  AllowAmbiguousTypes,+  DataKinds,+  DerivingStrategies,+  DerivingVia,+  GeneralizedNewtypeDeriving,+  ScopedTypeVariables,+  TypeApplications,+  TypeFamilies #-}++-- | Indices and offsets.+module DiffLoc.Index+  ( -- * One-dimensional indices+    -- ** Unbounded indices+    Plain(..)++    -- ** Indices bounded by an origin+  , IndexFrom()+  , indexFromM+  , indexFromM0+  , indexFromM1+  , fromIndex+  , fromIndex0+  , fromIndex1+  , zeroIndex+  , oneIndex++    -- ** Offsets+  , Offset()+  , offsetM+  , fromOffset+  ) where++import Data.Monoid (Sum(..))+import Data.Proxy (Proxy(..))+import GHC.TypeNats (KnownNat, Nat, natVal)+import Text.Show.Combinators (showCon, (@|))+import DiffLoc.Shift++-- | One-dimensional indices.+newtype Plain a = Plain a+  deriving (Eq, Ord, Show)++instance (Num a, Ord a) => Amor (Plain a) where+  type Trans (Plain a) = Offset a+  Plain y .+ Offset x = Plain (x Prelude.+ y)+  Plain x .-.? Plain y | y <= x = Just (Offset (x - y))+                       | otherwise = Nothing++--++-- | One-dimensional indices with an origin (an initial index).+-- Indices must be greater than the origin, hence the constructor is hidden.+--+-- Use 'indexFromM' to construct indices, with @TypeApplications@ to make the+-- indexing scheme explicit, and 'fromIndex' to destruct them.+--+-- @+-- (origin :: IndexFrom n a) <= i    -- for all i+-- @+newtype IndexFrom (n :: Nat) a = IndexFrom a+  deriving (Eq, Ord)+  deriving Amor via (Plain a)++instance Show a => Show (IndexFrom n a) where+  showsPrec = flip $ \(IndexFrom i) -> showCon "indexFrom" @| i++instance (Num a, Ord a, KnownNat n) => Origin (IndexFrom n a) where+  origin = IndexFrom (knownNum @n)++-- | Reify a 'KnownNat'.+--+-- @+-- knownNum @42 = 42+-- @+knownNum :: forall n a. (KnownNat n, Num a) => a+knownNum = fromIntegral (natVal @n Proxy)++-- | Constructor for 'IndexFrom'.+--+-- See also 'DiffLoc.Unsafe.indexFrom' in "DiffLoc.Unsafe", a variant of 'indexFromM' that+-- throws errors instead of using @Maybe@.+indexFromM :: forall n a. (KnownNat n, Num a, Ord a) => a -> Maybe (IndexFrom n a)+indexFromM i | knownNum @n <= i = Just (IndexFrom i)+             | otherwise = Nothing++-- | 'indexFromM' specialized to 0-indexing.+indexFromM0 :: forall a. (Num a, Ord a) => a -> Maybe (IndexFrom 0 a)+indexFromM0 = indexFromM++-- | 'indexFromM' specialized to 1-indexing.+indexFromM1 :: forall a. (Num a, Ord a) => a -> Maybe (IndexFrom 1 a)+indexFromM1 = indexFromM++-- | Destructor for 'IndexFrom'.+fromIndex :: forall n a. IndexFrom n a -> a+fromIndex (IndexFrom i) = i++-- | 'fromIndex' specialized to 0-indexing.+fromIndex0 :: IndexFrom 0 a -> a+fromIndex0 = fromIndex++-- | 'fromIndex' specialized to 1-indexing.+fromIndex1 :: IndexFrom 1 a -> a+fromIndex1 = fromIndex++-- | Convert from zero-indexing to one-indexing.+oneIndex :: Num a => IndexFrom 0 a -> IndexFrom 1 a+oneIndex (IndexFrom i) = IndexFrom (i Prelude.+ 1)++-- | Convert from one-indexing to zero-indexing.+zeroIndex :: Num a => IndexFrom 1 a -> IndexFrom 0 a+zeroIndex (IndexFrom i) = IndexFrom (i - 1)++-- | Type of nonnegative offsets.+newtype Offset a = Offset a+  deriving (Eq, Ord)+  deriving (Semigroup, Monoid) via (Sum a)++instance Show a => Show (Offset a) where+  showsPrec = flip $ \(Offset i) -> showCon "offset" @| i++-- | Construct a nonnegative 'Offset'.+--+-- See also 'DiffLoc.Unsafe.offset' in "DiffLoc.Unsafe", a variant of 'offsetM' that+-- throws errors instead of using @Maybe@.+offsetM :: (Num a, Ord a) => a -> Maybe (Offset a)+offsetM i | 0 <= i = Just (Offset i)+          | otherwise = Nothing++-- | Unwrap 'Offset'.+fromOffset :: Offset a -> a+fromOffset (Offset i) = i
+ src/DiffLoc/Interval.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE+  FlexibleContexts,+  StandaloneDeriving,+  TypeFamilies,+  UndecidableInstances #-}++-- | 'Interval' implements 'Shift'.+module DiffLoc.Interval+  ( Interval(..)+  , isZeroLength+  , Replace(..)+  ) where++import Prelude hiding ((+))+import DiffLoc.Shift+import DiffLoc.Unsafe ((.-.))++-- $setup+-- >>> import DiffLoc+-- >>> import DiffLoc.Test+-- >>> import Test.QuickCheck++-- Nicer looking formulas this way.++infixl 6 ++(+) :: Semigroup a => a -> a -> a+(+) = (<>)++-- | @(i ':..' n)@ represents a span of text between index @i@ and index @i+n@.+--+-- The type of indices @p@ is expected to be an instance of 'Amor'.+--+-- The length @n@ in an interval @(i :.. n)@ may be zero.+--+-- The elements of the interval can be thought of as indexing the interstices+-- /between/ characters. A span of length zero is a single interstice between+-- two characters, where some chunk of text may be inserted.+--+-- Example: drawing of @1 :.. 2@ in "abcde".+--+-- >  a b c d e+-- > 0 1 2 3 4 5+-- >   ^b+c+ length = 2+-- >   ^+-- >   ^ start = 1+data Interval p = !p :.. !(Trans p)++infixl 3 :..++-- | Does the interval have length zero?+isZeroLength :: (Eq (Trans p), Monoid (Trans p)) => Interval p -> Bool+isZeroLength (_ :.. n) = n == mempty++deriving instance (Eq p, Eq (Trans p)) => Eq (Interval p)+deriving instance (Show p, Show (Trans p)) => Show (Interval p)++instance Amor p => BlockOrder (Interval p) where+  precedes (i :.. n) (j :.. _) = i .+ n <= j+  distantlyPrecedes (i :.. n) (j :.. _) = i .+ n < j++-- | A minimalistic representation of text replacements.+--+-- A replacement @'Replace' i n m@ is given by a start location @i@, the length+-- @n@ of the interval to replace (source) and the length @m@ of its+-- replacement (target).+-- This representation does not keep track of the actual data being inserted.+--+-- This may overapproximate the underlying text replacement,+-- with intervals being wider than necessary.+-- For example, the transformation from "abc" to "ac" could be represented+-- by @mkReplace 1 1 0@ (replace "b" with "" at location 1), and also by+-- @mkReplace 0 2 1@ (replace "ab" with "a" at location 0).+--+-- > source   abc   abc+-- >      -    b    ab+-- >      +         a+-- > target   a c   a c+--+-- Insertions are replacements with source intervals of length zero.+-- Deletions are replacements with target intervals of length zero.+data Replace p = Replace !p !(Trans p) !(Trans p)++deriving instance (Eq p, Eq (Trans p)) => Eq (Replace p)+deriving instance (Show p, Show (Trans p)) => Show (Replace p)++-- | The composition of two replacements @l <> r@ represents the replacement @r@+-- followed by @l@, as one replacement of an span that contains both @r@ and @l@.+--+-- The right-to-left order of composition has the nice property that when+-- @l `'precedes` r@, @l <> r@ can also be viewed intuitively as performing @l@ and+-- @r@ simultaneously.+--+-- === Properties+--+-- prop> (x <> y) <> z === x <> (y <> z :: Replace (Plain Int))+instance Amor p => Semigroup (Replace p) where+  Replace li ln lm <> Replace ri rn rm+    | li .+ ln <= ri+      -- Disjoint, l on the left.+      --+      -- Before:+      -- > |---l---|       |---r---|+      -- > li      li+ln   ri      ri+rn+      --+      -- After both replacements (r first),+      -- with ld = lm-ln+      --+      -- > |---l---|       |---r---|+      -- > li      li+lm   ri+ld   ri+rm+ld+      --+    = Replace li ((ri .+ rn) .-. li) (lm + (ri .-. (li .+ ln)) + rm)++    | li <= ri+      -- l straddles the left end of r+      --+      -- Note that the indices in l should be interpreted+      -- as indices after r.+      -- After replacing r, the replaced span r and the to-be-replaced+      -- span l look like this:+      --+      -- >       |------r----|+      -- > |----l-----|+      -- > li    ri   li+ln  ri+rm+      --+      -- or this:+      --+      -- >      |--r--|+      -- > |-------l----------|+      -- > li   ri    ri+rm   li+ln+      --+    = let (n, m) = if li .+ ln < ri .+ rm+                   then ((ri .+ rn) .-. li, lm + ((ri .+ rm) .-. (li .+ ln)))+                   else ((ri .-. li) + rn + ((li .+ ln) .-. (ri .+ rm)), lm)+      in Replace li n m++    | li < ri .+ rm+      -- r straddles the left end of l+      --+      -- > |----r-----|+      -- >       |------l----|+      -- > ri    li   ri+rm  li+ln+      --+      -- or+      --+      -- > |-------r----------|+      -- >      |--l--|+      -- > ri   li    li+ln   ri+rm+      --+    = let (n, m) = if ri .+ rm < li .+ ln+                   then (rn + ((li .+ ln) .-. (ri .+ rm)), (li .+ lm) .-. ri)+                   else (rn, (li .-. ri) + lm + ((ri .+ rm) .-. (li .+ ln)))+      in Replace ri n m++    | otherwise+      --+      -- > |---r---|       |---l---|+      -- > ri      rm      li      ln+      --+    = Replace ri (rn + (li .-. (ri .+ rm)) + ln) ((li .+ lm) .-. ri)++instance Amor p => Shift (Replace p) where+  type Block (Replace p) = Interval p+  dual (Replace i n m) = Replace i m n++  src (Replace i n _) = i :.. n++  shiftBlock (Replace i n m) jp@(j :.. p)+    | j .+ p <= i = Just jp+    | i .+ n <= j = Just (i .+ (m + (j .-. (i .+ n))) :.. p)+    | otherwise = Nothing++  shiftR (Replace i n m) jpq@(Replace j p q)+    | j .+ p <= i = Just jpq+    | i .+ n <= j = Just (Replace (i .+ (m + (j .-. (i .+ n)))) p q)+    | otherwise = Nothing
+ src/DiffLoc/Shift.hs view
@@ -0,0 +1,181 @@+{-# LANGUAGE+  FlexibleContexts,+  TypeFamilies #-}++-- | Interfaces of structures used to implement 'DiffLoc.ADiff'.+module DiffLoc.Shift+  ( -- * Interfaces+    -- ** Replacement+    Shift(..)+  , BlockOrder(..)++    -- ** Indices and offsets+  , Amor(..)+  , Origin(..)+  , fromOrigin+  , ofOrigin+  ) where++import Data.Kind (Type)+import Data.Maybe (fromMaybe)+import GHC.Stack (HasCallStack)++-- $setup+-- >>> import Control.Monad ((<=<))+-- >>> import Test.QuickCheck+-- >>> import DiffLoc+-- >>> import DiffLoc.Unsafe ((.-.))+-- >>> import DiffLoc.Test+-- >>> type N = Plain Int++-- | Partial ordering of interval-like things.+class BlockOrder b where+  precedes :: b -> b -> Bool++  -- | Precedes but not adjacent, provided you have a notion of adjacence.+  -- Otherwise it's fine to equate this with precedes.+  distantlyPrecedes :: b -> b -> Bool++-- | Shift algebra.+--+-- __Laws:__+--+-- @+-- 'src' \<$>   'shiftR' r s   =     'shiftBlock' r ('src' s)+-- 'tgt' \<$>   'shiftR' r s   =     'shiftBlock' r ('tgt' s)+-- 'src' \<$> 'coshiftR' r s   =   'coshiftBlock' r ('src' s)+-- 'tgt' \<$> 'coshiftR' r s   =   'coshiftBlock' r ('tgt' s)+--+-- 'shiftBlock' r b = Just d   \<==>   'coshiftBlock' r d = Just b+-- 'shiftR'     r s = Just z   \<==>   'coshiftR'     r z = Just s+--+-- 'shiftR' r s = Just z  &&  'shiftR' s r = Just q   ==>+--   z '<>' r  =  q '<>' s+--+-- 'coshiftR' r s = Just z  &&  'coshiftR' s r = Just q   ==>+--   r '<>' z  =  s '<>' q+-- @+--+-- __Duality laws:__+--+-- @+-- src = tgt . 'dual'+-- tgt = src . 'dual'+-- shiftBlock = coshiftBlock . 'dual'+-- coshiftBlock = shiftBlock . 'dual'+-- coshiftR = shiftR . 'dual'+-- shiftR = coshiftR . 'dual'+-- @+class (Semigroup r, BlockOrder (Block r)) => Shift r where+  type Block r :: Type+  src :: r -> Block r+  tgt :: r -> Block r++  shiftBlock   :: r -> Block r -> Maybe (Block r)+  coshiftBlock :: r -> Block r -> Maybe (Block r)++  shiftR :: r -> r -> Maybe r+  coshiftR :: r -> r -> Maybe r++  dual :: r -> r++  src = tgt . dual+  tgt = src . dual+  shiftBlock = coshiftBlock . dual+  coshiftBlock = shiftBlock . dual+  coshiftR = shiftR . dual+  shiftR = coshiftR . dual++-- | /Action d'un Monoïde Ordonné./ Ordered monoid actions.+--+-- - An ordered set of points @Ord p@.+-- - An ordered monoid of translations (or "vectors") @(Ord (Trans p), Monoid ('Trans' p))@.+--+-- In addition to the 'Ord' and 'Monoid' laws, ordered monoids must+-- have a monotone @('<>')@:+--+-- @+-- v \<= v'   ==>    w \<= w'   =>   (v '<>' w) \<= (v' '<>' w')+-- @+--+-- - Points can be translated along vectors using @('.+')@.+-- - Given two ordered points @i <= j@, @j '.-.?' i@ finds a vector @n@+--   such that @i + n = j@.+--+-- In other words, we only require the existence of "positive" translations+-- (this is unlike affine spaces, where translations exist between any two points).+-- This makes it possible to implement this class for line-column locations+-- ("DiffLoc.Colline"), where translations are not invertible.+--+-- @('.-.?')@ is not part of a standard definition of ordered monoid actions.+-- Feel free to suggest a better name for this structure or a way to not+-- depend on this operation.+--+-- __Laws:__+--+-- @+--               (x '.+' v) '.+' w  =  x '.+' (v '<>' w)+-- x '<=' y  ==>  x '.+' (y 'DiffLoc.Unsafe..-.' x)  =  y+--              (x '.+' v) 'DiffLoc.Unsafe..-.' x  =  x+-- @+class (Ord p, Ord (Trans p), Monoid (Trans p)) => Amor p where+  -- | Type of translations between points of @p@.+  type Trans p :: Type++  infixr 6 .+++  -- | Translate a point.+  (.+) :: p -> Trans p -> p++  -- | Translation between two points.+  -- @j .-.? i@ must be defined ('Just') if @i <= j@,+  --+  -- There is an unsafe wrapper @('DiffLoc.Unsafe..-.')@ in "DiffLoc.Unsafe".+  (.-.?) :: p -> p -> Maybe (Trans p)++-- $hidden+-- prop> (x .+ v) .+ w                   ===  (x .+ (v <> w) :: Plain Int)+-- prop> x <= y  ==>  x .+ (y .-. x)     ===  (y :: Plain Int)+-- prop> (x .+ v) .-. (x :: Plain Int)   ===   v++infixl 6 .-.++-- | An unsafe variant of @('.-.?')@. This will be redefined in "DiffLoc.Unsafe".+(.-.) :: HasCallStack => Amor p => p -> p -> Trans p+i .-. j = fromMaybe (error "undefined vector") (i .-.? j)++-- | Extend 'Amor' with an "origin" point from which vectors can be drawn to+-- all points. To make the interface slightly more general, only the partial+-- application @(origin .-.)@ needs to be supplied.+--+-- __Laws:__+--+-- @+-- 'origin' <= x+-- @+class Amor p => Origin p where+  origin :: p++-- | Translate the origin along a vector.+--+-- @+-- x \<= y   <=>   ofOrigin x \<= ofOrigin y+--+-- 'ofOrigin' x '.+' v             =   'ofOrigin' (x '.+' v)+-- 'ofOrigin' x 'DiffLoc.Unsafe..-.' 'ofOrigin' y   =   x 'DiffLoc.Unsafe..-.' y+-- @+ofOrigin :: Origin p => Trans p -> p+ofOrigin v = origin .+ v++-- | Find the vector from the origin to this point.+--+-- @+-- x \<= y   <=>   fromOrigin x \<= fromOrigin y+--+-- 'ofOrigin' ('fromOrigin' x) = x+-- 'fromOrigin' ('ofOrigin' v) = v+--+-- 'fromOrigin' (x .+ v)  =   'fromOrigin' x <> v+-- @+fromOrigin :: Origin p => p -> Trans p+fromOrigin p = p .-. origin
+ src/DiffLoc/Starter.hs view
@@ -0,0 +1,75 @@+{-# LANGUAGE+  DataKinds,+  DerivingVia,+  FlexibleInstances,+  StandaloneDeriving,+  TypeOperators #-}++-- | Basic configurations to get started.+module DiffLoc.Starter+  ( -- * The heavy lifter+    Diff++    -- * Basic index types+  , Z+  , N+  , N'++    -- * Under the hood+  , (:$:)(..)+  ) where++import GHC.TypeNats (KnownNat)+import DiffLoc.Diff+import DiffLoc.Interval+import DiffLoc.Index+import DiffLoc.Shift+import DiffLoc.Unsafe++-- $setup+-- >>> import DiffLoc+-- >>> import DiffLoc.Unsafe++-- | A shorthand for the common use case of 'Diff'.+type Diff p = ADiff (Replace p)++-- | A trick to reduce noise by hiding newtype wrapper constructors.+-- This makes the documentation more palatable.+--+-- >>> show (NoShow (Plain 3) :: Plain :$: Int)+-- "3"+-- >>> show (Colline 4 2 :.. Vallee (offset 3) (offset 3) :: Interval (Colline N N))+-- "Colline 4 2 :.. Vallee (offset 3) (offset 3)"+newtype f :$: x = NoShow (f x)+  deriving (Eq, Ord)+  deriving (Semigroup, Monoid, Amor, Origin) via (f x)++instance Show a => Show (Plain :$: a) where+  show (NoShow (Plain i)) = show i++instance Show a => Show (IndexFrom n :$: a) where+  show (NoShow i) = show (fromIndex i)++instance Show a => Show (Offset :$: a) where+  show (NoShow i) = show (fromOffset i)++instance Num a => Num (Plain :$: a) where+  fromInteger n = NoShow (Plain (fromInteger n))+  (+) = undefined ; (-) = undefined ; (*) = undefined ; abs = undefined ; signum = undefined++instance (Num a, Ord a, KnownNat n) => Num (IndexFrom n :$: a) where+  fromInteger n = NoShow (indexFrom (fromInteger n))+  (+) = undefined ; (-) = undefined ; (*) = undefined ; abs = undefined ; signum = undefined++instance (Num a, Ord a) => Num (Offset :$: a) where+  fromInteger n = NoShow (offset (fromInteger n))+  (+) = undefined ; (-) = undefined ; (*) = undefined ; abs = undefined ; signum = undefined++-- | Integers.+type Z = Plain :$: Int++-- | Natural numbers.+type N = IndexFrom 0 :$: Int++-- | Positive numbers.+type N' = IndexFrom 1 :$: Int
+ src/DiffLoc/Test.hs view
@@ -0,0 +1,134 @@+{-# OPTIONS_GHC -Wno-orphans #-}+{-# LANGUAGE+  DerivingVia,+  FlexibleContexts,+  FlexibleInstances,+  PatternSynonyms,+  ScopedTypeVariables,+  StandaloneDeriving,+  TypeApplications,+  TypeFamilies,+  TypeOperators,+  UndecidableInstances #-}+module DiffLoc.Test+  ( (=.=)+  , partialSemiInverse+  , GoodSpan(.., GSN, GSV)+  , FairSpan(.., FSN, FSV)+  ) where++import Data.List (sort)+import Data.Proxy (Proxy(..))+import GHC.TypeNats (KnownNat, natVal)+import Test.QuickCheck+import Test.QuickCheck.HigherOrder++import DiffLoc+import DiffLoc.Unsafe++-- $setup+-- >>> import Data.Maybe+-- >>> import DiffLoc+-- >>> import Test.QuickCheck+-- >>> quickCheck = quickCheckWith stdArgs{maxSuccess=3000}++infix 1 =.=++(=.=) :: (Arbitrary a, Show a, Eq b, Show b) => (a -> b) -> (a -> b) -> Property+f =.= g = property (\x -> f x === g x)++whenJust :: Testable prop => Maybe a -> (a -> prop) -> Property+whenJust Nothing _ = discard+whenJust (Just x) f = property (f x)++partialSemiInverse :: (Arbitrary a, Eq a, Show a) => (a -> Maybe b) -> (b -> Maybe a) -> a -> Property+partialSemiInverse f g x = f x `whenJust` \y -> g y === Just x++instance (Arbitrary p, Arbitrary (Trans p)) => Arbitrary (Interval p) where+  arbitrary = do+    (i, n) <- arbitrary+    pure (i :.. n)+  shrink (i :.. n) = [ i' :.. n' | (i', n') <- shrink (i, n) ]++instance (Arbitrary p, Arbitrary (Trans p)) => Arbitrary (Replace p) where+  arbitrary = do+    (i, n, m) <- arbitrary+    pure (Replace i n m)+  shrink (Replace i n m) =+    [ Replace i' n' m' | (i', n', m') <- shrink (i, n, m) ]++instance (Arbitrary p, Show p, Arbitrary (Trans p), Show (Trans p)) => Constructible (Interval p) where+  type Repr (Interval p) = Interval p+  fromRepr = id++instance (Arbitrary p, Show p, Arbitrary (Trans p), Show (Trans p)) => Constructible (Replace p) where+  type Repr (Replace p) = Replace p+  fromRepr = id++instance (Shift r, Arbitrary r, Show r) => Constructible (ADiff r) where+  type Repr (ADiff r) = [r]+  fromRepr = listToDiff++-- | Generate GoodSpan most of the time, but also some completely arbitrary ones once in a while.+data FairSpan p = FS (Diff p) (Interval p)++-- | A Diff and a non-conflicting Span+data GoodSpan p = GS (Diff p) (Interval p)++deriving instance (Show p, Show (Trans p)) => Show (FairSpan p)+deriving instance (Show p, Show (Trans p)) => Show (GoodSpan p)++pattern FSN :: Diff N -> Interval N -> FairSpan N+pattern FSN d s = FS d s++pattern GSN :: Diff N -> Interval N -> GoodSpan N+pattern GSN d s = GS d s++pattern FSV :: Diff (Colline N N) -> Interval (Colline N N) -> FairSpan (Colline N N)+pattern FSV d s = FS d s++pattern GSV :: Diff (Colline N N) -> Interval (Colline N N) -> GoodSpan (Colline N N)+pattern GSV d s = GS d s++instance (Amor p, Arbitrary p, Arbitrary (Trans p)) => Arbitrary (FairSpan p) where+  arbitrary = frequency [(10, (\(GS d s) -> FS d s) <$> arbitrary), (1, arbitrary)]++instance (Amor p, Arbitrary p, Arbitrary (Trans p), Show p, Show (Trans p)) => Constructible (FairSpan p) where+  type Repr (FairSpan p) = FairSpan p+  fromRepr = id++-- |+-- prop> \(GSN d s) -> isJust (mapDiff d s)+-- prop> \(GSV d s) -> isJust (mapDiff d s)+instance (Amor p, Arbitrary p, Arbitrary (Trans p)) => Arbitrary (GoodSpan p) where+  arbitrary = do+    let pairs (x : y : xs) | x == y = pairs (x : xs)+                           | otherwise = (x, y) : pairs xs+        pairs _ = []+    ts <- scale (* 2) (pairs <$> sort <$> arbitrary) `suchThat` (not . null)+    i <- choose (0, length ts-1)+    let (s, ts') = case splitAt i ts of+          (pre, (x, y) : suf) -> (x :.. (y .-. x), pre ++ suf)+          _ -> error "should not happen"+    d <- listToDiff <$> traverse (\(x, y) -> Replace x (y .-. x) <$> arbitrary) ts'+    pure (GS d s)++instance (Arbitrary l, Arbitrary c) => Arbitrary (Colline l c) where+  arbitrary = Colline <$> arbitrary <*> arbitrary++instance (Arbitrary l, Arbitrary c) => Arbitrary (Vallee l c)  where+  arbitrary = Vallee <$> arbitrary <*> arbitrary++deriving via a instance Arbitrary a => Arbitrary (Plain a)+deriving via (f a) instance Arbitrary (f a) => Arbitrary (f :$: a)++genLowerBound :: (Arbitrary a, Num a, Ord a) => a -> Gen a+genLowerBound n = do+  NonNegative i <- arbitrary+  pure (if n <= n + i then n + i else n)  -- catches overflow++instance (Arbitrary a, Num a, Ord a, KnownNat n) => Arbitrary (IndexFrom n a) where+  arbitrary = indexFrom <$> genLowerBound (fromIntegral (natVal @n Proxy))++instance (Arbitrary a, Num a, Ord a) => Arbitrary (Offset a) where+  arbitrary = offset <$> genLowerBound 0
+ src/DiffLoc/Unsafe.hs view
@@ -0,0 +1,55 @@+{-# LANGUAGE+  DataKinds,+  ScopedTypeVariables,+  TypeApplications #-}+-- | Unsafe functions that will throw errors if misused.+module DiffLoc.Unsafe+  ( -- ** Inverting monoid actions+    (.-.)++    -- ** Smart constructors for 'IndexFrom'+  , indexFrom+  , indexFrom0+  , indexFrom1++    -- ** Smart constructor for 'Offset'+  , offset+  ) where++import Data.Maybe (fromMaybe)+import Data.Proxy (Proxy(..))+import GHC.Stack (HasCallStack)+import GHC.TypeNats (KnownNat, natVal)+import DiffLoc.Shift (Amor(Trans, (.-.?)))+import DiffLoc.Index (IndexFrom, Offset, indexFromM, offsetM)++infixl 6 .-.++-- | An unsafe variant of @('.-.?')@ which throws an exception on @Nothing@.+-- This operator may appear in class laws, imposing an implicit requirement+-- that its operands must be ordered.+(.-.) :: HasCallStack => Amor p => p -> p -> Trans p+i .-. j = fromMaybe (error "undefined vector") (i .-.? j)++-- | Constructor for 'IndexFrom'. The index must be greater than the origin,+-- otherwise an error is raised.+--+-- @+-- origin <= indexFrom i+-- @+indexFrom :: forall n a. (HasCallStack, KnownNat n, Num a, Ord a) => a -> IndexFrom n a+indexFrom i = fromMaybe err (indexFromM i)+  where err = error ("IndexFrom must not be less than origin " <> show (natVal @n Proxy))++-- | 'indexFrom' specialized to 0-indexing.+indexFrom0 :: (HasCallStack, Num a, Ord a) => a -> IndexFrom 0 a+indexFrom0 = indexFrom++-- | 'indexFrom' specialized to 1-indexing.+indexFrom1 :: (HasCallStack, Num a, Ord a) => a -> IndexFrom 1 a+indexFrom1 = indexFrom++-- | Construct an 'Offset'. The offset must be nonnegative, otherwise+-- an error is raised.+offset :: (HasCallStack, Num a, Ord a) => a -> Offset a+offset i = fromMaybe (error "Offset must not be negative") (offsetM i)