diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,373 @@ +Mozilla Public License Version 2.0 +================================== + +1. Definitions +-------------- + +1.1. "Contributor" + means each individual or legal entity that creates, contributes to + the creation of, or owns Covered Software. + +1.2. "Contributor Version" + means the combination of the Contributions of others (if any) used + by a Contributor and that particular Contributor's Contribution. + +1.3. "Contribution" + means Covered Software of a particular Contributor. + +1.4. "Covered Software" + means Source Code Form to which the initial Contributor has attached + the notice in Exhibit A, the Executable Form of such Source Code + Form, and Modifications of such Source Code Form, in each case + including portions thereof. + +1.5. "Incompatible With Secondary Licenses" + means + + (a) that the initial Contributor has attached the notice described + in Exhibit B to the Covered Software; or + + (b) that the Covered Software was made available under the terms of + version 1.1 or earlier of the License, but not also under the + terms of a Secondary License. + +1.6. "Executable Form" + means any form of the work other than Source Code Form. + +1.7. "Larger Work" + means a work that combines Covered Software with other material, in + a separate file or files, that is not Covered Software. + +1.8. "License" + means this document. + +1.9. "Licensable" + means having the right to grant, to the maximum extent possible, + whether at the time of the initial grant or subsequently, any and + all of the rights conveyed by this License. + +1.10. "Modifications" + means any of the following: + + (a) any file in Source Code Form that results from an addition to, + deletion from, or modification of the contents of Covered + Software; or + + (b) any new file in Source Code Form that contains any Covered + Software. + +1.11. "Patent Claims" of a Contributor + means any patent claim(s), including without limitation, method, + process, and apparatus claims, in any patent Licensable by such + Contributor that would be infringed, but for the grant of the + License, by the making, using, selling, offering for sale, having + made, import, or transfer of either its Contributions or its + Contributor Version. + +1.12. "Secondary License" + means either the GNU General Public License, Version 2.0, the GNU + Lesser General Public License, Version 2.1, the GNU Affero General + Public License, Version 3.0, or any later versions of those + licenses. + +1.13. "Source Code Form" + means the form of the work preferred for making modifications. + +1.14. "You" (or "Your") + means an individual or a legal entity exercising rights under this + License. For legal entities, "You" includes any entity that + controls, is controlled by, or is under common control with You. For + purposes of this definition, "control" means (a) the power, direct + or indirect, to cause the direction or management of such entity, + whether by contract or otherwise, or (b) ownership of more than + fifty percent (50%) of the outstanding shares or beneficial + ownership of such entity. + +2. License Grants and Conditions +-------------------------------- + +2.1. Grants + +Each Contributor hereby grants You a world-wide, royalty-free, +non-exclusive license: + +(a) under intellectual property rights (other than patent or trademark) + Licensable by such Contributor to use, reproduce, make available, + modify, display, perform, distribute, and otherwise exploit its + Contributions, either on an unmodified basis, with Modifications, or + as part of a Larger Work; and + +(b) under Patent Claims of such Contributor to make, use, sell, offer + for sale, have made, import, and otherwise transfer either its + Contributions or its Contributor Version. + +2.2. Effective Date + +The licenses granted in Section 2.1 with respect to any Contribution +become effective for each Contribution on the date the Contributor first +distributes such Contribution. + +2.3. Limitations on Grant Scope + +The licenses granted in this Section 2 are the only rights granted under +this License. No additional rights or licenses will be implied from the +distribution or licensing of Covered Software under this License. +Notwithstanding Section 2.1(b) above, no patent license is granted by a +Contributor: + +(a) for any code that a Contributor has removed from Covered Software; + or + +(b) for infringements caused by: (i) Your and any other third party's + modifications of Covered Software, or (ii) the combination of its + Contributions with other software (except as part of its Contributor + Version); or + +(c) under Patent Claims infringed by Covered Software in the absence of + its Contributions. + +This License does not grant any rights in the trademarks, service marks, +or logos of any Contributor (except as may be necessary to comply with +the notice requirements in Section 3.4). + +2.4. Subsequent Licenses + +No Contributor makes additional grants as a result of Your choice to +distribute the Covered Software under a subsequent version of this +License (see Section 10.2) or under the terms of a Secondary License (if +permitted under the terms of Section 3.3). + +2.5. Representation + +Each Contributor represents that the Contributor believes its +Contributions are its original creation(s) or it has sufficient rights +to grant the rights to its Contributions conveyed by this License. + +2.6. Fair Use + +This License is not intended to limit any rights You have under +applicable copyright doctrines of fair use, fair dealing, or other +equivalents. + +2.7. Conditions + +Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted +in Section 2.1. + +3. Responsibilities +------------------- + +3.1. Distribution of Source Form + +All distribution of Covered Software in Source Code Form, including any +Modifications that You create or to which You contribute, must be under +the terms of this License. You must inform recipients that the Source +Code Form of the Covered Software is governed by the terms of this +License, and how they can obtain a copy of this License. You may not +attempt to alter or restrict the recipients' rights in the Source Code +Form. + +3.2. Distribution of Executable Form + +If You distribute Covered Software in Executable Form then: + +(a) such Covered Software must also be made available in Source Code + Form, as described in Section 3.1, and You must inform recipients of + the Executable Form how they can obtain a copy of such Source Code + Form by reasonable means in a timely manner, at a charge no more + than the cost of distribution to the recipient; and + +(b) You may distribute such Executable Form under the terms of this + License, or sublicense it under different terms, provided that the + license for the Executable Form does not attempt to limit or alter + the recipients' rights in the Source Code Form under this License. + +3.3. Distribution of a Larger Work + +You may create and distribute a Larger Work under terms of Your choice, +provided that You also comply with the requirements of this License for +the Covered Software. If the Larger Work is a combination of Covered +Software with a work governed by one or more Secondary Licenses, and the +Covered Software is not Incompatible With Secondary Licenses, this +License permits You to additionally distribute such Covered Software +under the terms of such Secondary License(s), so that the recipient of +the Larger Work may, at their option, further distribute the Covered +Software under the terms of either this License or such Secondary +License(s). + +3.4. Notices + +You may not remove or alter the substance of any license notices +(including copyright notices, patent notices, disclaimers of warranty, +or limitations of liability) contained within the Source Code Form of +the Covered Software, except that You may alter any license notices to +the extent required to remedy known factual inaccuracies. + +3.5. Application of Additional Terms + +You may choose to offer, and to charge a fee for, warranty, support, +indemnity or liability obligations to one or more recipients of Covered +Software. However, You may do so only on Your own behalf, and not on +behalf of any Contributor. You must make it absolutely clear that any +such warranty, support, indemnity, or liability obligation is offered by +You alone, and You hereby agree to indemnify every Contributor for any +liability incurred by such Contributor as a result of warranty, support, +indemnity or liability terms You offer. You may include additional +disclaimers of warranty and limitations of liability specific to any +jurisdiction. + +4. Inability to Comply Due to Statute or Regulation +--------------------------------------------------- + +If it is impossible for You to comply with any of the terms of this +License with respect to some or all of the Covered Software due to +statute, judicial order, or regulation then You must: (a) comply with +the terms of this License to the maximum extent possible; and (b) +describe the limitations and the code they affect. Such description must +be placed in a text file included with all distributions of the Covered +Software under this License. Except to the extent prohibited by statute +or regulation, such description must be sufficiently detailed for a +recipient of ordinary skill to be able to understand it. + +5. Termination +-------------- + +5.1. The rights granted under this License will terminate automatically +if You fail to comply with any of its terms. However, if You become +compliant, then the rights granted under this License from a particular +Contributor are reinstated (a) provisionally, unless and until such +Contributor explicitly and finally terminates Your grants, and (b) on an +ongoing basis, if such Contributor fails to notify You of the +non-compliance by some reasonable means prior to 60 days after You have +come back into compliance. Moreover, Your grants from a particular +Contributor are reinstated on an ongoing basis if such Contributor +notifies You of the non-compliance by some reasonable means, this is the +first time You have received notice of non-compliance with this License +from such Contributor, and You become compliant prior to 30 days after +Your receipt of the notice. + +5.2. If You initiate litigation against any entity by asserting a patent +infringement claim (excluding declaratory judgment actions, +counter-claims, and cross-claims) alleging that a Contributor Version +directly or indirectly infringes any patent, then the rights granted to +You by any and all Contributors for the Covered Software under Section +2.1 of this License shall terminate. + +5.3. In the event of termination under Sections 5.1 or 5.2 above, all +end user license agreements (excluding distributors and resellers) which +have been validly granted by You or Your distributors under this License +prior to termination shall survive termination. + +************************************************************************ +* * +* 6. Disclaimer of Warranty * +* ------------------------- * +* * +* Covered Software is provided under this License on an "as is" * +* basis, without warranty of any kind, either expressed, implied, or * +* statutory, including, without limitation, warranties that the * +* Covered Software is free of defects, merchantable, fit for a * +* particular purpose or non-infringing. The entire risk as to the * +* quality and performance of the Covered Software is with You. * +* Should any Covered Software prove defective in any respect, You * +* (not any Contributor) assume the cost of any necessary servicing, * +* repair, or correction. This disclaimer of warranty constitutes an * +* essential part of this License. No use of any Covered Software is * +* authorized under this License except under this disclaimer. * +* * +************************************************************************ + +************************************************************************ +* * +* 7. Limitation of Liability * +* -------------------------- * +* * +* Under no circumstances and under no legal theory, whether tort * +* (including negligence), contract, or otherwise, shall any * +* Contributor, or anyone who distributes Covered Software as * +* permitted above, be liable to You for any direct, indirect, * +* special, incidental, or consequential damages of any character * +* including, without limitation, damages for lost profits, loss of * +* goodwill, work stoppage, computer failure or malfunction, or any * +* and all other commercial damages or losses, even if such party * +* shall have been informed of the possibility of such damages. This * +* limitation of liability shall not apply to liability for death or * +* personal injury resulting from such party's negligence to the * +* extent applicable law prohibits such limitation. Some * +* jurisdictions do not allow the exclusion or limitation of * +* incidental or consequential damages, so this exclusion and * +* limitation may not apply to You. * +* * +************************************************************************ + +8. Litigation +------------- + +Any litigation relating to this License may be brought only in the +courts of a jurisdiction where the defendant maintains its principal +place of business and such litigation shall be governed by laws of that +jurisdiction, without reference to its conflict-of-law provisions. +Nothing in this Section shall prevent a party's ability to bring +cross-claims or counter-claims. + +9. Miscellaneous +---------------- + +This License represents the complete agreement concerning the subject +matter hereof. If any provision of this License is held to be +unenforceable, such provision shall be reformed only to the extent +necessary to make it enforceable. Any law or regulation which provides +that the language of a contract shall be construed against the drafter +shall not be used to construe this License against a Contributor. + +10. Versions of the License +--------------------------- + +10.1. New Versions + +Mozilla Foundation is the license steward. Except as provided in Section +10.3, no one other than the license steward has the right to modify or +publish new versions of this License. Each version will be given a +distinguishing version number. + +10.2. Effect of New Versions + +You may distribute the Covered Software under the terms of the version +of the License under which You originally received the Covered Software, +or under the terms of any subsequent version published by the license +steward. + +10.3. Modified Versions + +If you create software not governed by this License, and you want to +create a new license for such software, you may create and use a +modified version of this License if you rename the license and remove +any references to the name of the license steward (except to note that +such modified license differs from this License). + +10.4. Distributing Source Code Form that is Incompatible With Secondary +Licenses + +If You choose to distribute Source Code Form that is Incompatible With +Secondary Licenses under the terms of this version of the License, the +notice described in Exhibit B of this License must be attached. + +Exhibit A - Source Code Form License Notice +------------------------------------------- + + This Source Code Form is subject to the terms of the Mozilla Public + License, v. 2.0. If a copy of the MPL was not distributed with this + file, You can obtain one at http://mozilla.org/MPL/2.0/. + +If it is not possible or desirable to put the notice in a particular +file, then You may include the notice in a location (such as a LICENSE +file in a relevant directory) where a recipient would be likely to look +for such a notice. + +You may add additional accurate notices of copyright ownership. + +Exhibit B - "Incompatible With Secondary Licenses" Notice +--------------------------------------------------------- + + This Source Code Form is "Incompatible With Secondary Licenses", as + defined by the Mozilla Public License, v. 2.0. diff --git a/pro-source.cabal b/pro-source.cabal new file mode 100644 --- /dev/null +++ b/pro-source.cabal @@ -0,0 +1,94 @@ +cabal-version: 3.0 + +name: pro-source +version: 0.1.0.0 + +license: MPL-2.0 +license-file: LICENSE +author: James Alexander Feldman-Crough +maintainer: hello@typeclasses.com +copyright: © 2019-2020 James Alexander Feldman-Crough + +category: Parsing +synopsis: Utilities for tracking source locations +description: + Forked from part of the + [prosidy](https://hackage.haskell.org/package/prosidy) + package. + +source-repository head + type: git + location: git://github.com/typeclasses/pro-source.git + +common base + default-language: Haskell2010 + ghc-options: -Wall + + default-extensions: + DeriveAnyClass DeriveGeneric + DerivingStrategies GeneralizedNewtypeDeriving + + LambdaCase ViewPatterns + + MultiParamTypeClasses TypeFamilies + + OverloadedStrings + + ScopedTypeVariables TypeApplications + + build-depends: + base ^>= 4.13 || ^>= 4.14 || ^>= 4.15 || ^>= 4.16 + , deepseq ^>= 1.4.4 + , hashable ^>= 1.3 || ^>= 1.4 + , optics-core ^>= 0.3 || ^>= 0.4 + , prettyprinter ^>= 1.6 || ^>= 1.7 + , text ^>= 1.2 + , vector ^>= 0.12 + +library + import: base + hs-source-dirs: src + + exposed-modules: + ProSource + ProSource.HasLocation + ProSource.Location + ProSource.LocationOps + ProSource.Line + ProSource.LineMap + ProSource.Column + ProSource.Offset + ProSource.Source + ProSource.SourceOps + ProSource.SparseLocation + ProSource.Units + + other-modules: Prelude Text + + mixins: + base ( Prelude as BasePrelude + , Control.Monad + , Data.Foldable + , Data.List + , GHC.Generics + ) + , deepseq ( Control.DeepSeq ) + , hashable ( Data.Hashable ) + , optics-core ( Optics.Core ) + , prettyprinter ( Prettyprinter ) + , text ( Data.Text, Data.Text.Lazy ) + , vector ( Data.Vector.Generic + , Data.Vector.Generic.Mutable + , Data.Vector.Unboxed ) + +test-suite pro-source-test + import: base + type: exitcode-stdio-1.0 + hs-source-dirs: test + main-is: Main.hs + + build-depends: + pro-source + , tasty ^>= 1.2 || ^>= 1.3 || ^>= 1.4 + , tasty-hunit ^>= 0.10 + , tasty-quickcheck ^>= 0.10 diff --git a/src/Prelude.hs b/src/Prelude.hs new file mode 100644 --- /dev/null +++ b/src/Prelude.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Prelude (module X) where + +import BasePrelude as X (Enum, Eq, Functor (fmap), Maybe (..), Monoid, Ord (compare, (<), (>), (>=), (>=)), Ordering (..), Semigroup ((<>)), Show (..), String, Word, div, drop, flip, fromEnum, fromIntegral, id, maybe, mconcat, otherwise, pred, succ, ($), (&&), (+), (-), (.), (/=), (<$>), (==), (||)) +import Control.DeepSeq as X (NFData) +import Control.Monad as X (guard) +import Data.Foldable as X (Foldable (toList)) +import Data.Hashable as X (Hashable (..)) +import Data.List as X (sort) +import Data.Text as X (Text) +import GHC.Generics as X (Generic) +import Optics.Core as X (AffineFold, AffineTraversal', Iso', castOptic, iso, lens, simple, to, (%)) +import Prettyprinter as X (Pretty (..), (<+>)) + +import Text as X diff --git a/src/ProSource.hs b/src/ProSource.hs new file mode 100644 --- /dev/null +++ b/src/ProSource.hs @@ -0,0 +1,34 @@ +{- | +Description: Utilities for tracking source locations. +Copyright: © 2020 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource + ( + -- * Source + Source(..) + , makeSource, getSourceLine, getLocation + + -- * Location + , Location (..), SparseLocation(..) + , enrichLocation, stripLocation, sparse + + -- * Units + , Offset(..), Line(..), Column(..) + + -- * Line map + , LineMap, lineOffsets, lineToOffset, offsetToLine + + -- * Polymorphic Location optics + , HasLocation(..), offset, column, line, source + + ) where + +import ProSource.HasLocation +import ProSource.LineMap +import ProSource.Location +import ProSource.LocationOps +import ProSource.Source +import ProSource.SourceOps +import ProSource.SparseLocation +import ProSource.Units diff --git a/src/ProSource/Column.hs b/src/ProSource/Column.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/Column.hs @@ -0,0 +1,14 @@ +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.Column (Column (..)) where + +-- | A column number. +newtype Column = Column Word + deriving stock (Eq, Ord, Generic, Show) + deriving anyclass (Hashable, NFData) + deriving newtype Enum + +instance Pretty Column where + pretty (Column n) = pretty $ succ n diff --git a/src/ProSource/HasLocation.hs b/src/ProSource/HasLocation.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/HasLocation.hs @@ -0,0 +1,41 @@ +{- | +Copyright: © 2020 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.HasLocation + ( -- * Classy optics; implementable on all types with a location + HasLocation(..), offset + -- ** Read-only optics + , column, line, source + ) where + +import ProSource.Location +import ProSource.Units +import ProSource.SparseLocation +import ProSource.Source +import ProSource.LocationOps + +-- | A classy optic for selecting the 'Location' from a value. Note that 'location' is affine: a 'Location' can't be attached to a value which does not -- already have one, and not all values with an instance of 'HasLocation' have a location. +class HasLocation t where + location :: AffineTraversal' t Location + +instance HasLocation Location where + location = castOptic simple + +-- | Focus on the 'Offset' from a value parsed from a source file. If the 'Offset' is modified, note that the resulting 'column' and 'line' will /also/ be modified as they are denormalizations of this value. +offset :: HasLocation l => AffineTraversal' l Offset +offset = location % sparse % lens + sparseLocationOffset + (\sl x -> sl { sparseLocationOffset = x }) + +-- | Fetch the 'Column' from a value parsed from a source file. Modifications are not allowed as the 'offset' and 'line' may become inconsistent. +column :: HasLocation l => AffineFold l Column +column = location % to locationColumn + +-- | Fetch the 'Line' from a value parsed from a source file. Modifications are not allowed as the 'offset' and 'column' may become inconsistent. +line :: HasLocation l => AffineFold l Line +line = location % to locationLine + +-- | Fetch the 'Source' a value was parsed from. Modifications are not allowed as the 'line', 'offset', and 'column' may become inconsistent. +source :: HasLocation l => AffineFold l Source +source = location % to locationSource diff --git a/src/ProSource/Line.hs b/src/ProSource/Line.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/Line.hs @@ -0,0 +1,17 @@ +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.Line (Line (..)) where + +{- | A line number. + +The 'Show' instance for 'Line' counts from one, while the internal implementation counts from zero. +-} +newtype Line = Line Word + deriving stock (Eq, Ord, Generic, Show) + deriving anyclass (Hashable, NFData) + deriving newtype Enum + +instance Pretty Line where + pretty (Line n) = pretty $ succ n diff --git a/src/ProSource/LineMap.hs b/src/ProSource/LineMap.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/LineMap.hs @@ -0,0 +1,51 @@ +{- | +Description: Binary-search tree for finding the position of new lines. +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.LineMap + ( LineMap + , lineOffsets + , lineToOffset + , offsetToLine + , fromOffsets + ) where + +import Data.Vector.Unboxed (Vector) +import qualified Data.Vector.Unboxed as V + +import ProSource.Units + +-- | A dense vector containing offsets poiting to the start of each line. That is, the starting position of the third line of a file can be found at position 2. +newtype LineMap = LineMap (Vector Offset) + deriving stock (Eq, Generic) + deriving newtype (Show, NFData) + +instance Hashable LineMap where + hashWithSalt salt (LineMap v) = V.foldl' hashWithSalt salt v + +fromOffsets :: Foldable f => f Offset -> LineMap +fromOffsets = LineMap . V.fromList . sort . toList + +-- | Convert a 'LineMap' into a list of 'Offset's, corresponding to the first character of a line. Note that the initial offset is omitted-- the offset at index 0 will be the offset of the /second/ line. +lineOffsets :: LineMap -> [Offset] +lineOffsets (LineMap v) = V.toList v + +-- | Fetch the 'Offset' for the given 'Line'. Evaluates to 'Nothing' if the given 'Line' does not appear in the LineMap +lineToOffset :: Line -> LineMap -> Maybe Offset +lineToOffset = \case + Line 0 -> \_ -> Just $ Offset 0 + Line nth -> \(LineMap xs) -> xs V.!? fromIntegral (pred nth) + +-- | Fetch the 'Line' number for a given 'Offset'. Newlines will be attributed the line that they terminate, rather than the line started immediately afterwards. +offsetToLine :: Offset -> LineMap -> Line +offsetToLine offset (LineMap xs) = Line $ fromIntegral $ go Nothing 0 (V.length xs) + where + go result min max | min >= max = maybe 0 succ result + go result min max = case compare nthOffset offset of + EQ -> succ nthIndex + LT -> go (Just nthIndex) (nthIndex + 1) max + GT -> go result min nthIndex + where + nthIndex = ((max - min) `div` 2) + min + nthOffset = xs V.! nthIndex diff --git a/src/ProSource/Location.hs b/src/ProSource/Location.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/Location.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE StrictData #-} + +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.Location (Location (..)) where + +import ProSource.Source +import ProSource.Units + +-- | A location in a 'Source', with the line and column number computed lazily. +data Location = Location + { locationSource :: Source + -- ^ The 'Source' this location references. + , locationOffset :: Offset + -- ^ The position in the 'Source', counted by Unicode codepoints. + , locationLine :: ~Line + -- ^ The line number in the 'Source'. + , locationColumn :: ~Column + -- ^ The column number in the 'Source'. + } + deriving stock (Show, Generic, Eq) + deriving anyclass (NFData, Hashable) + +instance Pretty Location where + pretty loc = pretty (locationSource loc) <+> "@" <+> mconcat + [pretty (locationLine loc), "×", pretty (locationColumn loc)] diff --git a/src/ProSource/LocationOps.hs b/src/ProSource/LocationOps.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/LocationOps.hs @@ -0,0 +1,41 @@ +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.LocationOps (enrichLocation, stripLocation, sparse) where + +import ProSource.Column +import ProSource.LineMap +import ProSource.Location +import ProSource.Offset +import ProSource.Source +import ProSource.SparseLocation + +-- | Add lazily computed line and column number information to a 'SparseLocation'. +enrichLocation :: SparseLocation -> Location +enrichLocation sl = Location + { locationSource = source + , locationOffset = offset + , locationLine = line + , locationColumn = column + } + where + source = sparseLocationSource sl + lineMap = sourceLineMap source + offset@(~(Offset offsetN)) = sparseLocationOffset sl + line = offsetToLine offset lineMap + + column = case lineToOffset line lineMap of + Just (Offset n) -> Column (offsetN - n) + Nothing -> Column 0 + +-- | Remove line and column number information from a 'Location'. +stripLocation :: Location -> SparseLocation +stripLocation l = SparseLocation + { sparseLocationSource = locationSource l + , sparseLocationOffset = locationOffset l + } + +-- | An isomorphism between 'Location' and 'SparseLocation'. This is allowed because although a 'Location' has strictly more data than a 'SparseLocation', those values are denormalizations of values within 'SparseLocation'. +sparse :: Iso' Location SparseLocation +sparse = iso stripLocation enrichLocation diff --git a/src/ProSource/Offset.hs b/src/ProSource/Offset.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/Offset.hs @@ -0,0 +1,40 @@ +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.Offset (Offset (..)) where + +import qualified Data.Vector.Generic as VG +import qualified Data.Vector.Generic.Mutable as VGM +import Data.Vector.Unboxed (MVector, Unbox, Vector) + +-- | An offset into a 'Source', counted by UTF-8 codepoint. +newtype Offset = Offset Word + deriving stock (Eq, Show, Ord, Generic) + deriving anyclass (Hashable, NFData) + deriving newtype Enum + +instance Pretty Offset where + pretty (Offset n) = "+" <> pretty n + +newtype instance MVector s Offset = MV_Offset (MVector s Word) + +instance VGM.MVector MVector Offset where + basicLength (MV_Offset m) = VGM.basicLength m + basicUnsafeSlice ix len (MV_Offset m) = MV_Offset $ VGM.basicUnsafeSlice ix len m + basicOverlaps (MV_Offset x) (MV_Offset y) = VGM.basicOverlaps x y + basicUnsafeNew len = MV_Offset <$> VGM.basicUnsafeNew len + basicInitialize (MV_Offset v) = VGM.basicInitialize v + basicUnsafeRead (MV_Offset v) = fmap Offset <$> VGM.basicUnsafeRead v + basicUnsafeWrite (MV_Offset v) ix (Offset w) = VGM.basicUnsafeWrite v ix w + +newtype instance Vector Offset = V_Offset (Vector Word) + +instance VG.Vector Vector Offset where + basicUnsafeFreeze (MV_Offset v) = V_Offset <$> VG.basicUnsafeFreeze v + basicUnsafeThaw (V_Offset v) = MV_Offset <$> VG.basicUnsafeThaw v + basicLength (V_Offset v) = VG.basicLength v + basicUnsafeSlice ix len (V_Offset v) = V_Offset $ VG.basicUnsafeSlice ix len v + basicUnsafeIndexM (V_Offset v) ix = Offset <$> VG.basicUnsafeIndexM v ix + +instance Unbox Offset where diff --git a/src/ProSource/Source.hs b/src/ProSource/Source.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/Source.hs @@ -0,0 +1,32 @@ +{-# LANGUAGE StrictData #-} + +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.Source (Source (..)) where + +import ProSource.LineMap + +{- | Information about a source file. + +The 'Show' instance for ths class does not include the 'LineMap' or 'Text' fields, as those are rather noisy. +-} +data Source = Source + { sourceName :: String + -- ^ The reported file-name of the 'Source'. + -- + -- When read from file handles, a non-filepath description such as @"\"@ is typically chosen. This field doesn't have semantic meaning, and should only be used to enrich the output displayed to users. + , sourceText :: Text + -- ^ The full source, as 'Text'. + , sourceLineMap :: LineMap + -- ^ A mapping of the start position of each line in the 'Source'. + } + deriving stock (Eq, Generic) + deriving anyclass (Hashable, NFData) + +instance Show Source where + show (Source fp _ _) = "Source " <> show fp + +instance Pretty Source where + pretty = pretty . sourceName diff --git a/src/ProSource/SourceOps.hs b/src/ProSource/SourceOps.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/SourceOps.hs @@ -0,0 +1,41 @@ +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.SourceOps (makeSource, getLocation, getSourceLine) where + +import qualified Data.Text as T + +import ProSource.Line +import ProSource.LineMap +import ProSource.Location +import ProSource.LocationOps +import ProSource.Offset +import ProSource.Source +import ProSource.SparseLocation + +-- | Create a 'Source' from a descriptive name and a body. The source name is typically a 'FilePath', but this is not guaranteed. For instance, when read from standard-input, a common choice is to name the source @\@. +makeSource :: String -> LText -> Source +makeSource name (toStrictText -> body) = Source name body lineMap + where + lineMap = case T.foldl' lineMapFold (1, '\0', []) $ body of + (_, _, acc) -> fromOffsets acc + lineMapFold (ix, prev, acc) ch + | ch == '\n' && prev == '\r' = (succ ix, ch, Offset ix : drop 1 acc) + | ch == '\n' || ch == '\r' = (succ ix, ch, Offset ix : acc) + | otherwise = (succ ix, ch, acc) + +-- | Convert an 'Offset' into a 'Location'. +getLocation :: Offset -> Source -> Maybe Location +getLocation offset src = do + guard $ T.length (sourceText src) > fromEnum offset + Just . enrichLocation $ SparseLocation src offset + +-- | Fetch a single line from a source. +getSourceLine :: Line -> Source -> Maybe Text +getSourceLine line source = do + start <- fromEnum <$> lineToOffset line lineMap + let end = fromEnum <$> lineToOffset (succ line) lineMap + Just . maybe id (T.take . (flip (-) start)) end . T.drop start $ sourceText + source + where lineMap = sourceLineMap source diff --git a/src/ProSource/SparseLocation.hs b/src/ProSource/SparseLocation.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/SparseLocation.hs @@ -0,0 +1,20 @@ +{-# LANGUAGE StrictData #-} + +{- | +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.SparseLocation (SparseLocation (..)) where + +import ProSource.Offset +import ProSource.Source + +-- | A location in a 'Source'. The line and column numbers of this type are not attached to this type; convert to a 'Location' to access those values. +data SparseLocation = SparseLocation + { sparseLocationSource :: Source + -- ^ The 'Source' this location references. + , sparseLocationOffset :: Offset + -- ^ The position in the 'Source', counted by Unicode codepoints. + } + deriving stock (Show, Generic, Eq) + deriving anyclass (NFData, Hashable) diff --git a/src/ProSource/Units.hs b/src/ProSource/Units.hs new file mode 100644 --- /dev/null +++ b/src/ProSource/Units.hs @@ -0,0 +1,10 @@ +{- | +Description: Positional units for marking source-code locations. +Copyright: © 2019 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module ProSource.Units (module X) where + +import ProSource.Column as X +import ProSource.Line as X +import ProSource.Offset as X diff --git a/src/Text.hs b/src/Text.hs new file mode 100644 --- /dev/null +++ b/src/Text.hs @@ -0,0 +1,11 @@ +{-# language NoImplicitPrelude #-} + +module Text where + +import Data.Text (Text) +import qualified Data.Text.Lazy as Text.Lazy + +type LText = Text.Lazy.Text + +toStrictText :: LText -> Text +toStrictText = Text.Lazy.toStrict diff --git a/test/Main.hs b/test/Main.hs new file mode 100644 --- /dev/null +++ b/test/Main.hs @@ -0,0 +1,128 @@ +{- | +Copyright: © 2020 James Alexander Feldman-Crough +License: MPL-2.0 +-} +module Main (main) where + +import Data.IORef +import System.IO.Unsafe +import Test.Tasty +import Test.Tasty.HUnit +import Test.Tasty.QuickCheck + +import Control.Exception (evaluate) +import Data.Foldable (for_, toList) +import Prelude hiding (lines) + +import qualified Data.Text as T +import qualified Data.Text.Lazy as LT +import qualified ProSource as PS + +main :: IO () +main = defaultMain $ testGroup "test" [tests] + +tests :: TestTree +tests = testGroup + "source" + [ testEmptyLineMap + , testSimpleLineMap + , testLineDelimiters + , testLocation + , testLocationLazy + , propLineOffset + ] + +testEmptyLineMap :: TestTree +testEmptyLineMap = testCase "empty" $ do + let source = PS.makeSource "" "" + assertBool "An empty source generates an empty line map." + $ null (PS.lineOffsets $ PS.sourceLineMap source) + +testSimpleLineMap :: TestTree +testSimpleLineMap = testCase "simple" $ do + let sourceLines = + [ "This source file contains a few lines." + , "Some, line the next, are empty." + , "" + , "Multiple consecutive empty lines are fine as well." + , "" + , "" + , "終わり" + ] + source = PS.makeSource "" $ LT.unlines (map LT.fromStrict sourceLines) + toList (PS.lineOffsets $ PS.sourceLineMap source) + @?= fmap PS.Offset [39, 71, 72, 123, 124, 125, 129] + for_ (zip [PS.Line 0 ..] sourceLines) $ \(lineNumber, line) -> + PS.getSourceLine lineNumber source @?= Just (line <> "\n") + +testLineDelimiters :: TestTree +testLineDelimiters = testCase "endings" $ do + let source = PS.makeSource "" "abc\ndef\rghi\r\njkl" + lines = PS.sourceLineMap source + PS.getSourceLine (PS.Line 0) source @?= Just "abc\n" + PS.lineToOffset (PS.Line 0) lines @?= Just (PS.Offset 0) + PS.getSourceLine (PS.Line 1) source @?= Just "def\r" + PS.lineToOffset (PS.Line 1) lines @?= Just (PS.Offset 4) + PS.getSourceLine (PS.Line 2) source @?= Just "ghi\r\n" + PS.lineToOffset (PS.Line 2) lines @?= Just (PS.Offset 8) + PS.getSourceLine (PS.Line 3) source @?= Just "jkl" + PS.lineToOffset (PS.Line 3) lines @?= Just (PS.Offset 13) + PS.getSourceLine (PS.Line 4) source @?= Nothing + +testLocation :: TestTree +testLocation = testCase "location" $ do + let source = PS.makeSource "" "ab\ncd\nef" + checkLocation offset line column = do + let loc = PS.getLocation (PS.Offset offset) source + fmap PS.locationOffset loc @?= Just (PS.Offset offset) + fmap PS.locationLine loc @?= Just (PS.Line line) + fmap PS.locationColumn loc @?= Just (PS.Column column) + checkLocation 0 0 0 + checkLocation 1 0 1 + checkLocation 2 0 2 + checkLocation 3 1 0 + checkLocation 4 1 1 + checkLocation 5 1 2 + checkLocation 6 2 0 + checkLocation 7 2 1 + PS.getLocation (PS.Offset 8) source @?= Nothing + +testLocationLazy :: TestTree +testLocationLazy = testCase "lazy" $ do + let source = PS.makeSource "" "abc\ndef" + Just loc = PS.getLocation (PS.Offset 5) source + (line, checkLine) <- checkEvaluated (PS.locationLine loc) + (col , checkCol ) <- checkEvaluated (PS.locationColumn loc) + assertBool "line is unevaluated" . not =<< checkLine + assertBool "col is unevaluated" . not =<< checkCol + _ <- evaluate line + assertBool "line is evaluated" =<< checkLine + assertBool "col is unevaluated" . not =<< checkCol + _ <- evaluate col + assertBool "line is evaluated" =<< checkLine + assertBool "col is evaluated" =<< checkCol + +propLineOffset :: TestTree +propLineOffset = + testProperty "line-and-offset" $ forAll gen $ \(source, initialOffset) -> + let lineMap = PS.sourceLineMap source + line = PS.offsetToLine initialOffset lineMap + Just offset = PS.lineToOffset line lineMap + line' = PS.offsetToLine offset lineMap + in (initialOffset >= offset) .&&. (line === line') + where + gen = do + text <- T.pack <$> genChar + initialOffset <- + elements + [PS.Offset 0 .. toEnum + (if T.null text then 0 else T.length text - 1)] + pure (PS.makeSource "" (LT.fromStrict text), initialOffset) + genChar = + listOf $ frequency + [(10, elements ['a' .. 'z']), (4, pure ' '), (1, pure '\n')] + +checkEvaluated :: a -> IO (a, IO Bool) +checkEvaluated val = do + ref <- newIORef False + pure (unsafePerformIO (writeIORef ref True) `seq` val, readIORef ref)